Jump to content

Fibonacci heap

From Rosetta Code
Fibonacci heap is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
This page uses content from Wikipedia. The original article was at Fibonacci heap. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance)


Task
  • Implement queue operations for Fibonacci heaps. Where H is heap, x node with data value, k integer.
  • Operations:
    • MakeHeap() - create new empty Fibonacci heap
    • Insert(H,x) - insert new element x into heap H
    • Union(H1, H2) - union heap H1 and heap H2
    • Minimum(H) - return minimum value from heap H
    • ExtractMin(H) - (or DeleteMin(H)) - return minimum value from heap H and remove it from heap
    • DecreaseKey(H,x,k) - decrease value of element x in heap H to value k
    • Delete(H,x) - remove element x from heap H



C++ 

template <class V> class FibonacciHeap;

template <class V> struct node {
private:
	node<V>* prev;
	node<V>* next;
	node<V>* child;
	node<V>* parent;
	V value;
	int degree;
	bool marked;
public:
	friend class FibonacciHeap<V>;
	node<V>* getPrev() {return prev;}
	node<V>* getNext() {return next;}
	node<V>* getChild() {return child;}
	node<V>* getParent() {return parent;}
	V getValue() {return value;}
	bool isMarked() {return marked;}

	bool hasChildren() {return child;}
	bool hasParent() {return parent;}
};

template <class V> class FibonacciHeap {
protected:
	node<V>* heap;
public:

	FibonacciHeap() {
		heap=_empty();
	}
	virtual ~FibonacciHeap() {
		if(heap) {
			_deleteAll(heap);
		}
	}
	node<V>* insert(V value) {
		node<V>* ret=_singleton(value);
		heap=_merge(heap,ret);
		return ret;
	}
	void merge(FibonacciHeap& other) {
		heap=_merge(heap,other.heap);
		other.heap=_empty();
	}

	bool isEmpty() {
		return heap==NULL;
	}

	V getMinimum() {
		return heap->value;
	}

	V removeMinimum() {
		node<V>* old=heap;
		heap=_removeMinimum(heap);
		V ret=old->value;
		delete old;
		return ret;
	}

	void decreaseKey(node<V>* n,V value) {
		heap=_decreaseKey(heap,n,value);
	}

	node<V>* find(V value) {
		return _find(heap,value);
	}

	void display() const {	// function code adapted from GO code just below C++
		node<V>* p = heap;
		if (p == NULL) {
			cout << "The Heap is Empty" << endl;
			return;
		}
		cout << "The root nodes of Heap are: " << endl;
		_display_tree(heap, "");
		cout << endl;
	}

private:
	node<V>* _empty() {
		return NULL;
	}

	node<V>* _singleton(V value) {
		node<V>* n=new node<V>;
		n->value=value;
		n->prev=n->next=n;
		n->degree=0;
		n->marked=false;
		n->child=NULL;
		n->parent=NULL;
		return n;
	}

	node<V>* _merge(node<V>* a,node<V>* b) {
		if(a==NULL)return b;
		if(b==NULL)return a;
		if(a->value>b->value) {
			node<V>* temp=a;
			a=b;
			b=temp;
		}
		node<V>* an=a->next;
		node<V>* bp=b->prev;
		a->next=b;
		b->prev=a;
		an->prev=bp;
		bp->next=an;
		return a;
	}

	void _deleteAll(node<V>* n) {
		if(n!=NULL) {
			node<V>* c=n;
			do {
				node<V>* d=c;
				c=c->next;
				_deleteAll(d->child);
				delete d;
			} while(c!=n);
		}
	}
	
	void _addChild(node<V>* parent,node<V>* child) {
		child->prev=child->next=child;
		child->parent=parent;
		parent->degree++;
		parent->child=_merge(parent->child,child);
	}

	void _unMarkAndUnParentAll(node<V>* n) {
		if(n==NULL)return;
		node<V>* c=n;
		do {
			c->marked=false;
			c->parent=NULL;
			c=c->next;
		}while(c!=n);
	}

	node<V>* _removeMinimum(node<V>* n) {
		_unMarkAndUnParentAll(n->child);
		if(n->next==n) {
			n=n->child;
		} else {
			n->next->prev=n->prev;
			n->prev->next=n->next;
			n=_merge(n->next,n->child);
		}
		if(n==NULL)return n;
		node<V>* trees[64]={NULL};
		
		while(true) {
			if(trees[n->degree]!=NULL) {
				node<V>* t=trees[n->degree];
				if(t==n)break;
				trees[n->degree]=NULL;
				t->prev->next=t->next;
				t->next->prev=t->prev;
				if(n->value<t->value) {
					_addChild(n,t);
				} else {
					if(n->next==n) {
						t->next=t->prev=t;
					} else {
						n->prev->next=t;
						n->next->prev=t;
						t->next=n->next;
						t->prev=n->prev;
					}
					_addChild(t,n);
					n=t;
				}
				continue;
			} else {
				trees[n->degree]=n;
			}
			n=n->next;
		}
		node<V>* min=n;
		do {
			if(n->value<min->value)min=n;
			n=n->next;
		} while(n!=n);
		return min;
	}

	node<V>* _cut(node<V>* heap,node<V>* n) {
		if(n->next==n) {
			n->parent->child=NULL;
		} else {
			n->next->prev=n->prev;
			n->prev->next=n->next;
			n->parent->child=n->next;
		}
		n->next=n->prev=n;
		n->marked=false;
		n->parent->degree--;
		return _merge(heap,n);
	}

	node<V>* _decreaseKey(node<V>* heap,node<V>* n,V value) {
		if(n->value<value)return heap;
		n->value=value;
		node<V>* parent = n->parent;
		if(parent != nullptr && n->value < parent->value) {
			heap=_cut(heap,n);
			n->parent=NULL;
			while(parent!=NULL && parent->marked) {
				heap=_cut(heap,parent);
				n=parent;
				parent=n->parent;
				n->parent=NULL;
			}
			if(parent!=NULL && parent->parent!=NULL)parent->marked=true;
			if (n->value < heap->value)heap = n;
		}
		return heap;
	}

	node<V>* _find(node<V>* heap,V value) {
		node<V>* n=heap;
		if(n==NULL)return NULL;
		do {
			if(n->value==value)return n;
			node<V>* ret=_find(n->child,value);
			if(ret)return ret;
			n=n->next;
		}while(n!=heap);
		return NULL;
	}

	void _display_tree(node<V>* n, string pre) const {
		string pc = "│  ";
		node<V>* x = n;
		do {
			if (x->next != n) {
				cout << pre << "├─";
			} else {
				cout << pre << "└─";
				pc = "   ";
			}
			if (x->child == nullptr) {
				cout << "─" << x->value << endl;
			} else {
				cout << "┐" << x->value << endl;
				_display_tree(x->child, pre + pc);
			}
			//		cout << endl;
			x = x->next;
		} while (x != n);
	}

};

/*
 * main() for testing constructor, getMinimum(), display(), removeMinimum(), decreaseKey(), isEmpty()
 */
int main(int argc, char** argv) {

	FibonacciHeap<int> fh;

	fh.insert(23);
	fh.insert(7);
	fh.insert(21);
	fh.insert(3);
	fh.insert(17);
	fh.insert(24);
	fh.insert(18);
	fh.insert(52);
	fh.insert(38);
	fh.insert(30);
	fh.insert(26);
	fh.insert(46);
	node<int>* n = fh.insert(39);
	node<int>* m = fh.insert(41);
	fh.insert(35);

	cout << "Heap Minimum: " << fh.getMinimum() << endl;
	cout << "The Heap is: " << endl;

	fh.display();
	cout << "Heap Minimum Extracted: " << fh.removeMinimum() << endl;
	fh.display();

	cout << "de: " << n->getValue() << " para: 5" << endl;
	fh.decreaseKey(n, 5);

	cout << "Heap Minimum: " << fh.getMinimum() << endl;
	fh.display();

	cout << "de: " << m->getValue() << " para: 2" << endl;
	fh.decreaseKey(m, 2);

	while (!fh.isEmpty()) {
		cout << "Heap Minimum Extracted: " << fh.removeMinimum() << endl;
		fh.display();
	}

	return 0;
}

FreeBASIC 

Type Node
    valor As String
    padre As Node Ptr
    hijo As Node Ptr
    prev As Node Ptr
    sgte As Node Ptr
    rank As Integer
    mark As Boolean
End Type

Type FibonacciHeap
    minNode As Node Ptr
    
    Declare Function Insert(valor As String) As Node Ptr
    Declare Sub Union_(other As FibonacciHeap Ptr)
    Declare Function Minimum() As String
    Declare Function ExtractMin() As String
    Declare Sub DecreaseKey(n As Node Ptr, newvalor As String)
    Declare Sub DeleteNode(n As Node Ptr)
    Declare Sub Visualize()
    
    Private:
    Declare Sub Meld1(n1 As Node Ptr, n2 As Node Ptr)
    Declare Sub Meld2(n1 As Node Ptr, n2 As Node Ptr)
    Declare Sub CutAndMeld(n As Node Ptr)
    Declare Sub Cut(n As Node Ptr)
    Declare Sub AddToRoots(roots() As Node Ptr, ByRef count As Integer, r As Node Ptr)
End Type

Sub FibonacciHeap.Meld1(n1 As Node Ptr, n2 As Node Ptr)
    n2->prev = n1->prev
    n2->sgte = n1
    If n1->prev Then n1->prev->sgte = n2
    n1->prev = n2
End Sub

Sub FibonacciHeap.Meld2(n1 As Node Ptr, n2 As Node Ptr)
    If n1->prev Then n1->prev->sgte = n2
    If n2->prev Then n2->prev->sgte = n1
    Dim As Node Ptr temp = n1->prev
    n1->prev = n2->prev
    n2->prev = temp
End Sub

Function FibonacciHeap.Insert(valor As String) As Node Ptr
    Dim As Node Ptr newNode = New Node
    newNode->valor = valor
    newNode->prev = newNode
    newNode->sgte = newNode
    
    If This.minNode = 0 Then
        This.minNode = newNode
    Else
        This.Meld1(This.minNode, newNode)
        If valor < This.minNode->valor Then This.minNode = newNode
    End If
    
    Return newNode
End Function

