QBMST - Cây khung nhỏ nhất ( HEAP )

Tác giả: ll931110

Ngôn ngữ: Pascal

Program QBMST;
        Const
                input  = '';
                output = '';
                  maxn = 10000;
                  maxm = 15000;
                  maxc = 1000000000;
        Type
                arrn = array[0..maxn + 1] of longint;
                arrm = array[1..maxm + 1] of longint;
                 arr = array[0..2 * maxm + 1] of longint;
               check = array[1..maxn] of boolean;
        Var
                      x,y,c: arrm;
              h,adj,adjcost: arr;
           d,trace,heap,pos: arrn;
                  n,m,nHeap: longint;
                       free: check;

Procedure LoadGraph;
          Var
                f: text;
                i: longint;
          Begin
                Assign(f, input);
                        Reset(f);

                Fillchar(h, sizeof(h), 0);
                Readln(f, n, m);

                For i:= 1 to m do
                  Begin
                        Readln(f, x[i], y[i], c[i]);
                        inc(h[x[i]]);
                        inc(h[y[i]]);
                  End;

                Close(f);

                For i:= 2 to n do h[i]:= h[i] + h[i - 1];
                For i:= 1 to m do
                  Begin
                        adj[h[x[i]]]:= y[i];
                        adjcost[h[x[i]]]:= c[i];
                        dec(h[x[i]]);

                        adj[h[y[i]]]:= x[i];
                        adjcost[h[y[i]]]:= c[i];
                        dec(h[y[i]]);
                  End;

                h[n + 1]:= 2 * m;
          End;

Procedure init;
          Var
                i: integer;
          Begin
                d[1]:= 0;
                For i:= 2 to n do d[i]:= maxc;

                Fillchar(pos, sizeof(pos), 0);
                Fillchar(free, sizeof(free), true);
                Fillchar(trace, sizeof(trace), 0);

                nHeap:= 0;
          End;

Procedure Update(v: longint);
          Var
                parent,child: longint;
          Begin
                child:= pos[v];
                If child = 0 then
                  Begin
                        inc(nHeap);
                        child:= nHeap;
                  End;

                parent:= child div 2;
                While (parent > 0) and (d[heap[parent]] > d[v]) do
                  Begin
                        heap[child]:= heap[parent];
                        pos[heap[child]]:= child;

                        child:= parent;
                        parent:= child div 2;
                  End;

                heap[child]:= v;
                pos[v]:= child;
          End;

Function pop: longint;
         Var
                r,c,v: longint;
         Begin
                pop:= heap[1];
                v:= heap[nHeap];
                dec(nHeap);

                r:= 1;
                While r * 2 <= nHeap do
                  Begin
                        c:= r * 2;
                        If (c < nHeap) and (d[heap[c]] > d[heap[c + 1]]) then inc(c);
                        If d[v] <= d[heap[c]] then break;

                        heap[r]:= heap[c];
                        pos[heap[r]]:= r;

                        r:= c;
                  End;

                heap[r]:= v;
                pos[v]:= r;
         End;

Procedure Prim;
          Var
                i,u,v,iv: longint;
          Begin
                Update(1);
                Repeat
                        u:= pop;
                        free[u]:= false;

                        For iv:= h[u] + 1 to h[u + 1] do
                          Begin
                                v:= adj[iv];
                                If free[v] and (d[v] > adjcost[iv]) then
                                  Begin
                                        d[v]:= adjcost[iv];
                                        trace[v]:= u;
                                        update(v);
                                  End;
                          End;
                Until nHeap = 0;
          End;

Procedure printresult;
          Var
                         f: text;
                u,v,iv,res: longint;
          Begin
                Assign(f, output);
                        Rewrite(f);

                res:= 0;
                For u:= 2 to n do
                    For iv:= h[u] + 1 to h[u + 1] do
                        Begin
                                v:= adj[iv];
                                If v = trace[u] then
                                  Begin
                                        res:= res + adjcost[iv];
                                        break;
                                  End;
                        End;

                    Writeln(f, res);
                Close(f);
          End;

Begin
        LoadGraph;
        init;
        Prim;
        printresult;
End.

Download