Huffman - clean 1. beadandó

module Huffman

import StdEnv, StdLib

:: Bit = Zero | One

:: Code :== [Bit]

:: Frequency :== (Char, Int)

:: Frequencies :== ([Frequency], Int)

:: CodeTree = Node Int CodeTree CodeTree
            | Leaf Char

instance == Bit where
  (==) Zero Zero = True
  (==) One One = True
  (==) _ _ = False

instance == CodeTree where
  (==) (Leaf a) (Leaf b) = a == b
  (==) (Node x aLeft aRight) (Node y bLeft bRight) = x == y && aLeft == bLeft && aRight == bRight
  (==) _ _ = False

// Done
getFrequencies :: String -> [Frequency]
getFrequencies str = getFrequencies2 [] [ch \\ ch <-: str]

getFrequencies2 :: [Char] [Char] -> [Frequency]
getFrequencies2 _ [] = []
getFrequencies2 list [x:xs]
    | isMember x list = getFrequencies2 list xs
    | otherwise = [(x, (length (filter ((==) x) [x:xs]))) : getFrequencies2 [x : list] xs]

// Done
frequencyToFrequencies :: [Frequency] -> [Frequencies]
frequencyToFrequencies frs = map expandTuple frs
    where
        expandTuple :: Frequency -> Frequencies
        expandTuple t = ([t], snd t)

// Done
sortFrequencies :: [Frequencies] -> [Frequencies]
sortFrequencies list = sortBy (\t1 t2 = (snd t1) < (snd t2)) list

sortTupleList :: [(a, Int)] -> [(a, Int)]
sortTupleList list = sortBy (\t1 t2 = (snd t1) < (snd t2)) list

buildTree :: [Frequencies] -> CodeTree
buildTree list = leavesToTree (sortTupleList (frequenciesToCodeTrees list))

frequenciesToCodeTrees :: [Frequencies] -> [(CodeTree, Int)]
frequenciesToCodeTrees list = map freqToLeaf list
    where
        freqToLeaf :: Frequencies -> (CodeTree, Int)
        freqToLeaf ([frequency:_],number) = (Leaf (fst frequency), number)

leavesToTree :: [(CodeTree, Int)] -> CodeTree
leavesToTree [(node, number):[]]    = node
leavesToTree [(node1, number1),(node2, number2):remaining]
    = leavesToTree (sortTupleList [(Node sum node1 node2, sum):remaining])
    where
        sum = number1 + number2

//Start = buildTree (frequencyToFrequencies (getFrequencies "abrakadabra"))
//Ez lesz: Node 11 (Leaf 'a') (Node 6 (Node 4 (Leaf 'r') (Leaf 'b')) (Node 2 (Leaf 'k') (Leaf 'd')))
//Ez kéne: Node 11 (Leaf 'a') (Node 6 (Leaf 'r') (Node 4 (Node 2 (Leaf 'k') (Leaf 'd')) (Leaf 'b')))


abrakadabra = Node 11 (Leaf 'a') (Node 6 (Node 4 (Leaf 'r') (Leaf 'b')) (Node 2 (Leaf 'k') (Leaf 'd')))
//Start = lookupCode abrakadabra 'a' == [Zero]
//Start = lookupCode abrakadabra 'b' == [One,Zero,One]
//Start = lookupCode abrakadabra 'd' == [One,One,One]
//Start = lookupCode (Leaf 'a') 'a'  == [Zero]

lookupCode :: CodeTree Char -> Code
lookupCode (Leaf a) char = if (a == char) [Zero] []
lookupCode (Node n (Leaf a) (Leaf b)) char = if (a == char) [Zero] (if (b == char) [One] [])
lookupCode (Node n (Leaf a) (Node n1 codeTree1 codeTree2)) char = if (a == char) [Zero] ((lookupCode codeTree1 char) ++ (lookupCode codeTree2 char))
lookupCode (Node n (Node n1 codeTree1 codeTree2) (Leaf a)) char = if (a == char) [One] ((lookupCode codeTree1 char) ++ (lookupCode codeTree2 char))
lookupCode (Node n codeTree1 codeTree2) char = (lookupCode codeTree1 char) ++ (lookupCode codeTree2 char)

