module Huffman where

--import qualified Data.List as List

import qualified Data.Map.Strict as Map
import Auxiliaries ( Bit (..) )
import Data.Maybe (fromMaybe)
import Data.Char (toUpper)
import Data.List (sort)
import qualified Data.IntMap.Strict as IntMap
type IntMap = IntMap.IntMap
type Map = Map.Map
type CodingTable = Map Char [Bit]

-----------------------------------------------------------------------
-- Aufgabe 2
-----------------------------------------------------------------------

data Node = Leaf Char Int | Inner Node Node Int deriving (Show)
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)

exercise1TreeInvalid :: HTree
exercise1TreeInvalid = Root (Inner (Leaf 'A' 21) (Leaf 'B' 20) 42)

-----------------------------------------------------------------------
-- Aufgabe 3
-----------------------------------------------------------------------

isConsistent :: HTree -> Bool
isConsistent (Root node) =
    case node of
        Leaf _ _ -> True
        Inner left right frequency ->
            case left of
                Leaf _ leftFrequency ->
                    case right of
                        Leaf _ rightFrequency -> frequency == leftFrequency + rightFrequency
                        Inner _ _ rightFrequency -> frequency == leftFrequency + rightFrequency && isConsistent (Root right)
                Inner _ _ leftFrequency ->
                    case right of
                        Leaf _ rightFrequency -> frequency == leftFrequency + rightFrequency && isConsistent (Root left)
                        Inner _ _ rightFrequency -> frequency == leftFrequency + rightFrequency && isConsistent (Root left) && isConsistent (Root right)

-----------------------------------------------------------------------
-- Aufgabe 4
-----------------------------------------------------------------------

data Direction = Left | Right
type BitList = [Bit]

toCodingTable :: HTree -> CodingTable
toCodingTable (Root node) =
    case node of
        Leaf char _ -> Map.singleton char [Zero]
        Inner left right _ -> Map.union (Map.fromList (toCodingTableList (Root left) Huffman.Left)) (Map.fromList (toCodingTableList (Root right) Huffman.Right)) 

toCodingTableList :: HTree -> Direction -> [(Char,BitList)]
toCodingTableList (Root node) direction =
    case direction of
        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 [(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 [(char,[])]

-- Prepends given Bit in front of each BitList inside the tuples of given list.
prependToBitLists :: Bit -> [(Char, BitList)] -> [(Char, BitList)]
prependToBitLists bitToPrepend = Prelude.map (\(char, bitList) -> (char, bitToPrepend : bitList))

-----------------------------------------------------------------------
-- Aufgabe 4 Test Data
-----------------------------------------------------------------------

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])]

treeOnlyLeafCodingTable :: CodingTable
treeOnlyLeafCodingTable = Map.fromList [('A',[Zero])]

-----------------------------------------------------------------------
-- Aufgabe 5
-----------------------------------------------------------------------

encode :: CodingTable -> String -> [Bit]
encode table input =
    case input of
        (firstChar:rest) -> encodeChar table firstChar ++ encode table rest
        [] -> []

encodeChar :: CodingTable -> Char -> [Bit]
encodeChar table char = fromMaybe [] (Map.lookup char table)

-----------------------------------------------------------------------
-- Aufgabe 5 Test Data
-----------------------------------------------------------------------

codingTableForTesting :: CodingTable
codingTableForTesting = toCodingTable exercise1TreeValid

enteEncoded :: BitList
enteEncoded = [Zero,Zero, Zero,One,Zero, One,One,Zero, Zero,Zero]

erenEncoded :: BitList
erenEncoded = [Zero,Zero, One,Zero,Zero, Zero,Zero, Zero,One,Zero]

startEncoded :: BitList
startEncoded = [One,Zero,One, One,One,Zero, One,One,One, One,Zero,Zero, One,One,Zero]

rainEncoded :: BitList
rainEncoded = [One,Zero,Zero, One,One,One, Zero,One,One, Zero,One,Zero]

-----------------------------------------------------------------------
-- Aufgabe 6
-----------------------------------------------------------------------

decode :: HTree -> [Bit] -> String
decode tree encodedString =
    case encodedString of
        [] -> []
        _ -> 
            let (steps, char) = walkTillLeaf tree encodedString 0
                in char ++ decode tree (drop steps encodedString)

walkTillLeaf :: HTree -> [Bit] -> Int -> (Int, String)
walkTillLeaf (Root tree) directions step =
    case tree of
        Leaf char _ -> (step, [char])
        Inner left right _ ->
            case directions of
                (first:rest) ->
                    case first of
                        Zero -> walkTillLeaf (Root left) rest (step + 1)
                        One -> walkTillLeaf (Root right) rest (step + 1)
                [] -> (0,"")

-----------------------------------------------------------------------
-- Aufgabe 7
-----------------------------------------------------------------------

instance Eq Node where
    (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

instance Ord Node where
    (Leaf _ frequency1) >= (Leaf _ frequency2) = frequency1 >= frequency2
    (Leaf _ frequency1) >= (Inner _ _ frequency2) = frequency1 >= frequency2
    (Inner _ _ frequency1) >= (Leaf _ frequency2) = frequency1 >= frequency2
    (Inner _ _ frequency1) >= (Inner _ _ frequency2) = frequency1 >= frequency2
    (Leaf _ frequency1) <= (Leaf _ frequency2) = frequency1 <= frequency2
    (Leaf _ frequency1) <= (Inner _ _ frequency2) = frequency1 <= frequency2
    (Inner _ _ frequency1) <= (Leaf _ frequency2) = frequency1 <= frequency2
    (Inner _ _ frequency1) <= (Inner _ _ frequency2) = frequency1 <= frequency2

buildHTree :: String -> HTree
buildHTree input =
    let charFrequencyMap = combineFrequencies (addOccurences input)
        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 = 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 = Map.fromListWith (+)

toHTreeNodes :: Map Char Int -> [(Int, [HTree])]
toHTreeNodes frequenciesMap = 
    let charFrequenciesList = Map.toList frequenciesMap
        in Prelude.map (\(char,frequency) -> (frequency, [Root (Leaf char frequency)])) charFrequenciesList

toHTreeIntMap :: [(Int, [HTree])] -> IntMap [HTree]
toHTreeIntMap = IntMap.fromListWith (++)

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

nodeList :: [Node]
nodeList = [Leaf 'R' 4, Leaf 'A' 3, Leaf 'I' 2, Leaf 'N' 1]