Sub FibonacciHeap.Union_(other As FibonacciHeap Ptr)
    If This.minNode = 0 Then
        This.minNode = other->minNode
    ElseIf other->minNode Then
        This.Meld2(This.minNode, other->minNode)
        If other->minNode->valor < This.minNode->valor Then This.minNode = other->minNode
    End If
    other->minNode = 0
End Sub

Function FibonacciHeap.Minimum() As String
    If This.minNode = 0 Then Return ""
    Return This.minNode->valor
End Function

Sub FibonacciHeap.AddToRoots(roots() As Node Ptr, ByRef count As Integer, r As Node Ptr)
    r->prev = r
    r->sgte = r
    Dim As Node Ptr rr = r
    
    Do
        Dim As Integer index = rr->rank
        If roots(index) = 0 Then Exit Do
        
        Dim As Node Ptr x = roots(index)
        roots(index) = 0
        If x->valor < rr->valor Then Swap x, rr
        
        x->padre = rr
        x->mark = False
        If rr->hijo = 0 Then
            x->sgte = x
            x->prev = x
            rr->hijo = x
        Else
            This.Meld1(rr->hijo, x)
        End If
        rr->rank += 1
    Loop
    
    roots(rr->rank) = rr
    If rr->rank >= count Then count = rr->rank + 1
End Sub

Function FibonacciHeap.ExtractMin() As String
    If This.minNode = 0 Then Return ""
    
    Dim As String minvalor = This.minNode->valor
    Dim As Node Ptr roots(100)
    Dim As Integer count = 0
    
    ' Process roots
    Dim As Node Ptr r = This.minNode->sgte
    While r <> This.minNode
        Dim As Node Ptr next = r->sgte
        This.AddToRoots(roots(), count, r)
        r = next
    Wend
    
    ' Process children
    Dim As Node Ptr c = This.minNode->hijo
    If c Then
        c->padre = 0
        Dim As Node Ptr rr = c->sgte
        This.AddToRoots(roots(), count, c)
        While rr <> c
            Dim As Node Ptr next = rr->sgte
            rr->padre = 0
            This.AddToRoots(roots(), count, rr)
            rr = next
        Wend
    End If
    
    ' Rebuild heap
    This.minNode = 0
    For i As Integer = 0 To count - 1
        If roots(i) Then
            If This.minNode = 0 Then
                roots(i)->sgte = roots(i)
                roots(i)->prev = roots(i)
                This.minNode = roots(i)
            Else
                This.Meld1(This.minNode, roots(i))
                If roots(i)->valor < This.minNode->valor Then This.minNode = roots(i)
            End If
        End If
    Next
    
    Return minvalor
End Function

Sub FibonacciHeap.Cut(n As Node Ptr)
    Dim As Node Ptr p = n->padre
    If p = 0 Then Exit Sub
    
    p->rank -= 1
    If p->rank = 0 Then
        p->hijo = 0
    Else
        p->hijo = n->sgte
        If n->prev Then n->prev->sgte = n->sgte
        If n->sgte Then n->sgte->prev = n->prev
    End If
    
    If p->padre = 0 Then Exit Sub
    
    If p->mark = False Then
        p->mark = True
        Exit Sub
    End If
    
    This.CutAndMeld(p)
End Sub

Sub FibonacciHeap.CutAndMeld(n As Node Ptr)
    This.Cut(n)
    n->padre = 0
    If This.minNode Then This.Meld1(This.minNode, n)
End Sub

Sub FibonacciHeap.DecreaseKey(n As Node Ptr, newvalor As String)
    If newvalor >= n->valor Then Exit Sub
    n->valor = newvalor
    If n = This.minNode Then Exit Sub
    
    Dim As Node Ptr p = n->padre
    If p = 0 Then
        If newvalor < This.minNode->valor Then This.minNode = n
        Exit Sub
    End If
    
    This.CutAndMeld(n)
End Sub

Sub FibonacciHeap.DeleteNode(n As Node Ptr)
    If n->padre = 0 Then
        If n = This.minNode Then
            This.ExtractMin()
            Exit Sub
        End If
        If n->prev Then n->prev->sgte = n->sgte
        If n->sgte Then n->sgte->prev = n->prev
    Else
        This.Cut(n)
    End If
    
    Dim As Node Ptr c = n->hijo
    If c = 0 Then Exit Sub
    
    Do
        c->padre = 0
        c = c->sgte
    Loop Until c = n->hijo
    
    If This.minNode Then This.Meld2(This.minNode, c)
End Sub

Sub PrintTree(n As Node Ptr, prefix As String)
    Dim As Node Ptr current = n
    Do
        If current->sgte <> n Then
            Print prefix & Chr(195) & Chr(196);  ' ├─
        Else
            Print prefix & Chr(192) & Chr(196);  ' └─
        End If
        
        If current->hijo = 0 Then
            Print "- " & current->valor
        Else
            Print Chr(191) & " " & current->valor  ' ┐
            If current->sgte <> n Then
                PrintTree(current->hijo, prefix & Chr(179) & " ")  ' │ 
            Else
                PrintTree(current->hijo, prefix & "  ")  ' Spaces for last node
            End If
        End If
        
        current = current->sgte
    Loop Until current = n
End Sub

Sub FibonacciHeap.Visualize()
    If This.minNode = 0 Then
        Print "<empty>"
        Exit Sub
    End If
    PrintTree(This.minNode, "")
End Sub

' Test code
Dim As FibonacciHeap h
Print "MakeHeap:"
h.Visualize()

Print !"\nInsert:"
Dim As Node Ptr catNode = h.Insert("cat")
h.Visualize()

Print !"\nUnion:"
Dim As FibonacciHeap h2
h2.Insert("rat")
h.Union_(@h2)
h.Visualize()

Print !"\nMinimum:"
Print h.Minimum()

Print !"\nExtractMin:"
h.Insert("bat")
Dim As Node Ptr meerkatNode = h.Insert("meerkat")
Dim As String m = h.ExtractMin()
Print "(extracted '" & m & "')"
h.Visualize()

Print !"\nDecreaseKey:"
h.DecreaseKey(meerkatNode, "gnat")
h.Visualize()

Print !"\nDelete:"
h.Insert("bobcat")
h.Insert("bat")
Print "(deleting '" & meerkatNode->valor & "')"
h.DeleteNode(meerkatNode)
h.Visualize()

Sleep
Output:
MakeHeap:
<empty>

Insert:
└─- cat

Union:
├─- cat
└─- rat

Minimum:
cat

ExtractMin:
(extracted 'bat')
├─┐ cat
│ └─- rat
└─- meerkat

DecreaseKey:
├─┐ cat
│ └─- rat
└─- gnat

Delete:
(deleting 'gnat')
├─- bat
├─- bobcat
└─┐ cat
  └─- rat

Go

A package. Implementation follows Fredman and Tarjan's 1987 paper. 

package fib

import "fmt"

type Value interface {
    LT(Value) bool
}

type Node struct {
    value      Value
    parent     *Node
    child      *Node
    prev, next *Node
    rank       int
    mark       bool
}

func (n Node) Value() Value { return n.value }

type Heap struct{ *Node }

// task requirement
func MakeHeap() *Heap { return &Heap{} }

// task requirement
func (h *Heap) Insert(v Value) *Node {
    x := &Node{value: v}
    if h.Node == nil {
        x.next = x
        x.prev = x
        h.Node = x
    } else {
        meld1(h.Node, x)
        if x.value.LT(h.value) {
            h.Node = x
        }
    }
    return x
}

func meld1(list, single *Node) {
    list.prev.next = single
    single.prev = list.prev
    single.next = list
    list.prev = single
}

// task requirement
func (h *Heap) Union(h2 *Heap) {
    switch {
    case h.Node == nil:
        *h = *h2
    case h2.Node != nil:
        meld2(h.Node, h2.Node)
        if h2.value.LT(h.value) {
            *h = *h2
        }
    }
    h2.Node = nil
}

func meld2(a, b *Node) {
    a.prev.next = b
    b.prev.next = a
    a.prev, b.prev = b.prev, a.prev
}

// task requirement
func (h Heap) Minimum() (min Value, ok bool) {
    if h.Node == nil {
        return
    }
    return h.value, true
}

// task requirement
func (h *Heap) ExtractMin() (min Value, ok bool) {
    if h.Node == nil {
        return
    }
    min = h.value
    roots := map[int]*Node{}
    add := func(r *Node) {
        r.prev = r
        r.next = r
        for {
            x, ok := roots[r.rank]
            if !ok {
               break
            }
            delete(roots, r.rank)
            if x.value.LT(r.value) {
                r, x = x, r
            }
            x.parent = r
            x.mark = false
            if r.child == nil {
                x.next = x
                x.prev = x
                r.child = x
            } else {
                meld1(r.child, x)
            }
            r.rank++
        }
        roots[r.rank] = r
    }
    for r := h.next; r != h.Node; {
        n := r.next
        add(r)
        r = n
    }
    if c := h.child; c != nil {
        c.parent = nil
        r := c.next
        add(c)
        for r != c {
            n := r.next
            r.parent = nil
            add(r)
            r = n
        }
    }
    if len(roots) == 0 {
        h.Node = nil
        return min, true
    }
    var mv *Node
    var d int
    for d, mv = range roots {
        break
    }
    delete(roots, d)
    mv.next = mv
    mv.prev = mv
    for _, r := range roots {
        r.prev = mv
        r.next = mv.next
        mv.next.prev = r
        mv.next = r
        if r.value.LT(mv.value) {
            mv = r
        }
    }
    h.Node = mv
    return min, true
}

// task requirement
func (h *Heap) DecreaseKey(n *Node, v Value) error {
    if n.value.LT(v) {
        return fmt.Errorf("DecreaseKey new value greater than existing value")
    }
    n.value = v
    if n == h.Node {
        return nil
    }
    p := n.parent
    if p == nil {
        if v.LT(h.value) {
            h.Node = n
        }
        return nil
    }
    h.cutAndMeld(n)
    return nil
}

func (h Heap) cut(x *Node) {
    p := x.parent
    p.rank--
    if p.rank == 0 {
        p.child = nil
    } else {
        p.child = x.next
        x.prev.next = x.next
        x.next.prev = x.prev
    }
    if p.parent == nil {
        return
    }
    if !p.mark {
        p.mark = true
        return
    }
    h.cutAndMeld(p)
}

func (h Heap) cutAndMeld(x *Node) {
    h.cut(x)
    x.parent = nil
    meld1(h.Node, x)
}

