Cây khung nhỏ nhất QBMST spoj: Kruskal, Prim heap

Code QBMST được viết bằng thuật toán Kruskal Pascal

Mình đã bỏ một số phần thừa trong sách TLGK Chuyên tin

Thuật toán kruskal dưới đây được biểu diễn đồ thị bằng danh sách cạnh trong lí thuyết đồ thị:

const   fi='';
        nmax=15500;
type
        data=longint;

var     f:text;
        u,v,c:array[1..nmax] of data;
        root:array[1..nmax] of data;
        n,m:data;

procedure docfile;
var     i:data;
begin
        assign(f,fi); reset(f);
        readln(f,n,m);
        for i:=1 to m do
                readln(f,u[i],v[i],c[i]);
        close(f);
end;

procedure swap(var a,b:data);
var     z:data;
begin
        z:=a;
        a:=b;
        b:=z;
end;

procedure quicksort(l,r:data);
var i,j,mid:data;
        begin
                i:=l;
                j:=r;
                mid:=c[(l+r) div 2];
                repeat
                        while c[i] < mid do i:=i+1;
                        while c[j] > mid do j:=j-1;
                        if i<= j then
                                begin
                                        swap(u[i],u[j]);
                                        swap(c[i],c[j]);
                                        swap(v[i],v[j]);
                                        i:=i+1;
                                        j:=j-1;
                                end;
                until i>j;
                if i<r then quicksort(i,r);
                if j>l then quicksort(l,j);
        end;

function findroot(x:data):data;
begin
        if root[x]<>x then
                root[x]:=findroot(root[x]);
        exit(root[x]);
end;

procedure union(x,y:data);
begin
        root[x]:=y;
end;

procedure kruskal;
var     i,ur,uv:data;
        t:longint;
begin
        for i:=1 to n do root[i]:=i;
        t:=0;
        for i:=1 to m do
                begin
                        ur:=findroot(u[i]);
                        uv:=findroot(v[i]);
                        if ur<>uv then
                                begin
                                        union(ur,uv);
                                        t:=t+c[i];
                                end;
                end;
        writeln(t);
end;

begin
        docfile;
        Quicksort(1,m);
        kruskal;
end.

Code QBMST được viết bằng Prim Heap Pascal

const   fi='';
        nmax=11000;
        mmax=30000;
        maxc=50000;
type    data=longint;
var
        f:text;
        adj,adc:array[0..2*mmax+2] of data;
        tmp,tmpc,head,u,v,C,heap,pos,d:array[0..mmax+1] of data;
        dd:array[0..nmax+1] of boolean;
        n,m,k,s,t,nheap:data;

procedure swaps(u,v:data);
var     k,i,j:data;
begin
        k:=0;
        for i:=u to v do
                begin
                        inc(k);
                        tmp[k]:=adj[i];
                        tmpc[k]:=adc[i];
                end;
        for i:=u to v do
                begin
                        adj[i]:=tmp[k];
                        adc[i]:=tmpc[k];
                        dec(K);
                end;
end;

procedure swap(var a,b:data);
var     z:data;
begin
        z:=a;
        a:=b;
        b:=z;
end;

procedure upheap(i:data);
begin
        if (i div 2=0) or (d[heap[i]]>d[heap[i div 2]]) then exit;
        swap(heap[i],heap[i div 2]);
        swap(pos[heap[i]],pos[heap[i div 2]]);
        upheap(i div 2);
end;


procedure downheap(i:data);
var     j:data;
begin
        j:=i*2;
        if j>nHeap then exit;
        if (j<nHeap) and (d[heap[j]]>d[heap[j+1]]) then inc(j);
        if d[heap[i]]<=d[heap[j]] then exit;
        swap(heap[i],heap[j]);
        swap(pos[heap[i]],pos[heap[j]]);
        downheap(j);
end;

procedure push(x:data);
begin
        inc(nHeap);
        heap[nHeap]:=x;
        upheap(Nheap);
end;

function pop:data;
begin
        pop:=Heap[1];
        heap[1]:=heap[nheap];
        dec(nheap);
        downheap(1);
end;


Procedure update(i:longint);
Begin
        if (i=1) or (d[heap[i]]>d[heap[i div 2]]) then exit;
        swap(heap[i],heap[i div 2]);
        swap(pos[heap[i]],pos[heap[i div 2]]);
        update(i div 2);
End;

procedure docfile;
var     i,j:data;
begin
        assign(f,fi); reset(f);
        read(f,n,m);
        fillchar(head,sizeof(head),0);
        for i:=1 to m do
                begin
                        read(f,u[i],v[i],c[i]);
                        inc(head[u[i]]);
                        inc(head[v[i]]);
                end;
        for i:=1 to n+1 do
                head[i]:=head[i-1]+head[i];
        for i:=1 to m do
                begin
                        adj[head[u[i]]]:=v[i];
                        adc[head[u[i]]]:=c[i];
                        dec(head[u[i]]);

                        adj[head[v[i]]]:=u[i];
                        adc[head[v[i]]]:=c[i];
                        dec(head[v[i]]);
                end;
        close(f);
        for i:=1 to n do
        	swaps(head[i]+1,head[i+1]);
end;


procedure prim;
var     i,j,u,v,res:data;
begin
        for i:=1 to n do
                begin
                        heap[i]:=i;
                        pos[i]:=i;
                        d[i]:=maxc;
                end;
        d[1]:=0;
        fillchar(dd,sizeof(dd),false);
        nHeap:=n;
        Update(1);
        repeat
                u:=pop;
                dd[u]:=true;
                for v:=head[u]+1 to head[u+1] do
                        if (not dd[adj[v]]) and (d[adj[v]]>adc[v]) then
                                begin
                                        d[adj[v]]:=adc[v];
                                        upheap(pos[adj[v]]);
                                end;
        until nheap=0;
        res:=0;
        for i:=1 to n do
                res:=res+d[i];
        writeln(res);
end;

begin
        docfile;
        prim;
end.