module Util.Huffman(
huffmanFold
) where
import Util.Queue
huffmanFold :: Ord a => (a -> a -> a) -> [a] -> a
huffmanFold :: (a -> a -> a) -> [a] -> a
huffmanFold a -> a -> a
op [a]
l =
let
pointedList :: PointedList a
pointedList = [a] -> PointedList a
forall a. [a] -> PointedList a
pointList [a]
l
phase1 :: PointedList a -> a
phase1 PointedList a
pointedList =
case PointedList a -> Maybe (a, PointedList a)
forall a. PointedList a -> Maybe (a, PointedList a)
removePointed PointedList a
pointedList of
Maybe (a, PointedList a)
Nothing -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"huffmanFold requires a non-empty list"
Just (a
a1,PointedList a
pointedList2) ->
case PointedList a -> Maybe (a, PointedList a)
forall a. PointedList a -> Maybe (a, PointedList a)
removePointed PointedList a
pointedList2 of
Maybe (a, PointedList a)
Nothing -> a
a1
Just (a
a2,PointedList a
pointedList3) ->
case PointedList a -> a -> Either (Queue a) (PointedList a)
forall a.
Ord a =>
PointedList a -> a -> Either (Queue a) (PointedList a)
insertAndMovePointer PointedList a
pointedList3 (a -> a -> a
op a
a1 a
a2) of
Right PointedList a
pointedList4 -> PointedList a -> a
phase1 PointedList a
pointedList4
Left Queue a
queue -> Queue a -> a
phase2 Queue a
queue
phase2 :: Queue a -> a
phase2 Queue a
queue =
case Queue a -> Maybe (a, Queue a)
forall a. Queue a -> Maybe (a, Queue a)
removeQ Queue a
queue of
Just (a
a1,Queue a
queue2) ->
case Queue a -> Maybe (a, Queue a)
forall a. Queue a -> Maybe (a, Queue a)
removeQ Queue a
queue2 of
Just (a
a2,Queue a
queue3) ->
Queue a -> a
phase2 (Queue a -> a -> Queue a
forall a. Queue a -> a -> Queue a
insertQ Queue a
queue3 (a -> a -> a
op a
a1 a
a2))
Maybe (a, Queue a)
Nothing -> a
a1
in
PointedList a -> a
phase1 PointedList a
pointedList
data PointedList a = PointedList (Queue a) [a]
instance Show a => Show (PointedList a) where
show :: PointedList a -> [Char]
show (PointedList Queue a
queue [a]
l) = ([a], [a]) -> [Char]
forall a. Show a => a -> [Char]
show (Queue a -> [a]
forall a. Queue a -> [a]
queueToList Queue a
queue, [a]
l)
pointList :: [a] -> PointedList a
pointList :: [a] -> PointedList a
pointList [a]
l = Queue a -> [a] -> PointedList a
forall a. Queue a -> [a] -> PointedList a
PointedList Queue a
forall a. Queue a
emptyQ [a]
l
removePointed :: PointedList a -> Maybe (a,PointedList a)
removePointed :: PointedList a -> Maybe (a, PointedList a)
removePointed (PointedList Queue a
queue [a]
list) =
case Queue a -> Maybe (a, Queue a)
forall a. Queue a -> Maybe (a, Queue a)
removeQ Queue a
queue of
Maybe (a, Queue a)
Nothing ->
case [a]
list of
[] -> Maybe (a, PointedList a)
forall a. Maybe a
Nothing
a
a:[a]
list' -> (a, PointedList a) -> Maybe (a, PointedList a)
forall a. a -> Maybe a
Just (a
a,Queue a -> [a] -> PointedList a
forall a. Queue a -> [a] -> PointedList a
PointedList Queue a
forall a. Queue a
emptyQ [a]
list')
Just (a
a,Queue a
queue') -> (a, PointedList a) -> Maybe (a, PointedList a)
forall a. a -> Maybe a
Just (a
a,Queue a -> [a] -> PointedList a
forall a. Queue a -> [a] -> PointedList a
PointedList Queue a
queue' [a]
list)
insertAndMovePointer :: Ord a => PointedList a -> a
-> Either (Queue a) (PointedList a)
insertAndMovePointer :: PointedList a -> a -> Either (Queue a) (PointedList a)
insertAndMovePointer (PointedList Queue a
queue [a]
list) a
a =
case [a]
list of
[] -> Queue a -> Either (Queue a) (PointedList a)
forall a b. a -> Either a b
Left (Queue a -> a -> Queue a
forall a. Queue a -> a -> Queue a
insertQ Queue a
queue a
a)
a
a2:[a]
list' ->
if a
a2a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
a
then PointedList a -> a -> Either (Queue a) (PointedList a)
forall a.
Ord a =>
PointedList a -> a -> Either (Queue a) (PointedList a)
insertAndMovePointer
(Queue a -> [a] -> PointedList a
forall a. Queue a -> [a] -> PointedList a
PointedList (Queue a -> a -> Queue a
forall a. Queue a -> a -> Queue a
insertQ Queue a
queue a
a2) [a]
list') a
a
else
PointedList a -> Either (Queue a) (PointedList a)
forall a b. b -> Either a b
Right (Queue a -> [a] -> PointedList a
forall a. Queue a -> [a] -> PointedList a
PointedList (Queue a -> a -> Queue a
forall a. Queue a -> a -> Queue a
insertQ Queue a
queue a
a) [a]
list)