Studium_Angewandte_Informatik_Bachelor/vertiefungsrichtung_anwendungsentwicklung_haskell
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Aufgabe 6.7

Browse Source
This commit is contained in:
WickedJack99
2024-01-15 19:18:59 +01:00
parent a5446adafd
commit 234dce215c
1 changed files with 80 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

99
Aufgabe_6/code/src/Huffman.hs
View File

@@ -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