-- | FIXME
module Codec.Audio.WavPack.Entropy
( EntropyData(..)
+
+ , clearMedian
+
+ , getMedian0
+ , getMedian1
+ , getMedian2
+
+ , incMedian0
+ , decMedian0
+ , incMedian1
+ , decMedian1
+ , incMedian2
+ , decMedian2
)
where
+import Data.Bits
import Data.Word
+import Prelude.Unicode
-- | FIXME
data EntropyData
= EntropyData {
-- | Median log2 values for a channel.
- edMedian ∷ !(Word32, Word32, Word32)
+ edMedian0 ∷ !Word32
+ , edMedian1 ∷ !Word32
+ , edMedian2 ∷ !Word32
-- | FIXME
, edSlowLevel ∷ !Word32
-- | FIXME
, edErrorLimit ∷ !Word32
}
deriving (Eq, Show)
+
+clearMedian ∷ EntropyData → EntropyData
+{-# INLINE clearMedian #-}
+clearMedian e = e {
+ edMedian0 = 0
+ , edMedian1 = 0
+ , edMedian2 = 0
+ }
+
+-- | The time constant of the 3 median level breakpoints
+div0, div1, div2 ∷ Word32
+div0 = 128 -- 5/ 7 of samples
+div1 = 64 -- 10/ 49 of samples
+div2 = 32 -- 20/343 of samples
+
+-- | Retrieve the specified median breakpoint (without frac; min = 1)
+getMedian0, getMedian1, getMedian2 ∷ EntropyData → Word32
+{-# INLINE getMedian0 #-}
+{-# INLINE getMedian1 #-}
+{-# INLINE getMedian2 #-}
+getMedian0 e = (edMedian0 e `shiftR` 4) + 1
+getMedian1 e = (edMedian1 e `shiftR` 4) + 1
+getMedian2 e = (edMedian2 e `shiftR` 4) + 1
+
+-- | Update the specified median breakpoints. Note that the median is
+-- incremented when the sample is higher than the median, else
+-- decremented. They are designed so that the median will never drop
+-- below 1 and the value is essentially stationary if there are 2
+-- increments for every 5 decrements.
+incMedian0, decMedian0, incMedian1, decMedian1, incMedian2, decMedian2 ∷ EntropyData → EntropyData
+incMedian0 e
+ = e { edMedian0 =
+ edMedian0 e + ((edMedian0 e + div0 ) `div` div0) ⋅ 5 }
+decMedian0 e
+ = e { edMedian0 =
+ edMedian0 e - ((edMedian0 e + (div0-2)) `div` div0) ⋅ 2 }
+incMedian1 e
+ = e { edMedian1 =
+ edMedian1 e + ((edMedian1 e + div1 ) `div` div1) ⋅ 5 }
+decMedian1 e
+ = e { edMedian1 =
+ edMedian1 e - ((edMedian1 e + (div1-2)) `div` div1) ⋅ 2 }
+incMedian2 e
+ = e { edMedian2 =
+ edMedian2 e + ((edMedian2 e + div2 ) `div` div2) ⋅ 5 }
+decMedian2 e
+ = e { edMedian2 =
+ edMedian2 e - ((edMedian2 e + (div2-2)) `div` div2) ⋅ 2 }
, UnboxedTuples
, UnicodeSyntax
#-}
--- | FIXME
+{-| This module provides entropy word encoding and decoding functions
+using a variation on the Rice method. This was introduced in wavpack
+3.93 because it allows splitting the data into a \"lossy\" stream and
+a \"correction\" stream in a very efficient manner and is therefore
+ideal for the "hybrid" mode. For 4.0, the efficiency of this method
+was significantly improved by moving away from the normal Rice
+restriction of using powers of two for the modulus divisions and now
+the method can be used for both hybrid and pure lossless encoding.
+
+Samples are divided by median probabilities at 5\/7 (71.43%), 10\/49
+(20.41%), and 20\/343 (5.83%). Each zone has 3.5 times fewer samples
+than the previous. Using standard Rice coding on this data would
+result in 1.4 bits per sample average (not counting sign
+bit). However, there is a very simple encoding that is over 99%
+efficient with this data and results in about 1.22 bits per sample. -}
module Codec.Audio.WavPack.Words
( WordsData(..)
+
+ , getWordsLossless
)
where
import Codec.Audio.WavPack.Entropy
-- lossless only ('edErrorLimit' ≡ 0). Also, rather than obtaining a
-- single sample, it can be used to obtain an entire buffer of either
-- mono or stereo samples.
-getWordsLossless ∷ ∀bs n v. (Bitstream bs, Integral n, GV.Vector v Int32)
+getWordsLossless ∷ ∀bs v. (Bitstream bs, GV.Vector v Int32)
⇒ Bool -- ^ Is the stream monaural?
→ WordsData
- → bs -- ^ WV bitstream.
- → n -- ^ Number of samples to get.
+ → bs -- ^ WV bitstream.
+ → Int -- ^ Number of samples to get.
→ (# WordsData, bs, v Int32 #)
{-# INLINEABLE getWordsLossless #-}
getWordsLossless isMono w0 bs0 nSamples0
- = let v0 = New.create $ MV.new $ fromIntegral nSamples
+ = let v0 = New.create $ MV.new nSamples
(# w1, bs1, n1, v1 #)
- = go w0 bs0 0 v0
- v2 = GV.new $ New.take (fromIntegral n1) v1
+ = go0 w0 bs0 0 v0
+ v2 = GV.new $ New.take n1 v1
in
(# w1, bs1, v2 #)
where
- nSamples ∷ n
- {-# INLINE nSamples #-}
+ nSamples ∷ Int
nSamples = if isMono
then nSamples0
else nSamples0 ⋅ 2
- go ∷ WordsData
- → bs
- → n
- → New v Int32
- → (# WordsData, bs, n, New v Int32 #)
- {-# INLINE go #-}
- go w bs n v
- | n ≥ nSamples = (# w, bs, n, v #)
+ go0 ∷ WordsData → bs → Int → New v Int32
+ → (# WordsData, bs, Int, New v Int32 #)
+ go0 w bs n v
+ | n ≥ nSamples
+ = (# w, bs, n, v #)
+ | edMedian0 (fst $ wdEntropyData w) < 2 ∧
+ wdHoldingZero w ≡ False ∧
+ wdHoldingOne w ≡ 0 ∧
+ edMedian1 (fst $ wdEntropyData w) < 2
+ = if wdZeroesAcc w > 0 then
+ let w' = w { wdZeroesAcc = wdZeroesAcc w - 1 }
+ in
+ if wdZeroesAcc w' > 0 then
+ let v' = New.modify (\mv → MV.unsafeWrite mv n 0) v
+ n' = n + 1
+ in
+ go0 w' bs n' v'
+ else
+ go1 w' bs n v
+ else
+ let cBits = min 33 $ B.length (B.takeWhile id bs)
+ bs' = B.drop cBits bs
+ in
+ if cBits ≡ 33 then
+ (# w, bs', n, v #)
+ else
+ let (# w', bs'' #) = go0' cBits w bs'
+ in
+ if wdZeroesAcc w' > 0 then
+ let w'' = w' {
+ wdEntropyData =
+ ( clearMedian $ fst $ wdEntropyData w'
+ , clearMedian $ snd $ wdEntropyData w' )
+ }
+ v' = New.modify (\mv → MV.unsafeWrite mv n 0) v
+ n' = n + 1
+ in
+ go0 w'' bs'' n' v'
+ else
+ go1 w' bs'' n v
+ | otherwise
+ = go1 w bs n v
+
+ go0' ∷ Word32 → WordsData → bs → (# WordsData, bs #)
+ go0' cBits w bs
+ | cBits < 2
+ = let w' = w { wdZeroesAcc = cBits }
+ in
+ (# w', bs #)
+ | otherwise
+ = let w' = w { wdZeroesAcc = 0 }
+ in
+ go0'' 1 cBits w' bs
+
+ go0'' ∷ Word32 → Word32 → WordsData → bs → (# WordsData, bs #)
+ go0'' mask cBits w bs
+ | cBits ≡ 1
+ = let w' = w { wdZeroesAcc = wdZeroesAcc w .|. mask }
+ in
+ (# w', bs #)
+ | otherwise
+ = let cBits' = cBits - 1
+ w' = if B.head bs then
+ w { wdZeroesAcc = wdZeroesAcc w .|. mask }
+ else
+ w
+ mask' = mask `shiftL` 1
+ bs' = B.tail bs
+ in
+ go0'' mask' cBits' w' bs'
+
+ go1 ∷ WordsData → bs → Int → New v Int32
+ → (# WordsData, bs, Int, New v Int32 #)
+ go1 w bs n v
+ | wdHoldingZero w
+ = let w' = w { wdHoldingZero = False }
+ in
+ go2 0 w' bs n v
| otherwise
= error "FIXME"
- where
- entropy ∷ EntropyData
- entropy
- | isMono = fst $ wdEntropyData w
- | n `rem` 2 ≡ 0 = fst $ wdEntropyData w
- | otherwise = snd $ wdEntropyData w
+
+ go2 ∷ Word32 → WordsData → bs → Int → New v Int32
+ → (# WordsData, bs, Int, New v Int32 #)
+ go2 0 w bs n v
+ = let ent = getEntropy n w
+ low = 0
+ high = getMedian0 ent
+ ent' = decMedian0 ent
+ w' = setEntropy ent' n w
+ in
+ go3 low high w' bs n v
+ go2 1 w bs n v
+ = let ent = getEntropy n w
+ low = getMedian0 ent
+ high = low + getMedian1 ent - 1
+ ent' = (incMedian0 ∘ decMedian1) ent
+ w' = setEntropy ent' n w
+ in
+ go3 low high w' bs n v
+ go2 2 w bs n v
+ = let ent = getEntropy n w
+ low = getMedian0 ent + getMedian1 ent
+ high = low + getMedian2 ent - 1
+ ent' = (incMedian0 ∘ incMedian1 ∘ decMedian2) ent
+ w' = setEntropy ent' n w
+ in
+ go3 low high w' bs n v
+ go2 onesCount w bs n v
+ = let ent = getEntropy n w
+ low = getMedian0 ent + getMedian1 ent + (onesCount-2) ⋅ getMedian2 ent
+ high = low + getMedian2 ent - 1
+ ent' = (incMedian0 ∘ incMedian1 ∘ incMedian2) ent
+ w' = setEntropy ent' n w
+ in
+ go3 low high w' bs n v
+
+ go3 ∷ Word32 → Word32 → WordsData → bs → Int → New v Int32
+ → (# WordsData, bs, Int, New v Int32 #)
+ go3 low high w bs n v
+ = let (# code, bs' #)
+ = readCode bs (high - low)
+ low' = low + code
+ a = if B.head bs' then
+ fromIntegral $ complement low'
+ else
+ fromIntegral low'
+ bs'' = B.tail bs'
+ v' = New.modify (\mv → MV.unsafeWrite mv n a) v
+ n' = n + 1
+ in
+ go0 w bs'' n' v'
+
+ getEntropy ∷ Int → WordsData → EntropyData
+ getEntropy n w
+ | isMono = fst $ wdEntropyData w
+ | n `testBit` 0 = fst $ wdEntropyData w
+ | otherwise = snd $ wdEntropyData w
+
+ setEntropy ∷ EntropyData → Int → WordsData → WordsData
+ setEntropy e n w
+ | isMono = w { wdEntropyData = (e, snd $ wdEntropyData w) }
+ | n `testBit` 0 = w { wdEntropyData = (e, snd $ wdEntropyData w) }
+ | otherwise = w { wdEntropyData = (fst $ wdEntropyData w, e) }
-- | Read a single unsigned value from the specified bitstream with a
-- value from 0 to maxCode. If there are exactly a power of two number
projects / wavpack.git / commitdiff