src/Codec/Goat/ValueFrame/Encode.hs
{- |
Module : Codec.Goat.ValueFrame.Encode
Description : Value compression
Copyright : (c) Daniel Lovasko, 2016-2017
License : BSD3
Maintainer : Daniel Lovasko <daniel.lovasko@gmail.com>
Stability : stable
Portability : portable
Encoding of value points into a compressed frame form.
-}
module Codec.Goat.ValueFrame.Encode
( valueEncode
) where
import Control.Arrow
import Data.Bits
import Data.Bits.Floating
import Data.List
import Data.Word
import qualified Data.ByteString as B
import Codec.Goat.Util
import Codec.Goat.ValueFrame.Types
-- | Encode a list of float values into a succinct value frame.
valueEncode :: [Float] -- ^ value points
-> ValueFrame -- ^ succinct frame form
valueEncode [] = ValueFrame Nothing 0 B.empty
valueEncode xs = ValueFrame (Just y) (genericLength bits) (packBits bits)
where
bits = concat $ snd $ mapAccumL encode (16, 16) xors :: [Bool]
xors = zipWith xor (y:ys) ys :: [Word32]
(y:ys) = map coerceToWord xs :: [Word32]
-- | Encode a single value based on the previous bounds.
encode :: (Int, Int) -- ^ current bounds
-> Word32 -- ^ value
-> ((Int, Int), [Bool]) -- ^ new bounds & encoded bits
encode bounds x
| x == 0 = (bounds, [False])
| fits = (bounds, [True, False] ++ slice bounds bits)
| otherwise = (newBounds, [True, True] ++ outside newBounds bits)
where
newBounds = (countTrailingZeros &&& countLeadingZeros) x
bits = toBools x
fits = within bounds newBounds
within (a, b) (na, nb) = na >= a && nb >= b
-- | Handle the encoding case where the core part of the word does not fit
-- into the rolling bounds.
outside :: (Int, Int) -- ^ bounds
-> [Bool] -- ^ all bits of a number
-> [Bool] -- ^ encoded bits
outside bounds@(lead, trail) bits = concat
[ take 5 $ toBools lead
, take 6 $ toBools $ 32-lead-trail
, slice bounds bits ]
-- | Select a sublist based on the specified bounds. Note that this
-- functions assumes list length to be 32.
slice :: (Int, Int) -- ^ bounds
-> [a] -- ^ list
-> [a] -- ^ sublist
slice (lead, trail) xs = take (32-lead-trail) (drop lead xs)