module Huffman where
import System( getArgs )
import Data.Char
import Iso
import Games
import BasicGames
type Set a = [a]
type PQ a = [(Int,a)]
addItem :: Int -> a -> PQ a -> PQ a
addItem n x [] = [(n,x)]
addItem n x q@((n1,x1):qrest)
| n < n1 = (n,x) : q
| otherwise = (n1,x1) : addItem n x qrest
updPQ :: Eq a => PQ a -> a -> PQ a
updPQ ((n,x):rest) y
| y == x = addItem (n+1) x rest
| otherwise = (n,x) : updPQ rest y
huff :: Eq a => PQ (Set a, Game a) -> Game a
huff [(_,(_,g))] = g
huff ((w1,(s1,g1)):(w2,(s2,g2)):wgs)
= huff $ addItem (w1+w2) (s1++s2, Split (splitIso (\n -> elem n s1)) g1 g2) wgs
huffGame :: Eq a => PQ a -> Game a
huffGame pq = huff $ map (\(i,x) -> (i,([x], constGame x))) pq
charHuffGame :: Game Char
charHuffGame = huffGame $ uniform ascii_chars
ascii_chars = map chr [32..126]
uniform = map (\x -> (1,x))
sHuffGame :: PQ Char -> Game [Char]
sHuffGame pq = listGame $ huffGame pq
dHuffGame :: PQ Char -> Game [Char]
dHuffGame pq = Split listIso unitGame $
depGame (huffGame pq) (dHuffGame . updPQ pq)
vecHuffGame :: Nat -> PQ Char -> Game [Char]
vecHuffGame 0 pq = constGame []
vecHuffGame (n+1) pq = depGame (huffGame pq) (vecHuffGame n . updPQ pq) +> nonemptyIso
lengthHuffGame :: PQ Char -> Game (Nat,[Char])
lengthHuffGame pq = depGame binNatGame (\n -> vecHuffGame n pq)
dHuffGame' pq = lengthHuffGame pq +> Iso h j
where h :: [t] -> (Nat,[t])
h lst = (length lst, lst)
j :: (Nat,[t]) -> [t]
j (n,lst) = lst
prodPQ :: PQ a -> PQ b -> PQ (a,b)
prodPQ p q = [ (m*n,(a,b)) | (m,a) <- p, (n,b) <- q ]