Binomial Heap

bi-heap.hoon

|%
++  heap
  |*  a=mold
  |=  compare=$-([a a] ?)
  =>  |%
      +=  bi-tree  [val=a rank=@ud kids=(list bi-tree)]
      +=  bi-heap  (list bi-tree)
      --
  |%
  ::
  ++  link
    |=  [a=bi-tree b=bi-tree]
    ^-  bi-tree
    ::
    ?:  (compare val.a val.b)
      [val.a +(rank.a) kids=[b kids.a]]
    [val.b +(rank.b) kids=[a kids.b]]
  ::
  ++  insert-node
    |=  [n=bi-tree h=bi-heap]
    ^-  bi-heap
    ::
    ?~  h
      ~[n]
    ?:  (lth rank.n rank.i.h)
      [n h]
    $(h t.h, n (link i.h n))
  ::
  ++  find-min
    |=  [n=bi-heap]
    ^-  bi-tree
    ::  TODO: handle empty :n properly
    ::
    ?~  n
      !!
    =/  min=bi-tree  i.n
    =>  .(n `bi-heap`n)
    ::
    |-  ^-  bi-tree
    ::
    ?~  n
      min
    ::
    =?    min
        (compare val.i.n val.min)
      i.n
    ::
    ~!  n=n
    ~!  t=t.n
    $(n t.n)
  ::
  ++  meld
    |=  [x=bi-heap y=bi-heap]
    ^-  bi-heap
    ::
    ?~  x  y
    ?~  y  x
    ?:  (lth rank.i.x rank.i.y)
      [i.x $(x t.x, y t.y)]
    ?:  (gth rank.i.x rank.i.y)
      [i.y $(x t.x, y t.y)]
    (insert-node (link i.x i.y) $(x t.x, y t.y))
  ::
  ++  delete-min
    |=  h=bi-heap
    ^-  bi-heap
    ::
    =/  min-node=bi-tree  (find-min h)
    ~&  min-node=min-node
    %+  meld  (flop kids.min-node)
    %+  skip  h
    |=  t=bi-tree
    =-  ~&(match=- -)
    =(min-node t)
  --
::
++  test
  =/  h  ((heap @ud) lte)
  =/  a=bi-tree:h  [val=3 rank=0 kids=~]
  =/  b=bi-tree:h
    :+  val=4  rank=2
    ^=  kids
    :~  ^-  bi-tree:h  [val=5 rank=0 kids=~]
        ^-  bi-tree:h
        :+  val=6  rank=1
        ^=  kids  ^-  (list bi-tree:h)
        [val=7 rank=0 kids=~]~
    ==
  ::
  =/  c=bi-heap:h  [0 0 ~]~
  =/  d=bi-heap:h  (insert-node:h [2 0 ~] c)
  =/  e=bi-heap:h  (insert-node:h [1 0 ~] d)
  ::
  ~&  [c=c d=d e=e]
  ~&  (find-min:h e)
  ::
  =/  f=bi-heap:h  (meld:h d e)
  =/  g=bi-heap:h  (insert-node:h [3 0 ~] f)
  =/  i=bi-heap:h  (insert-node:h [3 0 ~] g)
  =/  j=bi-heap:h  (insert-node:h [3 0 ~] i)
  ::
  =/  k=bi-heap:h  (meld:h f i)
  ::
  ~&  [i=i k=k]
  =/  k1=bi-heap:h  (delete-min:h k)
  =/  k2=bi-heap:h  (delete-min:h k1)
  =/  k3=bi-heap:h  (delete-min:h k2)
  ::
  ~&  [k1=k1 k2=k2 k3=k3]
  %ok
--