" GNU Smalltalk implementation of Pairing Heaps
  $Id: heap.st,v 1.5 2024/02/16 16:25:12 oj14ozun Exp $
  https://wwwcip.cs.fau.de/~oj14ozun/src+etc/heap.st
"

Object subclass: #Tree.

Tree subclass: EmptyTree [
    meld: other [ ^ other ]
    empty [ ^ true ]
]

Tree subclass: PairingTree [
    | elem subs |

    PairingTree class >> new: val [
        <category: 'instance creation'>
        | r |
        r := super new.
        r init: val.
        ^ r
    ]

    init: val [
        <category: 'initialisation'>
        elem := val.
        subs := OrderedCollection new.
    ]

    meld: other [
        (other isMemberOf: EmptyTree) "FIXME: Avoid reflection"
            ifTrue: [ ^ self ].

        (elem < (other value))
            ifTrue: [ self extend: other. ^ self ]
            ifFalse: [ other extend: self. ^ other ].
    ]
    extend: tree [ subs addFirst: tree. ]

    merge [
        | n head neck |
        n := subs size.

        (n = 0) ifTrue: [ ^ EmptyTree new ].
        (n = 1) ifTrue: [ ^ subs removeFirst ].

        head := subs removeFirst.
        neck := subs removeFirst.
        ^ head meld: (neck meld: (self merge))
    ]

    value [ ^ elem ]
    empty [ ^ false ]
]

Object subclass: PairingHeap [
    | tree |

    PairingHeap class >> new [
        <category: 'instance creation'>
        | r |
        r := super new.
        r init.
        ^ r
    ]
    init [
        <category: 'initialisation'>
        tree := EmptyTree new.
    ]

    findMin [ ^ tree value ]
    deleteMin [ tree := tree merge ]
    insert: value [
        tree := tree meld: (PairingTree new: value).
        ^ value
    ]

    pop [
        | min |
        min := self findMin.
        self deleteMin.
        ^ min
    ]

    empty [ ^ tree empty ]
]