module Holumbus.Data.Crunch
(
crunch8
, crunch16
, crunch32
, crunch64
, decrunch8
, decrunch16
, decrunch32
, decrunch64
)
where
import Data.Bits
import Data.Word
data Width = W01 | W02 | W03 | W04 | W05 | W06 | W07 | W08 | W10 | W12 | W15 | W20 | W30 | W60
deriving (Show, Eq, Enum)
value :: Width -> Word64
value W01 = (2 ^ 1) 1
value W02 = (2 ^ 2) 1
value W03 = (2 ^ 3) 1
value W04 = (2 ^ 4) 1
value W05 = (2 ^ 5) 1
value W06 = (2 ^ 6) 1
value W07 = (2 ^ 7) 1
value W08 = (2 ^ 8) 1
value W10 = (2 ^ 10) 1
value W12 = (2 ^ 12) 1
value W15 = (2 ^ 15) 1
value W20 = (2 ^ 20) 1
value W30 = (2 ^ 30) 1
value W60 = (2 ^ 60) 1
count :: Width -> Int
count W01 = 60
count W02 = 30
count W03 = 20
count W04 = 15
count W05 = 12
count W06 = 10
count W07 = 8
count W08 = 7
count W10 = 6
count W12 = 5
count W15 = 4
count W20 = 3
count W30 = 2
count W60 = 1
width :: Width -> Int
width W01 = 1
width W02 = 2
width W03 = 3
width W04 = 4
width W05 = 5
width W06 = 6
width W07 = 7
width W08 = 8
width W10 = 10
width W12 = 12
width W15 = 15
width W20 = 20
width W30 = 30
width W60 = 60
crunch64 :: [Word64] -> [Word64]
crunch64 [] = []
crunch64 s = crunch' s (count W01) W01 []
crunch' :: [Word64] -> Int -> Width -> [Word64] -> [Word64]
crunch' [] 0 m r = [encode m r]
crunch' [] _ m r = crunch' r (count (succ m)) (succ m) []
crunch' s 0 m r = (encode m r):(crunch' s (count W01) W01 [])
crunch' s@(x:xs) n m r = if x <= value m then crunch' xs (n 1) m (r ++ [x])
else crunch' (r ++ s) (count (succ m)) (succ m) []
encode :: Width -> [Word64] -> Word64
encode w [] = rotateR (fromIntegral (fromEnum w)) (64 (width w * count w))
encode w (x:xs) = rotateR (encode w xs .|. fromIntegral x) (width w)
decrunch64 :: [Word64] -> [Word64]
decrunch64 [] = []
decrunch64 (x:xs) = (decode (width w) (count w) (value w) (rotateL x (width w))) ++ (decrunch64 xs)
where
w = toEnum $ fromIntegral (x .&. 15)
decode :: Int -> Int -> Word64 -> Word64 -> [Word64]
decode _ 0 _ _ = []
decode w n m x = (x .&. m):(decode w (n 1) m (rotateL x w))
crunch8 :: [Word8] -> [Word64]
crunch8 = crunch64 . (map fromIntegral)
crunch16 :: [Word16] -> [Word64]
crunch16 = crunch64 . (map fromIntegral)
crunch32 :: [Word32] -> [Word64]
crunch32 = crunch64 . (map fromIntegral)
decrunch8 :: [Word64] -> [Word8]
decrunch8 = (map fromIntegral) . decrunch64
decrunch16 :: [Word64] -> [Word16]
decrunch16 = (map fromIntegral) . decrunch64
decrunch32 :: [Word64] -> [Word32]
decrunch32 = (map fromIntegral) . decrunch64