// task requirement
func (h *Heap) Delete(n *Node) {
    p := n.parent
    if p == nil {
        if n == h.Node {
            h.ExtractMin()
            return
        }
        n.prev.next = n.next
        n.next.prev = n.prev
    } else {
        h.cut(n)
    }
    c := n.child
    if c == nil {
        return
    }
    for {
        c.parent = nil
        c = c.next
        if c == n.child {
            break
        }
    }
    meld2(h.Node, c)
}

// adapted from task "Visualize a tree"
func (h Heap) Vis() {
    if h.Node == nil {
        fmt.Println("<empty>")
        return
    }
    var f func(*Node, string)
    f = func(n *Node, pre string) {
        pc := "│ "
        for x := n; ; x = x.next {
            if x.next != n {
                fmt.Print(pre, "├─")
            } else {
                fmt.Print(pre, "└─")
                pc = "  "
            }
            if x.child == nil {
                fmt.Println("╴", x.value)
            } else {
                fmt.Println("┐", x.value)
                f(x.child, pre+pc)
            }
            if x.next == n {
                break
            }
        }
    }
    f(h.Node, "")
}

A demonstration: 

package main

import (
    "fmt"

    "fib"
)

type str string

func (s str) LT(t fib.Value) bool { return s < t.(str) }

func main() {
    fmt.Println("MakeHeap:")
    h := fib.MakeHeap()
    h.Vis()

    fmt.Println("\nInsert:")
    h.Insert(str("cat"))
    h.Vis()

    fmt.Println("\nUnion:")
    h2 := fib.MakeHeap()
    h2.Insert(str("rat"))
    h.Union(h2)
    h.Vis()

    fmt.Println("\nMinimum:")
    m, _ := h.Minimum()
    fmt.Println(m)

    fmt.Println("\nExtractMin:")
    // add a couple more items to demonstrate parent-child linking that
    // happens on delete min.
    h.Insert(str("bat"))
    x := h.Insert(str("meerkat")) // save x for decrease key and delete demos
    m, _ = h.ExtractMin()
    fmt.Printf("(extracted %v)\n", m)
    h.Vis()

    fmt.Println("\nDecreaseKey:")
    h.DecreaseKey(x, str("gnat"))
    h.Vis()
    fmt.Println("\nDelete:")
    // add yet a couple more items to show how F&T's original delete was
    // lazier than CLRS's delete.
    h.Insert(str("bobcat"))
    h.Insert(str("bat"))
    fmt.Printf("(deleting %v)\n", x.Value())
    h.Delete(x)
    h.Vis()
}
Output:
MakeHeap:
<empty>

Insert:
└─╴ cat

Union:
├─╴ cat
└─╴ rat

Minimum:
cat

ExtractMin:
(extracted bat)
├─┐ cat
│ └─╴ rat
└─╴ meerkat

DecreaseKey:
├─┐ cat
│ └─╴ rat
└─╴ gnat

Delete:
(deleting gnat)
├─╴ bat
├─╴ bobcat
└─┐ cat
  └─╴ rat


Julia

Translation of: Python
module FibonacciHeaps

export FNode, FibonacciHeap, insert, extractmin, findmin, decreasekey, delete!
export Insert, MakeHeap, Minimum, ExtractMin, DecreaseKey, Delete
import Base.print

mutable struct FNode{T}
    value::T
    degree::Int
    parent::Union{FNode, Nothing}
    child::Union{FNode, Nothing}
    left::Union{FNode, Nothing}
    right::Union{FNode, Nothing}
    mark::Bool
end
FNode(data::T) where T = FNode{T}(data, 0, nothing, nothing, nothing, nothing, false)

# Get list of nodes attached to head (of a circular doubly linked list)
function aslist(head::FNode)
    nodelist, node, stop = FNode[], head, head
    flag = false
    while true
        if node == stop
            flag && break
            flag = true
        end
        push!(nodelist, node)
        node = node.right
    end
    return nodelist
end

mutable struct FibonacciHeap
    rootlist::Union{FNode, Nothing}
    minnode::Union{FNode, Nothing}
    nodecount::Int
    FibonacciHeap() = new(nothing, nothing, 0)
end
MakeHeap() = FibonacciHeap()                                             # MakeHeap()  for task

function print(io::IO, h::FibonacciHeap)
    if h.rootlist == nothing
        println("<empty heap>")
        return
    end
    function printtree(io::IO, rootnode, s::String="")
        n = rootnode
        stem= "│ "
        while n != nothing
            if n.right != rootnode
                print(io, s, "├─")
            else
                print(io, s, "└─")
                stem = "  "
            end
            if n.child == nothing
                println(io, "╴", n.value)
            else
                println(io, "┐", n.value)
                printtree(io, n.child, s * stem)
            end
            if n.right == rootnode
                break
            end
            n = n.right
        end
    end
    printtree(io, h.rootlist)
end


# return min node in O(1) time
findmin(h::FibonacciHeap) = h.minnode
Minimum(H) = findmin(H)                                                  # Minimum(H)  for task

# extract (delete) the min node from the heap in O(log n) time
function extractmin(root::FibonacciHeap)
    z = root.minnode
    if z != nothing
        if z.child != nothing
            # attach child nodes to root list
            children = aslist(z.child)
            for c in children
                merge_with_root_list(root, c)
                c.parent = nothing
            end
        end
        remove_from_root_list(root, z)
        # set new min node in heap
        if z == z.right
            root.minnode = root.rootlist = nothing
        else
            root.minnode = z.right
            consolidate(root)
        end
        root.nodecount -= 1
    end
    return z
end
ExtractMin(H) = extractmin(H)                                            # ExtractMin(H)  for task

# insert new node into the unordered root list in O(1) time
function insert(root, data)
    n = FNode(data)
    n.left = n.right = n
    merge_with_root_list(root, n)
    if root.minnode == nothing || n.value < root.minnode.value
        root.minnode = n
    end
    root.nodecount += 1
    return n
end
Insert(H, x) = insert(H, x)                                              # Insert(H, x)  for task

# modify the data of some node in the heap in O(1) time
function decreasekey(root, x, k)
    if k > x.value
        return nothing
    end
    x.value = k
    y = x.parent
    if y != nothing && x.value < y.value
        cut(root, x, y)
        cascadingcut(root, y)
    end
    if x.value < root.minnode.value
        root.minnode = x
    end
end
DecreaseKey(H, x, k) = decreasekey(H, x, k)                              # DecreaseKey(H, x, k)

# merge two fibonacci heaps in O(1) time by concatenating the root lists
# the root of the new root list becomes equal to the first list and the second
# list is simply appended to the end (then the proper min node is determined)
function merge(h1, h2)
    newh = FibonacciHeap()
    newh.rootlist, newh.minnode = h1.rootlist, h1.minnode
    # fix pointers when merging the two heaps
    last = h2.rootlist.left
    h2.rootlist.left = newh.rootlist.left
    newh.rootlist.left.right = h2.rootlist
    newh.rootlist.left = last
    newh.rootlist.left.right = newh.rootlist
    # update min node if needed
    if h2.minnode.value < newh.minnode.value
        newh.min_node = h2.minnode
    end
    # update total nodes
    newh.nodecount = h1.nodecount + h2.nodecount
    return newh
end
Union(H1, H2) = merge(H1, H2)   # NB: Union is a type in Julia          # Union(H1, H2)  for task

# if a child node becomes smaller than its parent node we
# cut this child node off and bring it up to the root list
function cut(root, x, y)
    remove_from_child_list(root, y, x)
    y.degree -= 1
    merge_with_root_list(root, x)
    x.parent = nothing
    x.mark = false
end

# cascading cut of parent node to obtain good time bounds
function cascadingcut(root, y)
    z = y.parent
    if z != nothing
        if y.mark == false
            y.mark = true
        else
            cut(root, y, z)
            cascadingcut(root, z)
        end
    end
end

# combine root nodes of equal degree to consolidate the heap
# by creating a list of unordered binomial trees
function consolidate(root)
    nodes = aslist(root.rootlist)
    len = length(nodes)
    A = fill!(Vector{Union{FNode, Nothing}}(undef, Int(round(log(root.nodecount)) * 2)), nothing)
    for x in nodes
        d = x.degree + 1
        while A[d] != nothing
            y = A[d]
            if x.value > y.value
                x, y = y, x
            end
            heaplink(root, y, x)
            A[d] = nothing
            d += 1
        end
        A[d] = x
    end
    # find new min node - no need to reconstruct new root list below
    # because root list was iteratively changing as we were moving
    # nodes around in the above loop
    for nod in A
        if nod != nothing && nod.value < root.minnode.value
            root.minnode = nod
        end
    end
end

# actual linking of one node to another in the root list
# while also updating the child linked list
function heaplink(root, y, x)
    remove_from_root_list(root, y)
    y.left = y.right = y
    merge_with_child_list(root, x, y)
    x.degree += 1
    y.parent = x
    y.mark = false
end

# merge a node with the doubly linked root list
function merge_with_root_list(root, node)
    if root.rootlist == nothing
        root.rootlist = node
    else
        node.right = root.rootlist.right
        node.left = root.rootlist
        root.rootlist.right.left = node
        root.rootlist.right = node
    end
end

# merge a node with the doubly linked child list of a root node
function merge_with_child_list(root, parent, node)
    if parent.child == nothing
        parent.child = node
    else
        node.right = parent.child.right
        node.left = parent.child
        parent.child.right.left = node
        parent.child.right = node
    end
end

# remove a node from the doubly linked root list
function remove_from_root_list(root, node)
    if node == root.rootlist
        root.rootlist = node.right
    end
    node.left.right = node.right
    node.right.left = node.left
end

# remove a node from the doubly linked child list
function remove_from_child_list(root, parent, node)
    if parent.child == parent.child.right
        parent.child = nothing
    elseif parent.child == node
        parent.child = node.right
        node.right.parent = parent
    end
    node.left.right = node.right
    node.right.left = node.left
end
 
function delete!(root, node)
    if (parent = node.parent) == nothing
        if node.child != nothing
            cut(root, node.child, node)
        end
        remove_from_root_list(root, node)
    else
        remove_from_child_list(root, parent, node)
    end
    if root.rootlist != nothing
        root.nodecount -= 1
        root.minnode = root.rootlist
        for n in aslist(root.rootlist)
            if n != nothing && n.value < root.minnode.value
                root.minnode = n
            end
        end
    end
