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