I finally got the tree construction done -
Did not like two things though -
1. I had to write a two separate sorting functions .. Cant seem to create instance of Eq of Parametric types .
2. The pattern matching seems a little cluttered.
data WeightedCharacter = WeightedCharacter { weight :: Int,
character :: Char
}deriving (Show)
instance Eq WeightedCharacter where
(WeightedCharacter a _) == (WeightedCharacter b _) = a==b
instance Ord WeightedCharacter where
(WeightedCharacter a _) > (WeightedCharacter b _) = a > b
(WeightedCharacter a _) >= (WeightedCharacter b _) = a >= b
(WeightedCharacter a _) < (WeightedCharacter b _) = a < b
(WeightedCharacter a _) <= (WeightedCharacter b _) = a <= b
type CharacterFrequencyTuple = (Int,Char)
{-
repeats hello
= [(1,'e'),(1,'h'),(1,'o'),(2,'l')]
-}
repeats :: String -> [CharacterFrequencyTuple]
repeats string = quickSort $ zip counts uniqueLetters
where
counts = map (frequency string) uniqueLetters
frequency :: String -> Char -> Int
frequency (x:xs) c
| c == x = 1 + frequency xs c
| otherwise = frequency xs c
frequency _ c = 0
uniqueLetters = unique string
unique :: String -> String -- get the unique letters in the string
unique (x:xs) = [x] ++ unique [y | y <- xs, y /= x ]
unique [] = []
data Tree a = Node a (Tree a) (Tree a) | Leaf a
deriving (Show)
huffman :: [Tree CharacterFrequencyTuple] -> [Tree CharacterFrequencyTuple]
huffman (min1:min2:rest) = huffman newList
where
newList
| length rest /= 0 = sortTreeList ((merge min1 min2):rest) -- TODO Sorting of the list is required
| otherwise = [merge min1 min2]
merge (Node node left right) (Leaf leaf)
| node <= leaf = Node (newWeight,'*') (Node node left right) (Leaf leaf)
| otherwise = Node (newWeight,'*') (Leaf leaf) (Node node left right)
where
newWeight = (fst leaf) + (fst node)
merge (Leaf leaf) (Node node left right)
| node <= leaf = Node (newWeight,'*') (Node node left right) (Leaf leaf)
| otherwise = Node (newWeight,'*') (Leaf leaf) (Node node left right)
where
newWeight = (fst leaf) + (fst node)
merge (Leaf leaf1) (Leaf leaf2)
| leaf1 <= leaf2 = Node (newWeight,'*') (Leaf leaf1) (Leaf leaf2)
| otherwise = Node (newWeight,'*') (Leaf leaf2) (Leaf leaf1)
where
newWeight = (fst leaf1) + (fst leaf2)
huffman x = x
quickSort (x:xs) = l1 ++ [x] ++ l2 -- items less than x + x + items bigger than x
where
l1 = quickSort [y | y <- xs, y < x] -- sorted items less than x
l2 = quickSort [y | y <- xs, y >= x] -- sorted items greater than x
quickSort [] = []
sortTreeList (x:xs) = l1 ++ [x] ++ l2
where
l1 = sortTreeList [y | y <- xs, (lessThan y x)]
l2 = sortTreeList [y | y <- xs, (not (lessThan y x))]
lessThan (Node n1 _ _) (Node n2 _ _) = (fst n1) < (fst n2)
lessThan (Node n1 _ _) (Leaf n2) = (fst n1) < (fst n2)
lessThan (Leaf n1) (Node n2 _ _) = (fst n1) < (fst n2)
lessThan (Leaf n1) (Leaf n2) = (fst n1) < (fst n2)
sortTreeList [] = []
main=do
x <- getLine
let y1=unique x
let y2=repeats x
putStrLn (show y1)
putStrLn (show y2)
let y=map Leaf y2
let z = huffman y
putStrLn (show z)
return ()
No comments:
Post a Comment