end
Delete(H, x) = delete!(H, x)                                             # Delete(H, x)   for task

end  # module

using .FibonacciHeaps

const h1 = MakeHeap()
println("Made heap 1:"), print(h1)
Insert(h1, "now")
println("Inserted the word now into heap 1"), print(h1)
const h2 = MakeHeap()
println("Made another heap 2.")
const t = Insert(h2, "time")
println("Inserted the word time into heap 2:"), print(h2)
const h3 = Union(h1, h2)
println("Made heap 3, union of heap 1 and heap 2:"), print(h3)
println("The minimum of h3 is now \"$(Minimum(h3).value)\".")
const xkeys = [Insert(h3, x) for x in  ["all", "good", "men"]]
println("Inserted 3 more into h3:"), print(h3)
println("The minimum of h3 is now \"$(Minimum(h3).value)\".")
println("The extracted min from heap 3 is: ", ExtractMin(h3).value)
println("h3 is now:"), print(h3)
println("Decrease key of heap 3 value $(xkeys[3].value) with the word come:")
DecreaseKey(h3, xkeys[3], "come")
print(h3)
println("Delete node with value $(xkeys[3].value) from heap 3:")
Delete(h3, xkeys[3])
print(h3)
println("The minimum of h3 is now: ", Minimum(h3).value
Output:
Made heap 1:
<empty heap>
Inserted the word now into heap 1
└─╴now
Made another heap 2.
Inserted the word time into heap 2:
└─╴time
Made heap 3, union of heap 1 and heap 2:
├─╴now
└─╴time
The minimum of h3 is now "now".
Inserted 3 more into h3:
├─╴now
├─╴men
├─╴good
├─╴all
└─╴time
The minimum of h3 is now "all".
The extracted min from heap 3 is: all
h3 is now:
└─┐good
  ├─╴time
  └─┐men
    └─╴now
Decrease key of heap 3 value men with the word come:
├─┐good
│ └─╴time
└─┐come
  └─╴now
Delete node with value come from heap 3:
├─┐good
│ └─╴time
└─╴now
The minimum of h3 is now: good

Kotlin

Translation of: Go
// version 1.2.21

class Node<V : Comparable<V>>(var value: V) {
    var parent: Node<V>? = null
    var child:  Node<V>? = null
    var prev:   Node<V>? = null
    var next:   Node<V>? = null
    var rank = 0
    var mark = false

    fun meld1(node: Node<V>) {
        this.prev?.next = node
        node.prev = this.prev
        node.next = this
        this.prev = node
    }

    fun meld2(node: Node<V>) {
        this.prev?.next = node
        node.prev?.next = this
        val temp = this.prev
        this.prev = node.prev
        node.prev = temp
    }
}

// task requirement
fun <V: Comparable<V>> makeHeap() = FibonacciHeap<V>()

class FibonacciHeap<V: Comparable<V>>(var node: Node<V>? = null) {

    // task requirement
    fun insert(v: V): Node<V> {
        val x = Node(v)
        if (this.node == null) {
            x.next = x
            x.prev = x
            this.node = x
        }
        else {
            this.node!!.meld1(x)
            if (x.value < this.node!!.value) this.node = x
        }
        return x
    }

    // task requirement
    fun union(other: FibonacciHeap<V>) {
        if (this.node == null) {
            this.node = other.node
        }
        else if (other.node != null) {
            this.node!!.meld2(other.node!!)
            if (other.node!!.value < this.node!!.value) this.node = other.node
        }
        other.node = null
    }

    // task requirement
    fun minimum(): V? = this.node?.value

    // task requirement
    fun extractMin(): V? {
        if (this.node == null) return null
        val min = minimum()
        val roots = mutableMapOf<Int, Node<V>>()

        fun add(r: Node<V>) {
            r.prev = r
            r.next = r
            var rr = r
            while (true) {
                var x = roots[rr.rank] ?: break
                roots.remove(rr.rank)
                if (x.value < rr.value) {
                    val t = rr
                    rr = x
                    x = t
                }
                x.parent = rr
                x.mark = false
                if (rr.child == null) {
                    x.next = x
                    x.prev = x
                    rr.child = x
                }
                else {
                    rr.child!!.meld1(x)
                }
                rr.rank++
            }
            roots[rr.rank] = rr
        }

        var r = this.node!!.next
        while (r != this.node) {
            val n = r!!.next
            add(r)
            r = n
        }
        val c = this.node!!.child
        if (c != null) {
            c.parent = null
            var rr = c.next!!
            add(c)
            while (rr != c) {
                val n = rr.next!!
                rr.parent = null
                add(rr)
                rr = n
            }
        }
        if (roots.isEmpty()) {
            this.node = null
            return min
        }
        val d = roots.keys.first()
        var mv = roots[d]!!
        roots.remove(d)
        mv.next = mv
        mv.prev = mv
        for ((_, rr) in roots) {
            rr.prev = mv
            rr.next = mv.next
            mv.next!!.prev = rr
            mv.next = rr
            if (rr.value < mv.value) mv = rr
        }
        this.node = mv
        return min
    }

    // task requirement
    fun decreaseKey(n: Node<V>, v: V) {
        require (n.value > v) {
            "In 'decreaseKey' new value greater than existing value"
        }
        n.value = v
        if (n == this.node) return
        val p = n.parent
        if (p == null) {
            if (v < this.node!!.value) this.node = n
            return
        }
        cutAndMeld(n)
    }

    private fun cut(x: Node<V>) {
        val p = x.parent
        if (p == null) return
        p.rank--
        if (p.rank == 0) {
            p.child = null
        }
        else {
            p.child = x.next
            x.prev?.next = x.next
            x.next?.prev = x.prev
        }
        if (p.parent == null) return
        if (!p.mark) {
            p.mark = true
            return
        }
        cutAndMeld(p)
    }

    private fun cutAndMeld(x: Node<V>) {
        cut(x)
        x.parent = null
        this.node?.meld1(x)
    }

    // task requirement
    fun delete(n: Node<V>) {
        val p = n.parent
        if (p == null) {
            if (n == this.node) {
                extractMin()
                return
            }
            n.prev?.next = n.next
            n.next?.prev = n.prev
        }
        else {
            cut(n)
        }
        var c = n.child
        if (c == null) return
        while (true) {
            c!!.parent = null
            c = c.next
            if (c == n.child) break
        }
        this.node?.meld2(c!!)
    }

    fun visualize() {
        if (this.node == null) {
            println("<empty>")
            return
        }

        fun f(n: Node<V>, pre: String) {
            var pc = "│ "
            var x = n
            while (true) {
                if (x.next != n) {
                    print("$pre├─")
                }
                else {
                    print("$pre└─")
                    pc = "  "
                }
                if (x.child == null) {
                    println("╴ ${x.value}")
                }
                else {
                    println("┐ ${x.value}")
                    f(x.child!!, pre + pc)
                }
                if (x.next == n) break
                x = x.next!!
            }
        }
        f(this.node!!, "")
    }
}

fun main(args: Array<String>) {
    println("MakeHeap:")
    val h = makeHeap<String>()
    h.visualize()

    println("\nInsert:")
    h.insert("cat")
    h.visualize()

    println("\nUnion:")
    val h2 = makeHeap<String>()
    h2.insert("rat")
    h.union(h2)
    h.visualize()

    println("\nMinimum:")
    var m = h.minimum()
    println(m)

    println("\nExtractMin:")
    // add a couple more items to demonstrate parent-child linking that
    // happens on delete min.
    h.insert("bat")
    val x = h.insert("meerkat")  // save x for decrease key and delete demos.
    m = h.extractMin()
    println("(extracted $m)")
    h.visualize()

    println("\nDecreaseKey:")
    h.decreaseKey(x, "gnat")
    h.visualize()

    println("\nDelete:")
    // add a couple more items.
    h.insert("bobcat")
    h.insert("bat")
    println("(deleting ${x.value})")
    h.delete(x)
    h.visualize()
}
Output:
MakeHeap:
<empty>

Insert:
└─╴ cat

Union:
├─╴ cat
└─╴ rat

Minimum:
cat

ExtractMin:
(extracted bat)
├─┐ cat
│ └─╴ rat
└─╴ meerkat

DecreaseKey:
├─┐ cat
│ └─╴ rat
└─╴ gnat

Delete:
(deleting gnat)
├─╴ bat
├─╴ bobcat
└─┐ cat
  └─╴ rat

Nim

Translation of: Go & Kotlin
import strutils, tables

type

  Node*[T] = ref object
    value: T
    parent: Node[T]
    child: Node[T]
    prev, next: Node[T]
    rank: int
    mark: bool

  Heap*[T] = object
    node: Node[T]


func meld1[T](list, single: Node[T]) =
  list.prev.next = single
  single.prev = list.prev
  single.next = list
  list.prev = single


func meld2[T](a, b: Node[T]) =
  a.prev.next = b
  b.prev.next = a
  swap a.prev, b.prev


# Task requirement.
func initHeap*[T]: Heap[T] = discard


# Task requirement.
func insert*[T](heap: var Heap[T]; value: T): Node[T] =
  result = Node[T](value: value)
  if heap.node.isNil:
    result.next = result
    result.prev = result
    heap.node = result
  else:
    heap.node.meld1(result)
    if result.value < heap.node.value:
      heap.node = result


# Task requirement.
func union*[T](heap1: var Heap[T]; heap2: var Heap[T]) =
  if heap1.node.isNil:
    heap1 = heap2
  elif not heap2.node.isNil:
    meld2(heap1.node, heap2.node)
    if heap2.node.value < heap1.node.value:
      heap1 = heap2
  heap2.node = nil


# Task requirement.
func min*[T](heap: Heap[T]): T =
  if heap.node.isNil:
    raise newException(ValueError, "cannot find minimum value in an empty heap.")
  result = heap.node.value


func add[T](roots: var Table[int, Node[T]]; root: Node[T]) =
  root.prev = root
  root.next = root
  var root = root
  while true:
    if root.rank notin roots: break
    var node = roots.getOrDefault(root.rank, nil)
    if node.isNil: break
    roots.del(root.rank)
    if node.value < root.value: swap node, root
    node.parent = root
    node.mark = false
    if root.child.isNil:
      node.next = node
      node.prev = node
      root.child = node
    else:
      meld1(root.child, node)
    inc root.rank
  roots[root.rank] = root


proc firstKey[T1, T2](t: Table[T1, T2]): T1 =
  for key in t.keys: return key


# Task requirement.
func extractMin*[T](heap: var Heap[T]): T =
  let m = min(heap)
  var roots: Table[int, Node[T]]

  var root = heap.node.next
  while root != heap.node:
    let node = root.next
    roots.add root
    root = node

  var child = heap.node.child
  if not child.isNil:
    child.parent = nil
    var root = child.next
    roots.add child
    while root != child:
      let node = root.next
      root.parent = nil
      roots.add root
      root = node

  if roots.len == 0:
    heap.node = nil
    return m

  let key = roots.firstKey()
  var node = roots[key]
  roots.del(key)
  node.next = node
  node.prev = node
  for root in roots.values:
    root.prev = node
    root.next = node.next
    node.next.prev = root
    node.next = root
    if root.value < node.value: node = root
  heap.node = node
  result = m


# Forward reference.
func cutAndMeld[T](heap: Heap[T]; node: Node[T])


func cut[T](heap: Heap[T]; node: Node[T]) =
  let parent = node.parent
  dec parent.rank
  if parent.rank == 0:
    parent.child = nil
  else:
    parent.child = node.next
    node.prev.next = node.next
    node.next.prev = node.prev
  if parent.parent.isNil: return
  if parent.mark:
    heap.cutAndMeld(parent)
  else:
    parent.mark = true


func cutAndMeld[T](heap: Heap[T]; node: Node[T]) =
  heap.cut(node)
  node.parent = nil
  meld1(heap.node, node)


# Task requirement.
func decreaseKey*[T](heap: var Heap[T]; node: Node[T]; val: T) =
  if node.value < val:
    raise newException(ValueError, "“decreaseKey” new value greater than existing value.")

  node.value = val
  if node == heap.node: return

  if node.parent.isNil:
    if val < heap.node.value:
      heap.node = node
  else:
    heap.cutAndMeld(node)


# Task requirement.
func delete*[T](heap: var Heap[T]; node: Node[T]) =

  let parent = node.parent
  if parent.isNil:
    if node == heap.node:
      discard heap.extractMin()
      return
    node.prev.next = node.next
    node.next.prev = node.prev
  else:
    heap.cut(node)

  var child = node.child
  if child.isNil: return

  while true:
    child.parent = nil
    child = child.next
    if child == node.child: break

  meld2(heap.node, child)


iterator nodes[T](head: Node[T]): Node[T] =
  if not head.isNil:
    yield head
    var node = head.next
    while node != head:
      yield node
      node = node.next


proc visualize[T](heap: Heap[T]) =

  if heap.node.isNil:
    echo "<empty>"
    return

  proc print[T](node: Node[T]; pre: string) =
    var pc = "│ "
    for curr in node.nodes():
      if curr.next != node:
        stdout.write pre, "├─"
      else:
        stdout.write pre, "└─"
        pc = "  "
      if curr.child.isNil:
        echo "╴", curr.value
      else:
        echo "┐", curr.value
        print(curr.child, pre & pc)

  print(heap.node, "")


when isMainModule:

  echo "MakeHeap:"
  var heap = initHeap[string]()
  heap.visualize()

  echo "\nInsert:"
  discard heap.insert("cat")
  heap.visualize()

  echo "\nUnion:"
  var heap2 = initHeap[string]()
  discard heap2.insert("rat")
  heap.union(heap2)
  heap.visualize()

  echo "\nMinimum:"
  var m = min(heap)
  echo m

  echo "\nExtractMin:"
  # Add a couple more items to demonstrate parent-child linking that happens on delete min.
  discard heap.insert("bat")
  let node = heap.insert("meerkat")  # Save node for decrease key and delete demos.
  m = heap.extractMin()
  echo "(extracted $#)" % m
  heap.visualize()

  echo "\nDecreaseKey:"
  heap.decreaseKey(node, "gnat")
  heap.visualize()

  echo "\nDelete:"
  # Add a couple more items.
  discard heap.insert("bobcat")
  discard heap.insert("bat")
  echo "(deleting $#)" % node.value
  heap.delete(node)
  heap.visualize()
Output:
MakeHeap:
<empty>

Insert:
└─╴cat

Union:
├─╴cat
└─╴rat

Minimum:
cat

ExtractMin:
(extracted bat)
├─┐cat
│ └─╴rat
└─╴meerkat

DecreaseKey:
├─┐cat
│ └─╴rat
└─╴gnat

Delete:
(deleting gnat)
├─╴bat
├─╴bobcat
└─┐cat
  └─╴rat

Pascal

Free Pascal 

program FibonacciHeap;
{$mode objfpc}

type
  // A pointer to a node in the heap
  PNode = ^TNode;

  // The node structure containing key, degree, parent, child, and linked nodes
  TNode = record
    Key: integer;      // The key value of the node
    Degree: integer;   // The degree of the node (number of children)
    Parent, Child, Left, Right: PNode;  // Pointers for the doubly linked circular list
    Marked: boolean;   // Whether the node is marked
  end;

  // Fibonacci Heap class definition
  TFibonacciHeap = class
  private
    MinNode: PNode;    // Points to the node with the minimum key in the heap
    NodeCount: integer; // The number of nodes in the heap
    function FindNode(Root: PNode; Key: integer): PNode; // Finds a node by key in the heap
    procedure PrintHeapRecursive(Node: PNode; Indent: integer); // Recursively prints the heap structure
  public
    constructor Create; // Constructor to initialize the heap
    procedure Insert(Key: integer); // Inserts a new key into the heap
    function FindMin: integer; // Returns the minimum key in the heap
    procedure DecreaseKey(Node: PNode; NewKey: integer); // Decreases the key of a given node
    function ExtractMin: integer; // Extracts the minimum key node from the heap
    procedure Delete(Key: integer); // Deletes a node with the specified key
    procedure Union(OtherHeap: TFibonacciHeap); // Unites the current heap with another heap
    procedure PrintHeap; // Prints the entire heap structure
  end;

  // Constructor: Initializes an empty Fibonacci heap
  constructor TFibonacciHeap.Create;
  begin
    MinNode := nil;  // No nodes initially
    NodeCount := 0;  // Node count is 0 initially
  end;

  // Inserts a new key into the Fibonacci heap
  procedure TFibonacciHeap.Insert(Key: integer);
  var
    NewNode: PNode;
  begin
    // Create a new node
    New(NewNode);
    NewNode^.Key := Key;
    NewNode^.Degree := 0;
    NewNode^.Parent := nil;
    NewNode^.Child := nil;
    NewNode^.Marked := False;
    NewNode^.Left := NewNode;
    NewNode^.Right := NewNode;

    // If the heap is empty, the new node becomes the MinNode
    if MinNode = nil then
      MinNode := NewNode
    else
    begin
      // Insert the new node into the root list
      NewNode^.Right := MinNode^.Right;
      NewNode^.Left := MinNode;
      MinNode^.Right^.Left := NewNode;
      MinNode^.Right := NewNode;

      // Update the MinNode if necessary
      if NewNode^.Key < MinNode^.Key then
        MinNode := NewNode;
    end;

    // Increase the node count
    Inc(NodeCount);
  end;

  // Finds the minimum key in the heap (returns -1 if empty)
  function TFibonacciHeap.FindMin: integer;
  begin
    if MinNode <> nil then
      Result := MinNode^.Key
    else
      Result := -1; // Return -1 for an empty heap
  end;

  // Decreases the key of a given node
  procedure TFibonacciHeap.DecreaseKey(Node: PNode; NewKey: integer);
  begin
    if Node = nil then Exit;

    // Check if the new key is smaller than the current key
    if NewKey > Node^.Key then
    begin
      Writeln('Error: New key is greater than current key.');
      Exit;
    end;

    // Update the key
    Node^.Key := NewKey;

    // If the node violates the heap property, move it to the root list
    if (Node^.Parent <> nil) and (Node^.Key < Node^.Parent^.Key) then
      Node^.Parent := nil;

    // Update the minimum node if necessary
    if Node^.Key < MinNode^.Key then
      MinNode := Node;
  end;

  // Extracts and returns the minimum key node from the heap
  function TFibonacciHeap.ExtractMin: integer;
  begin
    if MinNode = nil then
    begin
      Result := -1;
      Exit;
    end;

    Result := MinNode^.Key; // Return the key of the minimum node

    // If there is only one node, set MinNode to nil
    if MinNode^.Right = MinNode then
      MinNode := nil
    else
    begin
      // Remove the minimum node from the root list
      MinNode^.Left^.Right := MinNode^.Right;
      MinNode^.Right^.Left := MinNode^.Left;
      MinNode := MinNode^.Right; // Update MinNode to the next node
    end;

    // Decrease the node count
    Dec(NodeCount);
  end;

  // Finds a node by key starting from the root node
  function TFibonacciHeap.FindNode(Root: PNode; Key: integer): PNode;
  var
    Temp, ResultNode: PNode;
  begin
    Result := nil;
    if Root = nil then Exit;

    Temp := Root;
    repeat
      if Temp^.Key = Key then
      begin
        Result := Temp;
        Exit;
      end;

      // Recursively search children
      if Temp^.Child <> nil then
      begin
        ResultNode := FindNode(Temp^.Child, Key);
        if ResultNode <> nil then
        begin
          Result := ResultNode;
          Exit;
        end;
      end;

      // Move to the next node in the root list
      Temp := Temp^.Right;
    until Temp = Root;
  end;

  // Deletes a node by key by first decreasing its key to a very small value and then extracting it
  procedure TFibonacciHeap.Delete(Key: integer);
  var
    NodeToDelete: PNode;
  begin
    NodeToDelete := FindNode(MinNode, Key);
    if NodeToDelete <> nil then
    begin
      DecreaseKey(NodeToDelete, -MaxInt);  // Decrease key to the smallest possible value
      ExtractMin;  // Extract the node from the heap
    end;
  end;

  // Unites two Fibonacci heaps by merging their root lists
  procedure TFibonacciHeap.Union(OtherHeap: TFibonacciHeap);
  var
    Temp: PNode;
  begin
    if OtherHeap = nil then Exit;
    if OtherHeap.MinNode = nil then Exit;
    if MinNode = nil then
    begin
      MinNode := OtherHeap.MinNode;  // If current heap is empty, adopt the other heap's MinNode
      NodeCount := OtherHeap.NodeCount;
      Exit;
    end;

    // Merge the root lists of both heaps
    Temp := MinNode^.Right;
    MinNode^.Right := OtherHeap.MinNode^.Right;
    MinNode^.Right^.Left := MinNode;
    OtherHeap.MinNode^.Right := Temp;
    Temp^.Left := OtherHeap.MinNode;

    // Update the MinNode if necessary
    if OtherHeap.MinNode^.Key < MinNode^.Key then
      MinNode := OtherHeap.MinNode;

    // Adjust the node count
    Inc(NodeCount, OtherHeap.NodeCount);

    // Clear the other heap
    OtherHeap.MinNode := nil;
    OtherHeap.NodeCount := 0;
  end;

  // Recursive function to print the heap's structure
  procedure TFibonacciHeap.PrintHeapRecursive(Node: PNode; Indent: integer);
  var
    StartNode, Current: PNode;
    I: integer;
  begin
    if Node = nil then Exit;

    StartNode := Node;
    Current := Node;

    repeat
      // Indent and print the node key
      for I := 1 to Indent do
        Write('  ');
      Writeln(Current^.Key);

      // Print the children recursively
      if Current^.Child <> nil then
      begin
        for I := 1 to Indent do
          Write('  ');
        Writeln('Children of ', Current^.Key, ':');
        PrintHeapRecursive(Current^.Child, Indent + 2);
      end;

      // Move to the next node in the root list
      Current := Current^.Right;
    until Current = StartNode;
  end;

  // Prints the entire heap using recursion
  procedure TFibonacciHeap.PrintHeap;
  begin
    if MinNode = nil then
    begin
      Writeln('Heap is empty.');
      Exit;
    end;

    Writeln('Fibonacci Heap:');
    PrintHeapRecursive(MinNode, 0);  // Start printing from the MinNode
    writeln;
  end;

var
  Heap1, Heap2: TFibonacciHeap;
  node: PNode;
begin
  // Create two Fibonacci heaps
  Heap1 := TFibonacciHeap.Create;
  Heap2 := TFibonacciHeap.Create;

  // Insert nodes into Heap1
  Heap1.Insert(10);
  Heap1.Insert(5);
  Heap1.Insert(20);
  Heap1.Insert(99);

  writeln('Heap 1 minimum = ', Heap1.FindMin);
  Heap1.PrintHeap;

  writeln('Heap 1 extract minimum = ', Heap1.ExtractMin);
  Heap1.PrintHeap;

  // Decrease key in Heap1
  node := Heap1.FindNode(Heap1.MinNode, 20);
  Heap1.DecreaseKey(node, 3);
  writeln('Heap 1 after changing key 20 to 3');
  Heap1.PrintHeap;

  // Insert nodes into Heap2
  Heap2.Insert(15);
  Heap2.Insert(2);

  writeln('Heap 2 before union:');
  Heap2.PrintHeap;

  // Perform union of Heap1 and Heap2
  Heap1.Union(Heap2);

  writeln('Heap after union:');
  Heap1.PrintHeap;

  // Free the heaps
  Heap1.Free;
  Heap2.Free;
end.
Output:
Heap 1 minimum = 5
Fibonacci Heap:
5
99
20
10

Heap 1 extract minimum = 5
Fibonacci Heap:
99
20
10

Heap 1 after changing key 20 to 3
Fibonacci Heap:
3
10
99

Heap 2 before union:
Fibonacci Heap:
2
15

Heap after union:
Fibonacci Heap:
2
10
99
3
15

Phix

Translation of: Go
with javascript_semantics
enum VALUE, PARENT, CHILD, PREV, NEXT, RANK, MARK, NODELEN=$
 
function new_node()
    return repeat(NULL,NODELEN)
end function
 
sequence nodes = {}
integer freelist = NULL
 
function new_slot()
    integer res
    if freelist!=NULL then
        res = freelist
        freelist = nodes[freelist]
        nodes[res] = NULL
    else
        nodes = append(nodes,NULL)
        res = length(nodes)
    end if
    return res
end function
 
procedure release_slot(integer n)
    nodes[n] = freelist
    freelist = n
end procedure
 
-- task requirement
function MakeHeap()
    return new_slot()
end function
 
procedure meld1(integer list, single)
    nodes[nodes[list][PREV]][NEXT] = single
    nodes[single][PREV] = nodes[list][PREV]
    nodes[single][NEXT] = list
    nodes[list][PREV] = single
end procedure
 
function is_null(integer n)
    -- (helps with refcounts for pwa/p2js)
    return nodes[n] == NULL
end function

-- task requirement
function Insert(integer h, object v)
    integer n = 0
    sequence x = new_node()
    x[VALUE] = v
    if is_null(h) then
        x[NEXT] = h
        x[PREV] = h
        nodes[h] = x
    else
        n = new_slot()
        nodes[n] = deep_copy(x)
        meld1(h, n)
        if nodes[n][VALUE]<nodes[h][VALUE] then
            h = n
        end if
    end if
    return {h,n}
end function
 
procedure meld2(integer a, b)
    nodes[nodes[a][PREV]][NEXT] = b
    nodes[nodes[b][PREV]][NEXT] = a
    {nodes[a][PREV], nodes[b][PREV]} = {nodes[b][PREV], nodes[a][PREV]}
end procedure

-- task requirement
function Union(integer h, h2)
    if is_null(h) then
        h = h2
    elsif not is_null(h2) then
        meld2(h, h2)
        if nodes[h2][VALUE]<nodes[h][VALUE] then
            h = h2
        end if
    else
        release_slot(h2)
    end if
    return {h,NULL} -- (h2:=NULL implied)
end function
 
-- task requirement
function Minimum(integer h)
    if is_null(h) then
        return {"<none>",false}
    end if
    return {nodes[h][VALUE], true}
end function
 
procedure add_roots(integer r, integer roots)
    nodes[r][PREV] = r
    nodes[r][NEXT] = r
    while true do
        integer node = getd_index(nodes[r][RANK],roots)
        if node=NULL then exit end if
        integer x = getd_by_index(node,roots)
        deld(nodes[r][RANK],roots)
        if nodes[x][VALUE]<nodes[r][VALUE] then
            {r, x} = {x, r}
        end if
        nodes[x][PARENT] = r
        nodes[x][MARK] = false
        if nodes[r][CHILD] == NULL then
            nodes[x][NEXT] = x
            nodes[x][PREV] = x
            nodes[r][CHILD] = x
        else
            meld1(nodes[r][CHILD], x)
        end if
        nodes[r][RANK] += 1
    end while
    setd(nodes[r][RANK],r,roots)
end procedure
 
-- task requirement
function ExtractMin(integer h)
    if is_null(h) then
        return {h,"<none>",false}
    end if
    object minimum = nodes[h][VALUE]
    integer roots = new_dict()
    integer r = nodes[h][NEXT], n
    while r != h do
        n := nodes[r][NEXT]
        add_roots(r,roots)
        r = n
    end while
    integer c = nodes[h][CHILD]
    if c != NULL then
        nodes[c][PARENT] = NULL
        r := nodes[c][NEXT]
        add_roots(c,roots)
        while r != c do
            n := nodes[r][NEXT]
            nodes[r][PARENT] = NULL
            add_roots(r,roots)
            r = n
        end while
    end if
    if dict_size(roots) == 0 then
        destroy_dict(roots)
        return {NULL, minimum, true}
    end if
    integer d = getd_partial_key(0,roots)
    integer mv = getd(d,roots)
    deld(d,roots)
    nodes[mv][NEXT] = mv
    nodes[mv][PREV] = mv
    sequence rs = getd_all_keys(roots)
    for i=1 to length(rs) do
        r = getd(rs[i],roots)
        nodes[r][PREV] = mv
        nodes[r][NEXT] = nodes[mv][NEXT]
        nodes[nodes[mv][NEXT]][PREV] = r
        nodes[mv][NEXT] = r
        if nodes[r][VALUE]<nodes[mv][VALUE] then
            mv = r
        end if
    end for
    h = mv
    destroy_dict(roots)
    return {h, minimum, true}
end function
 
procedure cut_and_meld(integer h, x, bool meld)
    integer p := nodes[x][PARENT]
    nodes[p][RANK] -= 1
    if nodes[p][RANK] == 0 then
        nodes[p][CHILD] = NULL
    else
        nodes[p][CHILD] = nodes[x][NEXT]
        nodes[nodes[x][PREV]][NEXT] = nodes[x][NEXT]
        nodes[nodes[x][NEXT]][PREV] = nodes[x][PREV]
    end if
    if nodes[p][PARENT] == NULL then
        return
    end if
    if not nodes[p][MARK] then
        nodes[p][MARK] = true
        return
    end if
    cut_and_meld(h,p,true)
    if meld then
        nodes[x][PARENT] = NULL
        meld1(h, x)
    end if
end procedure
 
-- task requirement
function DecreaseKey(integer h, n, object v)
    if nodes[n][VALUE]<v then
        crash("DecreaseKey new value greater than existing value")
    end if
    nodes[n][VALUE] = v
    if n!=h then
        integer p := nodes[n][PARENT]
        if p == NULL then
            if v<nodes[h][VALUE] then
                h = n
            end if
        else
            cut_and_meld(h,n,true)
        end if
    end if
    return h
end function
 
-- task requirement
function Delete(integer h, n)
    integer p := nodes[n][PARENT]
    if p == NULL then
        if n == h then
            {h} = ExtractMin(h)
            return h
        end if
        nodes[nodes[n][PREV]][NEXT] = nodes[n][NEXT]
        nodes[nodes[n][NEXT]][PREV] = nodes[n][PREV]
    else
        cut_and_meld(h,n,false)
    end if
    integer c := nodes[n][CHILD]
    if c != NULL then
        while true do
            nodes[c][PARENT] = NULL
            c = nodes[c][NEXT]
            if c == nodes[n][CHILD] then
                exit
            end if
        end while
        meld2(h, c)
    end if
    return h
end function
 
constant W=platform()=WINDOWS,
         Horizontal = iff(W?#C4:'-'),
         Vertical   = iff(W?#B3:'|'),
         sBtmLeft   = iff(W?#C0:'+'),
         sLeftTee   = iff(W?#C3:'+'),
         sTopRight  = iff(W?#BF:'+')
 
procedure vis(integer n, string pre)
    string pc = Vertical&" "
    sequence x = nodes[n]
    while true do
        integer next = x[NEXT]
        if next!=n then
            printf(1,pre&sLeftTee&Horizontal)
        else
            printf(1,pre&sBtmLeft&Horizontal)
            pc = "  "
        end if
        if x[CHILD] == NULL then
            printf(1,"%c %s\n",{Horizontal,sprint(x[VALUE])})
        else
            printf(1,"%c %s\n",{sTopRight,sprint(x[VALUE])})
            vis(x[CHILD], pre&pc)
        end if
        if next=n then exit end if
        x = nodes[next]
    end while
end procedure
 
procedure Vis(integer h)
    if is_null(h) then
        printf(1,"<empty>\n")
        return
    end if
    vis(h,"")
end procedure
 
printf(1,"MakeHeap:\n")
integer h := MakeHeap()
Vis(h)
 
printf(1,"\nInsert:\n")
{h} = Insert(h,"cat")
Vis(h)
 
printf(1,"\nUnion:\n")
integer h2 := MakeHeap()
{h2} = Insert(h2,"rat")
{h,h2} = Union(h,h2)     -- (h2:=NULL)
Vis(h)
 
object m = Minimum(h)[1]
printf(1,"\nMinimum:\n%v\n",{m})
 
printf(1,"\nExtractMin:\n")
-- add a couple more items to demonstrate parent-child linking that
-- happens on delete min.
{h} = Insert(h,"bat")
integer x
{h,x} = Insert(h,"meerkat") -- save x for decrease key and delete demos
{h,m} = ExtractMin(h)
printf(1,"(extracted %s)\n", {sprint(m)})
Vis(h)
 
printf(1,"\nDecreaseKey:\n")
h = DecreaseKey(h, x, "gnat")
Vis(h)
 
printf(1,"\nDelete:\n")
-- add yet a couple more items to show how F&T's original delete was
-- lazier than CLRS's delete.
{h} = Insert(h,"bobcat")
{h} = Insert(h,"bat")
printf(1,"(deleting %s)\n", {sprint(nodes[x][VALUE])})
h = Delete(h,x)
Vis(h)
Output:
MakeHeap:
<empty>

Insert:
└── "cat"

Union:
├── "cat"
└── "rat"

Minimum:
"cat"

ExtractMin:
(extracted "bat")
├─┐ "cat"
│ └── "rat"
└── "meerkat"

DecreaseKey:
├─┐ "cat"
│ └── "rat"
└── "gnat"

Delete:
(deleting "gnat")
├── "bat"
├── "bobcat"
└─┐ "cat"
  └── "rat"

Python 

class FibonacciHeap:
    
    # internal node class 
    class Node:
        def __init__(self, data):
            self.data = data
            self.parent = self.child = self.left = self.right = None
            self.degree = 0
            self.mark = False
            
    # function to iterate through a doubly linked list
    def iterate(self, head):
        node = stop = head
        flag = False
        while True:
            if node == stop and flag is True:
                break
            elif node == stop:
                flag = True
            yield node
            node = node.right
    
    # pointer to the head and minimum node in the root list
    root_list, min_node = None, None
    
    # maintain total node count in full fibonacci heap
    total_nodes = 0
    
    # return min node in O(1) time
    def find_min(self):
        return self.min_node
         
    # extract (delete) the min node from the heap in O(log n) time
    # amortized cost analysis can be found here (http://bit.ly/1ow1Clm)
    def extract_min(self):
        z = self.min_node
        if z is not None:
            if z.child is not None:
                # attach child nodes to root list
                children = [x for x in self.iterate(z.child)]
                for i in xrange(0, len(children)):
                    self.merge_with_root_list(children[i])
                    children[i].parent = None
            self.remove_from_root_list(z)
            # set new min node in heap
            if z == z.right:
                self.min_node = self.root_list = None
            else:
                self.min_node = z.right
                self.consolidate()
            self.total_nodes -= 1
        return z
                    
    # insert new node into the unordered root list in O(1) time
    def insert(self, data):
        n = self.Node(data)
        n.left = n.right = n
        self.merge_with_root_list(n)
        if self.min_node is None or n.data < self.min_node.data:
            self.min_node = n
        self.total_nodes += 1
        
    # modify the data of some node in the heap in O(1) time
    def decrease_key(self, x, k):
        if k > x.data:
            return None
        x.data = k
        y = x.parent
        if y is not None and x.data < y.data:
            self.cut(x, y)
            self.cascading_cut(y)
        if x.data < self.min_node.data:
            self.min_node = x
            
    # merge two fibonacci heaps in O(1) time by concatenating the root lists
    # the root of the new root list becomes equal to the first list and the second
    # list is simply appended to the end (then the proper min node is determined)
    def merge(self, h2):
        H = FibonacciHeap()
        H.root_list, H.min_node = self.root_list, self.min_node
        # fix pointers when merging the two heaps
        last = h2.root_list.left
        h2.root_list.left = H.root_list.left
        H.root_list.left.right = h2.root_list
        H.root_list.left = last
        H.root_list.left.right = H.root_list
        # update min node if needed
        if h2.min_node.data < H.min_node.data:
            H.min_node = h2.min_node
        # update total nodes
        H.total_nodes = self.total_nodes + h2.total_nodes
        return H
        
    # if a child node becomes smaller than its parent node we
    # cut this child node off and bring it up to the root list
    def cut(self, x, y):
        self.remove_from_child_list(y, x)
        y.degree -= 1
        self.merge_with_root_list(x)
        x.parent = None
        x.mark = False
    
    # cascading cut of parent node to obtain good time bounds
    def cascading_cut(self, y):
        z = y.parent
        if z is not None:
            if y.mark is False:
                y.mark = True
            else:
                self.cut(y, z)
                self.cascading_cut(z)
    
    # combine root nodes of equal degree to consolidate the heap
    # by creating a list of unordered binomial trees
    def consolidate(self):
        A = [None] * self.total_nodes
        nodes = [w for w in self.iterate(self.root_list)]
        for w in xrange(0, len(nodes)):
            x = nodes[w]
            d = x.degree
            while A[d] != None:
                y = A[d] 
                if x.data > y.data:
                    temp = x
                    x, y = y, temp
                self.heap_link(y, x)
                A[d] = None
                d += 1
            A[d] = x
        # find new min node - no need to reconstruct new root list below
        # because root list was iteratively changing as we were moving 
        # nodes around in the above loop
        for i in xrange(0, len(A)):
            if A[i] is not None:
                if A[i].data < self.min_node.data:
                    self.min_node = A[i]
        
    # actual linking of one node to another in the root list
    # while also updating the child linked list
    def heap_link(self, y, x):
        self.remove_from_root_list(y)
        y.left = y.right = y
        self.merge_with_child_list(x, y)
        x.degree += 1
        y.parent = x
        y.mark = False
        
    # merge a node with the doubly linked root list   
    def merge_with_root_list(self, node):
        if self.root_list is None:
            self.root_list = node
        else:
            node.right = self.root_list.right
            node.left = self.root_list
            self.root_list.right.left = node
            self.root_list.right = node
            
    # merge a node with the doubly linked child list of a root node
    def merge_with_child_list(self, parent, node):
        if parent.child is None:
            parent.child = node
        else:
            node.right = parent.child.right
            node.left = parent.child
            parent.child.right.left = node
            parent.child.right = node
            
    # remove a node from the doubly linked root list
    def remove_from_root_list(self, node):
        if node == self.root_list:
            self.root_list = node.right
        node.left.right = node.right
        node.right.left = node.left
        
    # remove a node from the doubly linked child list
    def remove_from_child_list(self, parent, node):
        if parent.child == parent.child.right:
            parent.child = None
        elif parent.child == node:
            parent.child = node.right
            node.right.parent = parent
        node.left.right = node.right
        node.right.left = node.left

Raku

Translation of: Go & Kotlin
# 20200609 Raku programming solution

subset vEle of Any; 

class Node {
   has vEle $.value  is rw is default(Nil) ; 
   has Node $.parent is rw ;
   has Node $.child  is rw ; 
   has Node $.prev   is rw ; 
   has Node $.next   is rw ;  
   has Int  $.rank   is rw is default(0) ; 
   has Bool $.mark   is rw is default(False) ; 
}

multi infix:<⪡>(vEle \a, vEle \b) { a le b } # custom defined 'less than'

class Heap { 

   has Node $.root is rw ;  

   method MakeHeap { self.root = Node.new } 

   method Insert(vEle \v) {
      my $x = Node.new: value => v;
      if self.root.value ~~ Nil {
         $x.next = $x;
         $x.prev = $x; 
         self.root = $x
      } else {
         meld1(self.root, $x);
         self.root = $x if $x.value ⪡ self.root.value 
      }
      return $x
   }

   method Union(Heap $h2) {
      if not self.root.defined {
         self.root = $h2.root
      } elsif $h2.root.defined { 		 
         meld2(self.root, $h2.root);
         self.root = $h2.root if $h2.root.value ⪡ self.root.value 
      }
      $h2.root = Nil;
   }

   method Minimum() {
      return unless self.root.defined; 
      return self.root.value
   }

   method ExtractMin() {
      return Nil unless self.root.defined;
      my \min = self.root.value;
      my %roots;

      sub add (Node \r) {
         r.prev = r;
         r.next = r;
         loop {
            (defined my \x = %roots{r.rank}) or last;
            %roots{r.rank}:delete;
            (r, x) = (x, r) if x.value ⪡ r.value ; 
            x.parent = r ;
            x.mark = False ;
            if not r.child.defined {
               x.next = x;
               x.prev = x;
               r.child = x
            } else {
               meld1(r.child, x)
            }
            r.rank++
         }
         %roots{r.rank} = r ;
      }

      loop (my \r = self.root.next ; not r ~~ self.root ; ) {
         my $n = r.next;         
         add(r);
         r = $n ;
      }
      if defined (my \c = self.root.child ) {
         c.parent = Nil;
         r = c.next;
         add(c);
         while not r ~~ c {
            my $n = r.next;
            r.parent = Nil;
            add(r);
            r = $n;
         }
      }
      
      unless %roots.defined {
         self.root = Nil;
         return min
      }
      my Node $mv = %roots{my $d = %roots.keys.first}; 
      %roots{$d}:delete;
      $mv.next = $mv;
      $mv.prev = $mv;
      %roots.values.map: {
         $_.prev = $mv;
         $_.next = $mv.next;
         $mv.next.prev = $_;
         $mv.next = $_; 
         $mv = $_ if $_.value ⪡ $mv.value 
      }
      self.root = $mv;
      return min
   }


   method DecreaseKey(\n, \v) {
      die "DecreaseKey new value greater than existing value" if n.value ⪡ v;
      n.value = v; 
      return Nil if n ~~ self.root;
      my \p = n.parent;
      unless p.defined {
         self.root = n if v ⪡ self.root.value; 
         return Nil 
      }
      self.cutAndMeld(n);
      return Nil 
   }

   method cutAndMeld(\x) {
      self.cut(x);
      x.parent = Nil;
      meld1(self.root, x)
   }

   method cut(\x) {
      my \p = x.parent;
      return Nil unless p.defined;
      p.rank--;
      if p.rank == 0 {
         p.child = Nil
      } else {
         p.child = x.next;
         x.prev.next = x.next;
         x.next.prev = x.prev
      }
      return Nil unless p.parent.defined;
      unless p.mark {
        p.mark = True;
        return Nil
      }
      self.cutAndMeld(p)
   }
 
   method Delete(\n) {
      my \p = n.parent;
      if not p.defined {
         self.ExtractMin() and return if n ~~ self.root ; 
         n.prev.next = n.next;
         n.next.prev = n.prev
      } else {
         self.cut(n)
      }
      my \c = n.child;
      return Nil unless c.defined;
      loop ( c.parent = Nil, c = c.next ; c ~~ n.child ; c = c.next ) {} 
      meld2(self.root, c)
   }

   method Vis() {

      if self.root.value ~~ Nil { say "<empty>" and return }

      sub f(Node $n, Str $pre) {
         loop ( my $pc = "│ ", my $x = $n ; ; $x = $x.next) {
            if !($x.next ~~ $n) {
               print $pre, "├─"
            } else {
               print $pre, "└─";
               $pc = "  "
            }
            if not $x.child.defined {
               say "╴", $x.value
            } else {
               say "┐", $x.value;
               f($x.child, $pre~$pc)
            }
            last if $x.next ~~ $n 
         }
      }
      f(self.root, "")
   }
}

sub meld1(\list, \single) {
   list.prev.next = single;
   single.prev = list.prev;
   single.next = list;
   list.prev = single;
}

sub meld2(\a, \b) {
   a.prev.next = b;
   b.prev.next = a;
   ( a.prev, b.prev ) = ( b.prev, a.prev )
}

say "MakeHeap:";
my $h = Heap.new; 
$h.MakeHeap;
$h.Vis;

say "\nInsert:";
$h.Insert("cat");
$h.Vis;

say "\nUnion:";
my $h2 = Heap.new; 
$h2.MakeHeap;
$h2.Insert("rat");
$h.Union($h2);
$h.Vis;

say "\nMinimum:";
my \m = $h.Minimum();
say m;

say "\nExtractMin:";
$h.Insert("bat");
my $x = $h.Insert("meerkat"); 
say "extracted: ", my $mm = $h.ExtractMin();
$h.Vis;

say "\nDecreaseKey:";
$h.DecreaseKey($x, "gnat");
$h.Vis;

say "\nDelete:";
$h.Insert("bobcat");
$h.Insert("bat");
say "deleting: ", $x.value;
$h.Delete($x);
$h.Vis;
Output:
MakeHeap:
<empty>

Insert:
└─╴cat

Union:
├─╴cat
└─╴rat

Minimum:
cat

ExtractMin:
extracted: bat
├─┐cat
│ └─╴rat
└─╴meerkat

DecreaseKey:
├─┐cat
│ └─╴rat
└─╴gnat

Delete:
deleting: gnat
├─╴bat
├─╴bobcat
└─┐cat
  └─╴rat

Wren

Translation of: Kotlin
Library: Wren-str

This just deals with nodes whose values are strings. 

import "./str" for Str

class Node {
    construct new(value) {
        _value  = value
        _parent = null
        _child  = null
        _prev   = null
        _next   = null
        _rank   = 0
        _mark   = false
    }

    value  { _value  }
    parent { _parent }
    child  { _child  }
    prev   { _prev   }
    next   { _next   }
    rank   { _rank   }
    mark   { _mark   }

    value=(v)  { _value = v  }
    parent=(p) { _parent = p }
    child=(c)  { _child = c  }
    prev=(p)   { _prev = p   }
    next=(n)   { _next = n   }
    rank=(r)   { _rank = r   }
    mark=(m)   { _mark = m   }

    meld1(node) {
        if (_prev) _prev.next = node
        node.prev = _prev
        node.next = this
        _prev = node
    }

    meld2(node) {
        if (_prev) _prev.next = node
        if (node.prev) node.prev.next = this
        var temp = _prev
        _prev = node.prev
        node.prev = temp
    }
}

class FibonacciHeap {
    construct new() {
        _node = null
    }

    construct new(node) {
        _node = node
    }

    node     { _node }
    node=(n) { _node = n }

    insert(v) {
        var x = Node.new(v)
        if (!_node) {
            x.next = x
            x.prev = x
            _node = x
        } else {
            _node.meld1(x)
            if (Str.lt(x.value, _node.value)) _node = x
        }
        return x
    }

    union(other) {
        if (!_node) {
            _node = other.node
        } else if (other.node) {
            _node.meld2(other.node)
            if (Str.lt(other.node.value, _node.value)) _node = other.node
        }
        other.node = null
    }

    minimum() { _node.value }

    extractMin() {
        if (!_node) return null
        var min = minimum()
        var roots = {}

        var add = Fn.new { |r|
            r.prev = r
            r.next = r
            var rr = r
            while (true) {
                var x = roots[rr.rank]
                if (!x) break
                roots.remove(rr.rank)
                if (Str.lt(x.value, rr.value)) {
                    var t = rr
                    rr = x
                    x = t
                }
                x.parent = rr
                x.mark = false
                if (!rr.child) {
                    x.next = x
                    x.prev = x
                    rr.child = x
                } else {
                    rr.child.meld1(x)
                }
                rr.rank = rr.rank + 1
            }
            roots[rr.rank] = rr
        }
 
        var r = _node.next
        while (r != _node) {
            var n = r.next
            add.call(r)
            r = n
        }
        var c = _node.child
        if (c) {
            c.parent = null
            var rr = c.next
            add.call(c)
            while (rr != c) {
                var n = rr.next
                rr.parent = null
                add.call(rr)
                rr = n
            }
        }
        if (roots.isEmpty) {
            _node = null
            return min
        }
        var d = roots.keys.toList[0]
        var mv = roots[d]
        roots.remove(d)
        mv.next = mv
        mv.prev = mv
        for (rr in roots.values) {
            rr.prev = mv
            rr.next = mv.next
            mv.next.prev = rr
            mv.next = rr
            if (Str.lt(rr.value, mv.value)) mv = rr
        }
        _node = mv
        return min
    }

    decreaseKey(n, v) {
        if (Str.le(n.value, v)) {
            Fiber.abort("In 'decreaseKey' new value greater than or equal to existing value.")
        }
        n.value = v
        if (n == _node) return
        var p = n.parent
        if (!p) {
            if (Str.lt(v, _node.value)) _node = n
            return
        }
        cutAndMeld_(n)
    }

    cut_(x) {
        var p = x.parent
        if (!p) return
        p.rank = p.rank - 1
        if (p.rank == 0) { 
            p.child = null
        } else {
            p.child = x.next
            if (x.prev) x.prev.next = x.next
            if (x.next) x.next.prev = x.prev
        }
        if (!p.parent) return
        if (!p.mark) {
            p.mark = true
            return
        }
        cutAndMeld_(p)
    }

    cutAndMeld_(x) {
        cut_(x)
        x.parent = null
        if(_node) _node.meld1(x)
    }

    delete(n) {
        var p = n.parent
        if (!p) {
            if (n == _node) {
                extractMin()
                return
            }
            if (n.prev) n.prev.next = n.next
            if (n.next) n.next.prev = n.prev
        } else {
            cut_(n)
        }
        var c = n.child
        if (!c) return
        while (true) {
            c.parent = null
            c = c.next
            if (c == n.child) break
        }
        if (_node) _node.meld2(c)
    }

    visualize() {
        if (!_node) {
            System.print("<empty>")
            return
        }

        var f // recursive closure
        f = Fn.new { |n, pre|
            var pc = "│ "
            var x = n
            while (true) {
                if (x.next != n) {
                    System.write("%(pre)├─")
                } else {
                    System.write("%(pre)└─")
                    pc = "  "
                }
                if (!x.child) {
                    System.print("╴ %(x.value)")
                } else {
                    System.print("┐ %(x.value)")
                    f.call(x.child, pre + pc)
                }
                if (x.next == n) break
                x = x.next
            }
        }
        f.call(_node, "")
    }
}

var makeHeap = Fn.new { FibonacciHeap.new() }

System.print("MakeHeap:")
var h = makeHeap.call()
h.visualize()

System.print("\nInsert:")
h.insert("cat")
h.visualize()

System.print("\nUnion:")
var h2 = makeHeap.call()
h2.insert("rat")
h.union(h2)
h.visualize()

System.print("\nMinimum:")
var m = h.minimum()
System.print(m)

System.print("\nExtractMin:")
// add a couple more items to demonstrate parent-child linking that
// happens on delete min.
h.insert("bat")
var x = h.insert("meerkat")  // save x for decrease key and delete demos.
m = h.extractMin()
System.print("(extracted '%(m)')")
h.visualize()

System.print("\nDecreaseKey:")
h.decreaseKey(x, "gnat")
h.visualize()

System.print("\nDelete:")
// add a couple more items.
h.insert("bobcat")
h.insert("bat")
System.print("(deleting '%(x.value)')")
h.delete(x)
h.visualize()
Output:
MakeHeap:
<empty>

Insert:
└─╴ cat

Union:
├─╴ cat
└─╴ rat

Minimum:
cat

ExtractMin:
(extracted 'bat')
├─┐ cat
│ └─╴ rat
└─╴ meerkat

DecreaseKey:
├─┐ cat
│ └─╴ rat
└─╴ gnat

Delete:
(deleting 'gnat')
├─╴ bat
├─╴ bobcat
└─┐ cat
  └─╴ rat
Retrieved from "https://rosettacode.org/wiki/Fibonacci_heap?oldid=379622"
Cookies help us deliver our services. By using our services, you agree to our use of cookies.
More information