Init with batchedqueue, start of dequeue

Author: ThinkThoughtThunk

BatchedDeque.hs

@@ -0,0 +1,44 @@
+module BatchedDeque(BatchedDeque(..)) where
+
+import Prelude hiding (head, tail)
+import Deque
+{-
+empty   :: q a
+isEmpty :: q a -> Bool
+
+-- For working with front of queue
+cons    :: a -> q a -> q a
+head    :: q a -> a
+tail    :: q a -> q a
+
+-- For working with end of queue
+snoc    :: q a -> a -> q a
+last    :: q a -> a
+init    :: q a -> q a
+-}
+
+data BatchedDeque a = BD [a] [a]
+
+split (BD f r)
+  | null f = BD ()
+    where reversed x = reverse x
+
+instance Deque BatchedDeque where
+  -- Route r nodes to front when f is empty
+  empty = BD [] []
+  isEmpty (BD f r) = null f && null r
+
+  cons x (BD f r) = BD (x:f) r
+
+  head (BD []     r) = error "empty queue"
+  head (BD (f:fs) r) = f
+
+  tail (BD []     r) = error "empty queue"
+  tail (BD [f]    r) = BD (reverse r) []
+  tail (BD (f:fs) r) = BD fs r
+
+  snoc (BD [] r) x = BD [x] r
+  snoc (BD f  r) x = BD f (x:r)
+
+  last (BD [] r) = error "empty queue"
+  last (BD )

BatchedQueue.hs

@@ -0,0 +1,21 @@
+module BatchedQueue where
+
+import Prelude hiding (head, tail)
+import Queue
+
+data BatchedQueue a = BQ [a] [a]
+  deriving (Show, Eq)
+
+instance Queue BatchedQueue where
+  empty = BQ [] []
+  isEmpty (BQ f r) = null f
+
+  snoc (BQ [] r) x = BQ [x] r
+  snoc (BQ f  r) x = BQ f   (x:r)
+
+  head (BQ [] _) = error "empty queue"
+  head (BQ (x:xs) r) = x
+
+  tail (BQ [] _) = error "empty queue"
+  tail (BQ [x] r) = BQ (reverse r) []
+  tail (BQ (x:xs) r) = BQ xs r

BinomialHeap.hs

@@ -0,0 +1,45 @@
+module BinomialHeap (BinomialHeap(..)) where
+
+import Heap
+
+data Tree a = Node Int a [Tree a]
+data BinomialHeap a = BH [Tree a]
+
+rank (Node r x c) = r
+root (Node r x c) = x
+
+link t1@(Node r x1 c1) t2@(Node _ x2 c2)
+  | x1 <= x2  = Node (r + 1) x1 (t2 : c1)
+  | otherwise = Node (r + 1) x2 (t1 : c2)
+
+insertTree t [] = [t]
+insertTree t ts@(t' : ts')
+  | rank t < rank t' = t : ts
+  | otherwise        = insertTree (link t t') ts'
+
+merge ts1 [] = ts1
+merge [] ts2 = ts2
+merge ts1@(t1 : ts1') ts2@(t2 : ts2')
+  | rank t1 < rank t2 = t1 : merge ts1' ts2
+  | rank t2 < rank t1 = t2 : merge ts1' ts2
+  | otherwise         = insertTree (link t1 t2) (mrg ts1' ts2')
+
+removeMinTree [] = error "empty heap"
+removeMinTree [t] = (t, [])
+removeMinTree (t:ts)
+  | root t < root t' = (t, ts)
+  | otherwise        = (t', t : ts')
+    where (t', ts') = removeMinTree ts
+
+instance Heap Binomial Heap where
+  empty = BH []
+  isEmpty (BH ts) = null ts
+
+  insert x (BH ts) = BH (insTree (Node 0 x []) ts)
+  merge (BH ts1) (BH ts2) = BH (merge ts1 ts2)
+
+  findMin (BH ts) = root t
+    where (t, _) = removeMinTree ts
+
+  deleteMin (BH ts) = BH (merge (reverse ts1) ts2)
+    where (Node _ x ts1, ts2) = removeMinTree ts

Deque.hs

@@ -0,0 +1,15 @@
+module Deque (Deque(..)) where
+
+class Deque q where
+  empty   :: q a
+  isEmpty :: q a -> Bool
+
+  -- For working with front of queue
+  cons    :: a -> q a -> q a
+  head    :: q a -> a
+  tail    :: q a -> q a
+
+  -- For working with end of queue
+  snoc    :: q a -> a -> q a
+  last    :: q a -> a
+  init    :: q a -> q a

Heap.hs

@@ -0,0 +1,11 @@
+module Heap (Heap(..)) where
+
+class Heap h where
+  empty :: Ord a => h a
+  isEmpty :: Ord a => h a -> Bool
+
+  insert :: Ord a => a -> h a -> h a
+  merge :: Ord a => h a -> h a -> h a
+
+  findMin :: Ord a => h a -> a
+  deleteMin :: Ord a => h a -> h a

LeftistHeap.hs

@@ -0,0 +1,34 @@
+module LeftistHeap (LeftistHeap(..)) where
+
+import Heap
+data LeftistHeap a = E
+                   | T Int a (LeftistHeap a) (LeftistHeap a)
+
+-- The rank is defined as the distance from a node to an (empty) leaf
+rank E = 0
+rank (T r _ _ _) = r
+
+-- makeT is a helper that checks the rank of the left and right subtrees.
+-- If the left subtree has a higher rank, it returns a new tree with a rank
+-- incremented from the left subtree.
+makeT x a b | rank a >= rank b = T (rank b + 1) x a b
+            | otherwise        = T (rank a + 1) x b a
+
+instance Heap LeftistHeap where
+  empty = E
+  isEmpty E = True
+  isEmpty _ = False
+
+  insert x h = merge (T 1 x E E) h
+
+  merge h E = h
+  merge E h = h
+  merge h1@(T _ x a1 b1) h2@(T _ y a2 b2)
+    | x <= y    = makeT x a1 (merge b1 h2)
+    | otherwise = makeT y a2 (merge h1 b2)
+
+  findMin E = error "empty heap"
+  findMin (T _ x a b) = x
+
+  deleteMin E = error "empty heap"
+  deleteMin (T _ x a b) = merge a b

Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import BatchedQueue
+
+main :: IO ()
+main = putStrLn "Hello, Haskell!"

Queue.hs

@@ -0,0 +1,11 @@
+module Queue (Queue(..)) where
+
+import Prelude hiding (head, tail)
+
+class Queue q where
+  empty :: q a
+  isEmpty :: q a -> Bool
+
+  snoc :: q a -> a -> q a
+  head :: q a -> a
+  tail :: q a -> q a

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain