2
\$\begingroup\$

This is problem 50 in https://wiki.haskell.org/99_questions/46_to_50. The website has more elegant Haskell solutions, but I wanted to get feedback on how the code I wrote on my own below could be improved.

import Data.List

data Tree a = Leaf a Int | Internal (Tree a) (Tree a) Int

instance (Eq a) => Eq (Tree a) where
 (Leaf a ac)         == (Leaf b bc)  = (a == b) && (ac == bc)
 (Internal a1 a2 ac) == (Internal b1 b2 bc) = (a1 == b1) && (a2 == b2) && (ac == bc)
 _   == _  = False

instance (Eq a) => Ord (Tree a) where
 a <= b = (freq a) <= (freq b)

freq :: Tree a -> Int
freq (Leaf _ c) = c
freq (Internal _ _ c) = c

leafMap :: [(a, Int)] -> [Tree a]
leafMap list = map (\(a, count) -> Leaf a count) list 

extractMinFreq :: (Eq a) => [Tree a] -> (Tree a, [Tree a])
extractMinFreq list = (mf , delete mf list)
                      where mf = minimum list

collapseLowest :: (Eq a) => [Tree a] -> [Tree a]
collapseLowest list = (collapsePair s1 s2):xs
                        where
                        (s1,y) = extractMinFreq list
                        (s2, xs) = extractMinFreq y

treeBuilder :: (Eq a) => [Tree a] -> Tree a
treeBuilder list = case len of
                        0 -> error "Empty"
                        1 -> list !! 0
                        _ -> treeBuilder $ collapseLowest list
                    where len = length list

collapsePair :: Tree a -> Tree a -> Tree a
collapsePair x y = Internal x y $ (freq x) + (freq y)

prefixBuilder :: Tree Char -> String -> [(Char, String)]
prefixBuilder (Leaf a _) prefix = [(a, prefix)]
prefixBuilder (Internal a b _) prefix = (prefixBuilder a $ prefix ++ "0") ++
                                        (prefixBuilder b $ prefix ++ "1")

huffman :: [(Char, Int)] -> [(Char, String)]
huffman list = prefixBuilder (treeBuilder $ leafMap list) ""

main = print $ huffman [('a',45),('b',13),('c',12),('d',16),('e',9),('f',5)]
\$\endgroup\$
  • 1
    \$\begingroup\$ I think it would be more helpful if you added a paragraph of text in which you explain the purpose of the code and the issues you encountered while writing it. \$\endgroup\$ – rubik Apr 7 '15 at 10:28
2
\$\begingroup\$

Specify imports

Do you know the names of all functions in Data.List? Me neither. Specify what you import like

import Data.List (delete)

In my final version, this becomes

import Data.List (minimumBy,partition)
import Data.Ord (comparing)

Ord vs Eq

Your Ord and Eq instances do not agree! For Ord, only the frequency matters, for Eq, both frequency and payload have to be equal. This leads to oddities like this:

> let i c x = Internal (Leaf c 0) (Leaf ' ' 0) x -- helper
> i 'a' 1 >= i 'b' 1
False
> i 'b' 1 >= i 'b' 1
True

To solve the issue, I'd get rid of the Ord instance by

where mf = minimumBy (comparing freq) list

Use deriving

You implement a custom Eq instance for Tree, where deriving Eq would suffice. It takes a second to figure out what deriving Eq does, to read yours takes longer and does nothing different.

use pattern matches

length and indexing with !! 0 look like a direct translation from imperative programming. Use pattern matching instead:

treeBuilder []   = error "Empty"
treeBuilder [x]  = x
treeBuilder list = treeBuilder $ collapseLowest list

The use of length causes an unnecessary traversal of the list and can cause performance issues: In the worst case you lose list fusion.

Getting rid of Eq constraint

Just as minimumBy allowed to get rid of the Ord instance, deleteBy allows to get rid of the Eq constraint.

extractMinFreq list = (mf , deleteBy ((==) `on` freq) mf list)

Now you can compress uncomparable things like functions or IO actions after Char has been replaced by a.

Eta reduction

leafMap allows eta reduction, the lambda can be written with uncurry. (The latter is of dubious value)

 leafMap = map (uncurry Leaf)

Github

You can see all steps at https://github.com/Frank-Siebert/codereview86061

\$\endgroup\$
  • \$\begingroup\$ Could you please tell me where you learned about eta reduction and uncurry? \$\endgroup\$ – ssh Apr 11 '15 at 1:27

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.