Initial data commit

Task/Huffman-coding/Haskell/huffman-coding-1.hs

@@ -0,0 +1,40 @@
+import Data.List (group, insertBy, sort, sortBy)
+import Control.Arrow ((&&&), second)
+import Data.Ord (comparing)
+
+data HTree a
+  = Leaf a
+  | Branch (HTree a)
+           (HTree a)
+  deriving (Show, Eq, Ord)
+
+test :: String -> IO ()
+test =
+  mapM_ (\(a, b) -> putStrLn ('\'' : a : ("' : " ++ b))) .
+  serialize . huffmanTree . freq
+
+serialize :: HTree a -> [(a, String)]
+serialize (Branch l r) =
+  (second ('0' :) <$> serialize l) ++ (second ('1' :) <$> serialize r)
+serialize (Leaf x) = [(x, "")]
+
+huffmanTree
+  :: (Ord w, Num w)
+  => [(w, a)] -> HTree a
+huffmanTree =
+  snd .
+  head . until (null . tail) hstep . sortBy (comparing fst) . fmap (second Leaf)
+
+hstep
+  :: (Ord a, Num a)
+  => [(a, HTree b)] -> [(a, HTree b)]
+hstep ((w1, t1):(w2, t2):wts) =
+  insertBy (comparing fst) (w1 + w2, Branch t1 t2) wts
+
+freq
+  :: Ord a
+  => [a] -> [(Int, a)]
+freq = fmap (length &&& head) . group . sort
+
+main :: IO ()
+main = test "this is an example for huffman encoding"

Task/Huffman-coding/Haskell/huffman-coding-2.hs

@@ -0,0 +1,19 @@
+'p' : 00000
+'r' : 00001
+'g' : 00010
+'l' : 00011
+'n' : 001
+'m' : 0100
+'o' : 0101
+'c' : 01100
+'d' : 01101
+'h' : 0111
+'s' : 1000
+'x' : 10010
+'t' : 100110
+'u' : 100111
+'f' : 1010
+'i' : 1011
+'a' : 1100
+'e' : 1101
+' ' : 111

Task/Huffman-coding/Haskell/huffman-coding-3.hs

@@ -0,0 +1,12 @@
+import qualified Data.Set as S
+
+htree :: (Ord t, Num t, Ord a) => S.Set (t, HTree a) -> HTree a
+htree ts | S.null ts_1 = t1
+         | otherwise = htree ts_3
+           where
+             ((w1,t1), ts_1) = S.deleteFindMin ts
+             ((w2,t2), ts_2) = S.deleteFindMin ts_1
+             ts_3 = S.insert (w1 + w2, Branch t1 t2) ts_2
+
+huffmanTree :: (Ord w, Num w, Ord a) => [(w, a)] -> HTree a
+huffmanTree =  htree . S.fromList . map (second Leaf)

Task/Huffman-coding/Haskell/huffman-coding-4.hs

@@ -0,0 +1,17 @@
+import Data.List (sortBy, insertBy, sort, group)
+import Control.Arrow (second, (&&&))
+import Data.Ord (comparing)
+
+freq :: Ord a => [a] -> [(Int, a)]
+freq = map (length &&& head) . group . sort
+
+huffman :: [(Int, Char)] -> [(Char, String)]
+huffman = reduce . map (\(p, c) -> (p, [(c ,"")])) . sortBy (comparing fst)
+  where add (p1, xs1) (p2, xs2) = (p1 + p2, map (second ('0':)) xs1 ++ map (second ('1':)) xs2)
+        reduce [(_, ys)]  = sortBy (comparing fst) ys
+        reduce (x1:x2:xs) = reduce $ insertBy (comparing fst) (add x1 x2) xs
+
+test s = mapM_ (\(a, b) -> putStrLn ('\'' : a : "\' : " ++ b)) . huffman . freq $ s
+
+main = do
+    test "this is an example for huffman encoding"