decompression up to Maybe [Word]

not yet to ByteString though
This commit is contained in:
Jack Wines 2024-04-15 01:51:35 -07:00
parent b8cb909fc9
commit 3d1deaacc1
No known key found for this signature in database
GPG key ID: 25B20640600571E6
2 changed files with 28 additions and 7 deletions

View file

@ -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

View file

@ -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