lookupPrefix :: CodeTree Code -> Char
lookupPrefix _ _ = 'a'

encode :: String -> (CodeTree, Code)
encode str = (Leaf 'a', [])

decode :: (CodeTree, Code) -> String
decode (tree, c) = ""

/*
Start = (and (flatten allTests), allTests)
  where
    allTests =
      [ test_getFrequencies
      , test_frequencyToFrequencies
      , test_sortFrequencies
      , test_buildTree
      , test_lookupCode
      , test_lookupPrefix
      , test_encode
      , test_decode
      ]
*/

test_getFrequencies =
  [ isEmpty (getFrequencies "")
  , and (map (\x -> isMember x (getFrequencies "abrakadabra")) [('r',2),('k',1),('d',1),('b',2),('a',5)])
  , and (map (\x -> isMember x (getFrequencies "Szeretem a clean-t")) [('z',1),('t',2),('r',1),('n',1),('m',1),('l',1),('e',4),('c',1),('a',2),('S',1),('-',1),(' ',2)])
  , and (map (\x -> isMember x (getFrequencies "adadada")) (getFrequencies "dadadaa"))
  ]

test_frequencyToFrequencies =
  [
    frequencyToFrequencies [('r',2),('k',1),('d',1),('b',2),('a',5)] == [([('r',2)],2),([('k',1)],1),([('d',1)],1),([('b',2)],2),([('a',5)],5)]
  ]

test_sortFrequencies =
  [ sort (map snd (sortFrequencies [([('r',2)],2),([('d',1)],1),([('k',1)],1),([('b',2)],2),([('a',5)],5)])) == [1,1,2,2,5]
  ]

test_buildTree =
  [ buildTree [([('a',1)],1)] == Leaf 'a'
  , buildTree [([('a',1)],1), ([('b',2)],2)] == Node 3 (Leaf 'a') (Leaf 'b') || buildTree [([('a',1)],1), ([('b',2)],2)] == Node 3 (Leaf 'b') (Leaf 'a')
  , countNodes (buildTree (frequencyToFrequencies (getFrequencies "sokf�le karakterb�l �ll� sz�veg"))) == 37
  ]
    where
      countNodes (Leaf _) = 1
      countNodes (Node _ left right) = 1 + (countNodes left) + (countNodes right)

test_lookupCode =
  [ lookupCode abrakadabra 'a' == [Zero]
  , lookupCode abrakadabra 'b' == [One,Zero,One]
  , lookupCode abrakadabra 'd' == [One,One,One]
  , lookupCode (Leaf 'a') 'a'  == [Zero]
  ]
  where
    abrakadabra = Node 11 (Leaf 'a') (Node 6 (Node 4 (Leaf 'r') (Leaf 'b')) (Node 2 (Leaf 'k') (Leaf 'd')))

test_lookupPrefix =
  [ lookupPrefix abrakadabra (lookupCode abrakadabra 'a') == 'a'
  , lookupPrefix abrakadabra (lookupCode abrakadabra 'b') == 'b'
  , lookupPrefix abrakadabra (lookupCode abrakadabra 'd') == 'd'
  , lookupPrefix abrakadabra (lookupCode (Leaf 'a') 'a')  == 'a'
  ]
  where
    abrakadabra = Node 11 (Leaf 'a') (Node 6 (Node 4 (Leaf 'r') (Leaf 'b')) (Node 2 (Leaf 'k') (Leaf 'd')))

test_encode =
  [ (length o snd) (encode "abrakadabra") == 23
  , encode "aaaaa" == (Leaf 'a', [Zero,Zero,Zero,Zero,Zero])
  ]

test_decode =
  [ decode (encode "Decode function test") == "Decode function test"
  ,  decode (encode "Functional programming is fun!") == "Functional programming is fun!"
  ,  decode (abrakadabra, [Zero,One,Zero,One,One,Zero,Zero,Zero,One,One,Zero]) == "abrak"
  ]
  where
    abrakadabra = Node 11 (Leaf 'a') (Node 6 (Node 4 (Leaf 'r') (Leaf 'b')) (Node 2 (Leaf 'k') (Leaf 'd')))