module Huffman where


import System( getArgs )

import Data.Char
import Iso
import Games
import BasicGames

type Set a = [a]      

-- A simple priority queue, with integers corresponding 
-- to frequencies; element with smallest frequency first 
type PQ a = [(Int,a)] 

-- Add a *new* item to a priority queue
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

-- Update the frequency of an existing item in a priority queue
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


-- A game for Huffman 
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))


-- Static precomputed Huffman game 
sHuffGame :: PQ Char -> Game [Char] 
sHuffGame pq = listGame $ huffGame pq

-- Dynamic Huffman game 
dHuffGame :: PQ Char -> Game [Char] 
dHuffGame pq = Split listIso unitGame $
               depGame (huffGame pq) (dHuffGame . updPQ pq) 



-- Let's save some more bits 
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] 
        -- Precondition: n = length lst
        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 ]