Cod sursa(job #1363623)

Utilizator mihai1996Toader Mihai mihai1996 Data 27 februarie 2015 09:05:24
Problema Distante Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.32 kb
program distante;
const inf=maxlongint;
type    lista=array[0..2,1..200000] of longint;
        pornire=array[1..50000] of longint;
        vizitat=array[1..50000] of 0..1;
        distanta=array[1..50000] of longint;
        coada=array[1..200000] of longint;
        buffer=array[1..200000] of char;
var     t:lista;
        start:pornire;
        cd:coada;
        viz:vizitat;
        d0,d:distanta;
        bufin,bufout:buffer;
        n,m,i,j,nr,s:longint;
        ok:boolean;
        f,g:text;

procedure bellman_ford(x:longint);
var sf,st,p,nd:longint;
begin
 st:=1; sf:=1; cd[sf]:=x; d[x]:=0;
 while st<=sf do
 begin
        nd:=cd[st];
        viz[nd]:=0;
        p:=start[nd];
        while p<>0 do
        begin
                if d[nd]+t[2,p]<d[t[0,p]] then
                 begin
                         d[t[0,p]]:=d[nd]+t[2,p];
                         if viz[t[0,p]]=0 then
                         begin
                                viz[t[0,p]]:=1;
                                sf:=sf+1;
                                cd[sf]:=t[0,p];
                         end;
                 end;
                p:=t[1,p];
        end;
        st:=st+1;
 end;
end;

procedure citire_graf;
var i,j,z,k,cost:longint;
begin
 readln(f,n,m,s);
 for i:=1 to n do
        read(f,d0[i]);
 k:=0;
 for z:=1 to m do
 begin
        readln(f,i,j,cost);
        k:=k+1;
        t[0,k]:=j;
        t[1,k]:=start[i];
        t[2,k]:=cost;
        start[i]:=k;
        k:=k+1;
        t[0,k]:=i;
        t[1,k]:=start[j];
        t[2,k]:=cost;
        start[j]:=k;
 end;
end;

begin
 assign(f,'distante.in'); reset(f);
 assign(g,'distante.out'); rewrite(g);
 settextbuf(f,bufin);
 settextbuf(g,bufout);
 readln(f,nr);
 for i:=1 to nr do
 begin
        citire_graf;
        for j:=1 to n do
                d[j]:=inf;
        bellman_ford(s);
        ok:=true;
        for j:=1 to n do
                if d0[j]<>d[j] then
                begin
                        ok:=false;
                        break;
                end;
        if ok then
                writeln(g,'DA')
        else
                writeln(g,'NU');
        for j:=1 to n do
        begin
                viz[j]:=0;
                start[j]:=0;
        end;
 end;
 close(f);
 close(g);
end.