diff --git a/Aufgabe_6/code/src/Huffman.hs b/Aufgabe_6/code/src/Huffman.hs index 5ba33bd..3f2fe7f 100755 --- a/Aufgabe_6/code/src/Huffman.hs +++ b/Aufgabe_6/code/src/Huffman.hs @@ -7,7 +7,8 @@ import Auxiliaries ( Bit (..) ) import Data.Maybe (fromMaybe) import Data.Char (toUpper) import Data.List (sort) -import Data.IntMap.Strict +import qualified Data.IntMap.Strict as IntMap +type IntMap = IntMap.IntMap type Map = Map.Map type CodingTable = Map Char [Bit] @@ -16,7 +17,7 @@ type CodingTable = Map Char [Bit] ----------------------------------------------------------------------- data Node = Leaf Char Int | Inner Node Node Int deriving (Show) -data HTree = Root Node +newtype HTree = Root Node exercise1TreeValid :: HTree exercise1TreeValid = Root (Inner (Inner (Leaf 'E' 158) (Inner (Leaf 'N' 97) (Leaf 'I' 82) 179) 337) (Inner (Inner (Leaf 'R' 77) (Leaf 'S' 67) 144) (Inner (Leaf 'T' 64) (Leaf 'A' 61) 125) 269) 606) @@ -62,11 +63,11 @@ toCodingTableList (Root node) direction = Huffman.Left -> case node of Inner left right _ -> prependToBitLists Zero (toCodingTableList (Root left) Huffman.Left) ++ prependToBitLists Zero (toCodingTableList (Root right) Huffman.Right) - Leaf char _ -> prependToBitLists Zero [((toUpper char),[])] + Leaf char _ -> prependToBitLists Zero [(char,[])] Huffman.Right -> case node of Inner left right _ -> prependToBitLists One (toCodingTableList (Root left) Huffman.Left) ++ prependToBitLists One (toCodingTableList (Root right) Huffman.Right) - Leaf char _ -> prependToBitLists One [((toUpper char),[])] + Leaf char _ -> prependToBitLists One [(char,[])] -- Prepends given Bit in front of each BitList inside the tuples of given list. prependToBitLists :: Bit -> [(Char, BitList)] -> [(Char, BitList)] @@ -77,10 +78,10 @@ prependToBitLists bitToPrepend = Prelude.map (\(char, bitList) -> (char, bitToPr ----------------------------------------------------------------------- treeValidCodingTable :: CodingTable -treeValidCodingTable = (Map.fromList [('E',[Zero,Zero]), ('N',[Zero,One,Zero]), ('I',[Zero,One,One]), ('R',[One,Zero,Zero]), ('S',[One,Zero,One]), ('T',[One,One,Zero]), ('A',[One,One,One])]) +treeValidCodingTable = Map.fromList [('E',[Zero,Zero]), ('N',[Zero,One,Zero]), ('I',[Zero,One,One]), ('R',[One,Zero,Zero]), ('S',[One,Zero,One]), ('T',[One,One,Zero]), ('A',[One,One,One])] treeOnlyLeafCodingTable :: CodingTable -treeOnlyLeafCodingTable = (Map.fromList [('A',[Zero])]) +treeOnlyLeafCodingTable = Map.fromList [('A',[Zero])] ----------------------------------------------------------------------- -- Aufgabe 5 @@ -88,8 +89,8 @@ treeOnlyLeafCodingTable = (Map.fromList [('A',[Zero])]) encode :: CodingTable -> String -> [Bit] encode table input = - case Prelude.map toUpper input of - (firstChar:rest) -> (encodeChar table firstChar) ++ (encode table rest) + case input of + (firstChar:rest) -> encodeChar table firstChar ++ encode table rest [] -> [] encodeChar :: CodingTable -> Char -> [Bit] @@ -129,7 +130,7 @@ decode tree encodedString = walkTillLeaf :: HTree -> [Bit] -> Int -> (Int, String) walkTillLeaf (Root tree) directions step = case tree of - Leaf char _ -> (step, [toUpper char]) + Leaf char _ -> (step, [char]) Inner left right _ -> case directions of (first:rest) -> @@ -143,7 +144,7 @@ walkTillLeaf (Root tree) directions step = ----------------------------------------------------------------------- instance Eq Node where - (Leaf char1 frequency1) == (Leaf char2 frequency2) = (toUpper char1) == (toUpper char2) && frequency1 == frequency2 + (Leaf char1 frequency1) == (Leaf char2 frequency2) = toUpper char1 == toUpper char2 && frequency1 == frequency2 (Leaf _ _) == (Inner {}) = False (Inner {}) == (Leaf _ _) = False (Inner node11 node12 frequency1) == (Inner node21 node22 frequency2) = node11 == node21 && node12 == node22 && frequency1 == frequency2 @@ -161,26 +162,86 @@ instance Ord Node where buildHTree :: String -> HTree buildHTree input = let charFrequencyMap = combineFrequencies (addOccurences input) - in toHTree (toHTreeNodes charFrequencyMap) + in toHTree (toHTreeIntMap (toHTreeNodes charFrequencyMap)) (Root (Leaf 'A' 0)) --map ['r','a','i','n','a'] becomes [('r',1),('a',1),('i',1),('n',1),('a',1)] addOccurences :: String -> [(Char,Int)] -addOccurences characters = Prelude.map (\char -> (toUpper char,1)) characters +addOccurences = Prelude.map (\char -> (char,1)) --fromListWith (+) [('r',1),('a',1),('i',1),('n',1),('a',1)] becomes [('r',1),('a',2),('i',1),('n',1)] combineFrequencies :: [(Char,Int)] -> Map Char Int -combineFrequencies charPairs = Map.fromListWith (+) charPairs +combineFrequencies = Map.fromListWith (+) -toHTreeNodes :: Map Char Int -> [Node] +toHTreeNodes :: Map Char Int -> [(Int, [HTree])] toHTreeNodes frequenciesMap = let charFrequenciesList = Map.toList frequenciesMap - in sort (Prelude.map (\(char,frequency) -> Leaf char frequency) charFrequenciesList) + in Prelude.map (\(char,frequency) -> (frequency, [Root (Leaf char frequency)])) charFrequenciesList --- divide and conquer -toHTree :: [Node] -> HTree -toHTree = undefined +toHTreeIntMap :: [(Int, [HTree])] -> IntMap [HTree] +toHTreeIntMap = IntMap.fromListWith (++) -workList :: Data.IntMap.Strict.Key [HTree] +toHTree :: IntMap [HTree] -> HTree -> HTree +toHTree map lastTree = + let Root lastTreeRoot = lastTree + in case lastTreeRoot of + Leaf _ lastTreeRootFrequency -> + case IntMap.minView map of + Just (minimums, newMap) -> + case minimums of + [] -> error "Impossible case" + [x] -> + let Root xRoot = x + in case xRoot of + Leaf _ xFrequency -> + if lastTreeRootFrequency < xFrequency + then toHTree newMap (Root (Inner lastTreeRoot xRoot (lastTreeRootFrequency + xFrequency))) + else toHTree newMap (Root (Inner xRoot lastTreeRoot (lastTreeRootFrequency + xFrequency))) + Inner _ _ xFrequency -> + if lastTreeRootFrequency < xFrequency + then toHTree newMap (Root (Inner lastTreeRoot xRoot (lastTreeRootFrequency + xFrequency))) + else toHTree newMap (Root (Inner xRoot lastTreeRoot (lastTreeRootFrequency + xFrequency))) + (x:y:rest) -> + let Root xRoot = x + Root yRoot = y + in case xRoot of + Leaf _ xFrequency -> + if lastTreeRootFrequency < xFrequency + then toHTree (IntMap.insert xFrequency rest newMap) (Root (Inner lastTreeRoot (Inner xRoot yRoot (xFrequency * 2)) (lastTreeRootFrequency + (xFrequency * 2)))) + else toHTree (IntMap.insert xFrequency rest newMap) (Root (Inner (Inner xRoot yRoot (xFrequency * 2)) lastTreeRoot (lastTreeRootFrequency + (xFrequency * 2)))) + _ -> lastTree + Inner _ _ lastTreeRootFrequency -> + case IntMap.minView map of + Just (minimums, newMap) -> + case minimums of + [] -> error "Impossible case" + [x] -> + let Root xRoot = x + in case xRoot of + Leaf _ xFrequency -> + if lastTreeRootFrequency < xFrequency + then toHTree newMap (Root (Inner lastTreeRoot xRoot (lastTreeRootFrequency + xFrequency))) + else toHTree newMap (Root (Inner xRoot lastTreeRoot (lastTreeRootFrequency + xFrequency))) + Inner _ _ xFrequency -> + if lastTreeRootFrequency < xFrequency + then toHTree newMap (Root (Inner lastTreeRoot xRoot (lastTreeRootFrequency + xFrequency))) + else toHTree newMap (Root (Inner xRoot lastTreeRoot (lastTreeRootFrequency + xFrequency))) + (x:y:rest) -> + let Root xRoot = x + Root yRoot = y + in case xRoot of + Leaf _ xFrequency -> + if lastTreeRootFrequency < xFrequency + then toHTree (IntMap.insert xFrequency rest newMap) (Root (Inner lastTreeRoot (Inner xRoot yRoot (xFrequency * 2)) (lastTreeRootFrequency + (xFrequency * 2)))) + else toHTree (IntMap.insert xFrequency rest newMap) (Root (Inner (Inner xRoot yRoot (xFrequency * 2)) lastTreeRoot (lastTreeRootFrequency + (xFrequency * 2)))) + _ -> lastTree + +--[(0,'i'),(3,'j'),(0,'f')] +--minView 0 -> [(0,'i'),(0,'f')] + +--minView +--kleinster +--minView :: IntMap a -> Maybe (a, IntMap a) +--O(log n). Retrieves the minimal key of the map, and the map stripped of that element, or Nothing if passed an empty map. ----------------------------------------------------------------------- -- Aufgabe 7 Test