Fibonacci heap Dijkstra implementation, tested against https://vn.spoj.com/problems/FLOYD/

floyd_fibheap.pas

{$M 2000000}
program floyd;
const
    nm = 100;
    oo = 4*trunc(1e9);
type
    pNode = ^node;
    node = record
        v: word;
        w: longword;
        next: pNode;
    end;
    pFibNode = ^FibNode;
    FibNode = record
        val: word;
        key, degree: longword;
        cut: boolean;
        parent, left, right, child: pFibNode;
    end;
    FibHeap = object
        root: pFibNode;
        tree: array[0..32] of pFibNode;
        procedure insert(x: pFibNode);
        function insert(const v: word; const w: longword): pFibNode;
        procedure remove(x: pFibNode);
        procedure decreaseKey(tmp: pFibNode; const w: longword);
        //procedure merge(f: FibHeap);
        procedure join(tmp: pFibNode);
        function extractMin: longword;
    end;
    procedure FibHeap.insert(x: pFibNode);
        begin
            x^.parent := nil;
            if (root = nil) then
                begin
                    x^.left := x;
                    x^.right := x;
                    root := x;
                    exit;
                end;
            x^.left := root^.left;
            x^.right := root;
            root^.left^.right := x;
            root^.left := x;
            if (root^.key > x^.key) then root := x;
        end;
    function FibHeap.insert(const v: word; const w: longword): pFibNode;
        var
            tmp: pFibNode;
        begin
            new(tmp);
            tmp^.val := v;
            tmp^.key := w;
            tmp^.degree := 0;
            tmp^.cut := false;
            tmp^.parent := nil;
            tmp^.left := tmp;
            tmp^.right := tmp;
            tmp^.child := nil;
            insert(tmp);
            exit(tmp);
        end;
    procedure FibHeap.remove(x: pFibNode);
        var
            par: pFibNode;
        begin
            par := x^.parent;
            if (x^.right = x) then par^.child := nil
            else begin
                x^.left^.right := x^.right;
                x^.right^.left := x^.left;
                if (par^.child = x) then par^.child := x^.right;
            end;
            dec(par^.degree);
        end;
    procedure FibHeap.decreaseKey(tmp: pFibNode; const w: longword);
        var
            par: pFibNode;
        begin
            par := tmp^.parent;
            tmp^.key := w;
            if (par = nil) then
                begin
                    if (root^.key > tmp^.key) then root := tmp;
                    exit;
                end;
            if (tmp^.key < par^.key) then
                begin
                    remove(tmp);
                    insert(tmp);
                    tmp := par;
                    par := tmp^.parent;
                    while (tmp^.cut and (par <> nil)) do
                        begin
                            remove(tmp);
                            insert(tmp);
                            tmp := par;
                            par := par^.parent;
                        end;
                end;
            tmp^.cut := true;
        end;
    procedure FibHeap.join(tmp: pFibNode);
        var
            nRoot, nChild: pFibNode;
        begin
            while (tree[tmp^.degree] <> nil) do
                begin
                    if (tree[tmp^.degree]^.key < tmp^.key) then
                        begin
                            nRoot := tree[tmp^.degree];
                            nChild := tmp;
                        end
                        else begin
                            nRoot := tmp;
                            nChild := tree[tmp^.degree];
                        end;
                    nChild^.parent := nRoot;
                    nChild^.cut := false;
                    if (nRoot^.child = nil) then
                        begin
                            nRoot^.child := nChild;
                            nChild^.left := nChild;
                            nChild^.right := nChild;
                        end
                        else begin
                            nChild^.left := nRoot^.child^.left;
                            nChild^.right := nRoot^.child;
                            nRoot^.child^.left^.right := nChild;
                            nRoot^.child^.left := nChild;
                        end;
                    tmp := nRoot;
                    tree[tmp^.degree] := nil;
                    inc(tmp^.degree);
                end;
            tree[tmp^.degree] := tmp;
        end;
    function FibHeap.extractMin: longword;
        var
            i, res: longword;
            scan, pre: pFibNode;
        begin
            if (root = nil) then exit(0);
            res := root^.val;
            scan := root^.child;
            if (scan <> nil) then
                repeat
                    pre := scan;
                    scan := scan^.right;
                    join(pre);
                until (scan = root^.child);
            scan := root^.right;
            while (scan <> root) do
                begin
                    pre := scan;
                    scan := scan^.right;
                    join(pre);
                end;
            root := nil;
            for i := 0 to 32 do
                if (tree[i] <> nil) then
                    begin
                        insert(tree[i]);
                        tree[i] := nil;
                    end;
            exit(res);
        end;
var
    adj: array[1..nm] of pNode;
    d: array[1..nm, 1..nm] of longword;
    trace: array[1..nm, 1..nm] of byte;
    f: array[1..nm] of pFibNode;
    n, test, count: word;
    heap: FibHeap;
procedure inp;
    var
        i, m, u, v, w: longword;
        t: pNode;
    begin
        readln(n, m, test);
        for i := 1 to n do
            begin
                adj[i] := nil;
            end;
        for i := 1 to m do
            begin
                readln(u, v, w);
                new(t);
                t^.v := v;
                t^.w := w;
                t^.next := adj[u];
                adj[u] := t;
                new(t);
                t^.v := u;
                t^.w := w;
                t^.next := adj[v];
                adj[v] := t;
            end;
        filldword(d, sizeof(d) div sizeof(longword), oo);
    end;
procedure dijkstra(const u0: word);
    var
        u, cnt: word;
        t: pNode;
    begin
        d[u0, u0] := 0; trace[u0, u0] := 0;
        for u := 1 to n do f[u] := nil;
        f[u0] := heap.insert(u0, 0); cnt := 0;
        repeat
            u := heap.extractMin;
            if (u = 0) then break;
            f[u] := nil;
            t := adj[u];
            while (t <> nil) do
                begin
                    if ((d[u0, u] + t^.w) < d[u0, t^.v]) then
                        begin
                            d[u0, t^.v] := d[u0, u] + t^.w;
                            trace[u0, t^.v] := u;
                            if (f[t^.v] = nil) then f[t^.v] := heap.insert(t^.v, d[u0, t^.v]) else heap.decreaseKey(f[t^.v], d[u0, t^.v]);
                        end;
                    t := t^.next;
                end;
        until false;
    end;
procedure tracePath(const u0, v: word);
    begin
        if (v <> 0) then
            begin
                inc(count);
                tracePath(u0, trace[u0, v]);
                write(v, ' ');
            end
        else write(count, ' ');
    end;
procedure sol;
    var
        i, j, q, u, v: word;
    begin
        fillchar(trace, sizeof(trace), 0);
        for i := 1 to n do dijkstra(i);
        for i := 1 to test do
            begin
                readln(q, u, v);
                if (q = 0) then writeln(d[u, v]) else begin
                    count := 0;
                    tracePath(u, v);
                    writeln;
                end;
            end;
    end;
begin
    inp;
    sol;
end.