decompression up to Maybe [Word]
not yet to ByteString though
This commit is contained in:
parent
b8cb909fc9
commit
3d1deaacc1
2 changed files with 28 additions and 7 deletions
|
|
@ -1,4 +1,4 @@
|
|||
Compresses files using [Huffman coding](https://en.wikipedia.org/wiki/Huffman_coding). Please note that decompression isn't implemented yet.
|
||||
Compresses files using [Huffman coding](https://en.wikipedia.org/wiki/Huffman_coding). Please note that decompression isn't fully implemented yet. It is however implemented to the point where we know compression works correctly.
|
||||
|
||||
To run with [Nix](nixos.org):
|
||||
``` sh
|
||||
|
|
|
|||
33
src/Main.hs
33
src/Main.hs
|
|
@ -39,6 +39,23 @@ findTreeDirections (Node{..}) = M.union (rec' L left) (rec' R right)
|
|||
rec' :: TreeDir -> HuffmanTree a -> M.Map a [TreeDir]
|
||||
rec' dir = M.map (dir :) . findTreeDirections
|
||||
|
||||
decompress :: forall a. (Ord a, Integral a, B.FiniteBits a) => Maybe ([TreeDir], HuffmanTree a) -> Maybe [a]
|
||||
decompress Nothing = Just []
|
||||
decompress (Just (treeDirs, tree)) = decompress' treeDirs
|
||||
where
|
||||
|
||||
decompress' :: [TreeDir] -> Maybe [a]
|
||||
decompress' [] = Just []
|
||||
decompress' xs = case nextLeaf xs tree of
|
||||
Nothing -> Nothing
|
||||
Just (x, remainingDirs) -> (x :) <$> decompress' remainingDirs
|
||||
|
||||
nextLeaf :: [TreeDir] -> HuffmanTree a -> Maybe (a, [TreeDir])
|
||||
nextLeaf xs (Leaf a) = Just (a, xs)
|
||||
nextLeaf [] _ = Nothing
|
||||
nextLeaf (L:xs) (Node {..}) = nextLeaf xs left
|
||||
nextLeaf (R:xs) (Node {..}) = nextLeaf xs right
|
||||
|
||||
compress :: forall a. (Ord a, Integral a, B.FiniteBits a) => BS.ByteString -> Maybe ([TreeDir], HuffmanTree a)
|
||||
compress bs =
|
||||
liftA2 (,) treeDirections mergedHuffmanTrees
|
||||
|
|
@ -57,7 +74,10 @@ compress bs =
|
|||
|
||||
dividedByteString = toBitsList bs
|
||||
|
||||
encodeCompressed :: (C.Serialize a) => Maybe ([TreeDir], HuffmanTree a) -> BS.ByteString
|
||||
testCompression :: forall a. (Ord a, Eq a, Integral a, B.FiniteBits a) => D.Proxy a -> BS.ByteString -> Bool
|
||||
testCompression _ bs = ((Just . toBitsList $ bs) :: Maybe [a]) == (decompress . compress $ bs)
|
||||
|
||||
encodeCompressed :: C.Serialize a => Maybe ([TreeDir], HuffmanTree a) -> BS.ByteString
|
||||
encodeCompressed = C.encode . fmap (Bi.first encodeTreeDirs)
|
||||
where
|
||||
encodeTreeDirs = BV.cloneToByteString . V.fromList . map (BV.Bit . (== R))
|
||||
|
|
@ -120,8 +140,9 @@ main :: IO ()
|
|||
main = do
|
||||
[filePath] <- SE.getArgs
|
||||
f <- BS.readFile filePath
|
||||
TIO.putStrLn "compression ratios:"
|
||||
print . ("Word64",) . compressionRatioFor (D.Proxy :: D.Proxy Word64) $ f
|
||||
print . ("Word32",) . compressionRatioFor (D.Proxy :: D.Proxy Word32) $ f
|
||||
print . ("Word16",) . compressionRatioFor (D.Proxy :: D.Proxy Word16) $ f
|
||||
print . ("Word8",) . compressionRatioFor (D.Proxy :: D.Proxy Word8) $ f
|
||||
-- TIO.putStrLn "compression ratios:"
|
||||
print . ("Word64",) . testCompression (D.Proxy :: D.Proxy Word16) $ f
|
||||
-- print . ("Word64",) . compressionRatioFor (D.Proxy :: D.Proxy Word64) $ f
|
||||
-- print . ("Word32",) . compressionRatioFor (D.Proxy :: D.Proxy Word32) $ f
|
||||
-- print . ("Word16",) . compressionRatioFor (D.Proxy :: D.Proxy Word16) $ f
|
||||
-- print . ("Word8",) . compressionRatioFor (D.Proxy :: D.Proxy Word8) $ f
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue