Binomial heaps

A free binary tree container is defined according to

Object subclass: #CTBinomialHeap
	instanceVariableNames: 'representation'
	classVariableNames: ''
	package: 'Containers-BinomialHeap'

and its responsibility is to direct and manage objects of types

Object subclass: #CTBinomialTree
	instanceVariableNames: 'content children'
	classVariableNames: ''
	package: 'Containers-BinomialHeap'

as actual representation for the underlying structure. The simpler container is the empty tree,

where

"CTBinomialHeap class, protocol requirements"
empty

   ^ self new
        representation: nil;
        yourself

In general, we use collections and then build trees out of them. On one hand, using ArrayedCollection objects

where

"CTBinomialHeapTest, protocol tests"
tree: aCollection

   ^ aCollection asBinomialHeap

"Collection, protocol *Containers-BinomialHeap"
asBinomialHeap

   ^ self asBinaryTree: CTBinomialHeap

and

"CTBinomialHeap class, protocol instance creation"
withArrayedCollection: aCollection

   ^ aCollection ifEmpty: [ self empty ] ifNotEmpty: [ 
        self new yourself: [ :tree | 
           tree representation: (aCollection
                  bisect: [ :l :r | tree merge: l with: r ]
                  baseBlock: [ :each | 0 -> (CTBinomialTree leaf: each) ~~> nil ]) ] ]

uses

"CTBinomialHeap, protocol adding"
merge: trees with: otherTrees

   ^ trees ifNil: [ otherTrees ] ifNotNil: [ 
        otherTrees ifNil: [ trees ] ifNotNil: [ 
           | aTree anotherTree allButFirstTrees allButFirstOtherTrees aRank anotherRank |
           "Getting rests of both collections of trees to merge."
           allButFirstTrees := trees nextLink.
           allButFirstOtherTrees := otherTrees nextLink.

           "Getting current topmost trees."
           aTree := trees value.
           anotherTree := otherTrees value.

           "Getting ranks."
           aRank := aTree key.
           anotherRank := anotherTree key.

           "Rank comparison via `#key`."
           aRank < anotherRank
              ifTrue: [ 
              aTree ~~> (self merge: allButFirstTrees with: otherTrees) ]
              ifFalse: [ 
                 anotherRank < aRank
                    ifTrue: [ 
                    anotherTree
                    ~~> (self merge: trees with: allButFirstOtherTrees) ]
                    ifFalse: [ 
                       | binomialTree mergedTrees |
                       "Invariant: both `aTree` and `anotherTree` have the *same* rank."
                       binomialTree := aTree value linkBinomialTree:
                                          anotherTree value.
                       mergedTrees := self
                                         merge: allButFirstTrees
                                         with: allButFirstOtherTrees.
                       self pushTree: aRank + 1 -> binomialTree onTrees: mergedTrees ] ] ] ]

that delegates on both

"CTBinomialHeap, protocol adding"
pushTree: anAssociation onTrees: trees

   ^ trees ifNil: [ anAssociation ~~> trees ] ifNotNil: [ 
        | carAssociation rank |
        rank := anAssociation key.
        carAssociation := trees value.
        rank < carAssociation key
           ifTrue: [ anAssociation ~~> trees ]
           ifFalse: [ 
              self
                 pushTree: rank + 1
                    ->
                    (anAssociation value linkBinomialTree: carAssociation value)
                 onTrees: trees nextLink ] ]

and

"CTBinomialTree, protocol as yet unclassified"
linkBinomialTree: aTree

   | x |
   x := aTree content.
   ^ content < x
        ifTrue: [ self class node: content children: aTree ~~> children ]
        ifFalse: [ self class node: x children: self ~~> aTree children ]

to finally build the tree. On the other hand, using Collection objects

where

"CTBinomialHeap class, protocol instance creation"
withCollection: aCollection

   ^ aCollection
        inject: self empty
        into: [ :aBinaryTree :each | aBinaryTree push: each ]

uses

"CTBinomialHeap, protocol adding"
push: x

   representation := self
                        pushTree: 0 -> (CTBinomialTree leaf: x)
                        onTrees: representation

repeatedly. The two cases above can be redone with shuffled collections, both

and

respectively.