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):
|
To run with [Nix](nixos.org):
|
||||||
``` sh
|
``` 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' :: TreeDir -> HuffmanTree a -> M.Map a [TreeDir]
|
||||||
rec' dir = M.map (dir :) . findTreeDirections
|
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 :: forall a. (Ord a, Integral a, B.FiniteBits a) => BS.ByteString -> Maybe ([TreeDir], HuffmanTree a)
|
||||||
compress bs =
|
compress bs =
|
||||||
liftA2 (,) treeDirections mergedHuffmanTrees
|
liftA2 (,) treeDirections mergedHuffmanTrees
|
||||||
|
|
@ -57,7 +74,10 @@ compress bs =
|
||||||
|
|
||||||
dividedByteString = toBitsList 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)
|
encodeCompressed = C.encode . fmap (Bi.first encodeTreeDirs)
|
||||||
where
|
where
|
||||||
encodeTreeDirs = BV.cloneToByteString . V.fromList . map (BV.Bit . (== R))
|
encodeTreeDirs = BV.cloneToByteString . V.fromList . map (BV.Bit . (== R))
|
||||||
|
|
@ -120,8 +140,9 @@ main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
[filePath] <- SE.getArgs
|
[filePath] <- SE.getArgs
|
||||||
f <- BS.readFile filePath
|
f <- BS.readFile filePath
|
||||||
TIO.putStrLn "compression ratios:"
|
-- TIO.putStrLn "compression ratios:"
|
||||||
print . ("Word64",) . compressionRatioFor (D.Proxy :: D.Proxy Word64) $ f
|
print . ("Word64",) . testCompression (D.Proxy :: D.Proxy Word16) $ f
|
||||||
print . ("Word32",) . compressionRatioFor (D.Proxy :: D.Proxy Word32) $ f
|
-- print . ("Word64",) . compressionRatioFor (D.Proxy :: D.Proxy Word64) $ f
|
||||||
print . ("Word16",) . compressionRatioFor (D.Proxy :: D.Proxy Word16) $ f
|
-- print . ("Word32",) . compressionRatioFor (D.Proxy :: D.Proxy Word32) $ f
|
||||||
print . ("Word8",) . compressionRatioFor (D.Proxy :: D.Proxy Word8) $ 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