okasaki

commit 805baf63a74c43052fd80c0a6a43a32e6ad7c16b
parent f55885a59ed7dea463187ddcf6ca7522cc2f624d
Author: Jared Tobin <jared@jtobin.io>
Date:   Thu, 23 Mar 2023 13:01:35 +0400

Add binomial heap skeleton.

Diffstat:
A
lib/Okasaki/Heap/Binomial.hs
 | 
43
+++++++++++++++++++++++++++++++++++++++++++
M
okasaki.cabal
 | 
3
++-

2 files changed, 45 insertions(+), 1 deletion(-)
diff --git a/lib/Okasaki/Heap/Binomial.hs b/lib/Okasaki/Heap/Binomial.hs
@@ -0,0 +1,43 @@
+{-# OPTIONS_GHC -Wall -fno-warn-unused-top-binds #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Okasaki.Heap.Binomial where
+
+import Data.Eq.Deriving (deriveEq1)
+import Data.Fix hiding (cata, ana, hylo)
+import Data.Functor.Foldable
+import Text.Show.Deriving
+
+data TreeF a r = NodeF Int a [Tree a]
+  deriving (Functor, Foldable, Traversable)
+
+type Tree a = Fix (TreeF a)
+
+$(deriveShow1 ''TreeF)
+$(deriveEq1 ''TreeF)
+
+newtype Heap a = Heap [Tree a]
+
+lef :: Heap a
+lef = Heap []
+
+nod :: Int -> a -> [Tree a] -> Tree a
+nod r a t = Fix (NodeF r a t)
+
+lin :: Ord a => Tree a -> Tree a -> Tree a
+lin s@(project -> NodeF r a c) t@(project -> NodeF _ b d)
+  | a <= b    = nod (succ r) a (t : c)
+  | otherwise = nod (succ r) b (s : d)
+
+ran :: Tree a -> Int
+ran (project -> NodeF r _ _) = r
+
+pat :: Ord a => Tree a -> Heap a -> Heap a
+pat s (Heap ts) = Heap $ case project ts of
+  Nil -> embed (Cons s (embed Nil))
+  Cons h t
+    | ran s < ran h -> embed (Cons s ts)
+    | otherwise     -> embed (Cons (lin s h) t)
+
+put :: Ord a => a -> Heap a -> Heap a
+put a = pat (nod 0 a (embed Nil))
diff --git a/okasaki.cabal b/okasaki.cabal
@@ -24,7 +24,8 @@ library
   other-modules:
     Okasaki.Orphans
   exposed-modules:
-      Okasaki.Heap.Leftist
+      Okasaki.Heap.Binomial
+    , Okasaki.Heap.Leftist
     , Okasaki.Heap.Leftist.Weighted
     , Okasaki.Map
     , Okasaki.Stack