TRAFFICN - Traffic Network

Tác giả: ll931110

Ngôn ngữ: Pascal

Program TRAFFICN;
        Const
                input  = '';
                output = '';
                  maxn = 10000;
                  maxm = 100000;
                  maxv = 1000000000;
        Type
                arrn = array[1..maxn + 1] of longint;
                arrm = array[1..maxm + 1] of longint;
        Var
             h,hs,ht,heap,pos: arrn;
                      d,ds,dt: arrn;
                  adj,adjcost: arrm;
                adjs,adjcosts: arrm;
                adjt,adjcostt: arrm;
                        x,y,c: arrm;
                         free: array[1..maxn] of boolean;
                    n,m,k,s,t: longint;
                       test,i: integer;
                        nHeap: longint;
                        fi,fo: text;

Procedure openfile;
          Begin
                Assign(fi, input);
                        Reset(fi);

                Assign(fo, output);
                        Rewrite(fo);
          End;

Procedure LoadGraph;
          Var
                i: longint;
          Begin
                Fillchar(hs, sizeof(hs), 0);
                Fillchar(ht, sizeof(ht), 0);

                Readln(fi, n, m, k, s, t);
                For i:= 1 to m do
                        Begin
                                Readln(fi, x[i], y[i], c[i]);
                                inc(hs[x[i]]);
                                inc(ht[y[i]]);
                        End;

                For i:= 2 to n do hs[i]:= hs[i] + hs[i - 1];
                For i:= 2 to n do ht[i]:= ht[i] + ht[i - 1];

                For i:= 1 to m do
                        Begin
                                adjs[hs[x[i]]]:= y[i];
                                adjcosts[hs[x[i]]]:= c[i];
                                dec(hs[x[i]]);

                                adjt[ht[y[i]]]:= x[i];
                                adjcostt[ht[y[i]]]:= c[i];
                                dec(ht[y[i]]);
                        End;

                hs[n + 1]:= m;
                ht[n + 1]:= m;
          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 + 1]] < d[heap[c]]) 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 Dijkstra(s: longint);
          Var
                u,v,i,iv: longint;
          Begin
                nHeap:= 0;

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

                For i:= 1 to n do d[i]:= maxv;
                d[s]:= 0;

                update(s);
                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] > d[u] + adjcost[iv]) then
                                        Begin
                                                d[v]:= d[u] + adjcost[iv];
                                                update(v);
                                        End;
                          End;
                Until nHeap = 0;
          End;

Procedure solve;
          Var
                i,minway: longint;
                u,v,cost: longint;
                     tmp: longint;
          Begin
                h:= hs;
                adj:= adjs;
                adjcost:= adjcosts;
                Dijkstra(s);
                ds:= d;

                h:= ht;
                adj:= adjt;
                adjcost:= adjcostt;
                Dijkstra(t);
                dt:= d;

                minway:= ds[t];
                For i:= 1 to k do
                  Begin
                        Readln(fi, u, v, cost);

                        tmp:= ds[u] + dt[v] + cost;
                        If minway > tmp then minway:= tmp;

                        tmp:= ds[v] + dt[u] + cost;
                        If minway > tmp then minway:= tmp;
                  End;

                If minway = maxv then writeln(fo, -1)
                                 else writeln(fo, minway);
          End;

Procedure closefile;
          Begin
                Close(fo);
                Close(fi);
          End;

Begin
        openfile;

        Readln(fi, test);
        For i:= 1 to test do
                Begin
                        LoadGraph;
                        solve;
                End;

        closefile;
End.

Download