Cod sursa(job #271722)

Utilizator 05_YohnE1 La5c01 05_Yohn Data 5 martie 2009 21:04:21
Problema Distante Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.97 kb
const inf=100000;
type pnod=^nod;
     nod= record
          info:word;
          dist:integer;
          urm:pnod;
          end;

var v:array[1..50001]of pnod;
    d,tz:array[1..50001] of longint;
    c:array[1..50001]of word;
    viz:array[1..50001]of boolean;
    ok:boolean;
    q:pnod;
    tt,t:byte;
    f,g:text;
    m,i:longint;
    n,vf,s,x,y,cc,p,u:word;

procedure init(var p:pnod;y,z:longint);
var q:pnod;
begin
new(q);
q^.info:=y;
q^.dist:=z;
if p=nil then begin
              q^.urm:=nil;
              p:=q;
              end
        else begin
             q^.urm:=p;
             p:=q;
             end;
end;


procedure bellford;
begin
read(f,n,m,s);
for i:=1 to n do read(f,tz[i]);
for i:=1 to m do begin
        read(f,x,y,cc);
        init(v[x],y,cc);
        init(v[y],x,cc);
    end;
for i:=1 to n do d[i]:=inf;
for i:=1 to n do viz[i]:=false;
viz[s]:=true;
p:=1;u:=1;
c[p]:=s;
d[s]:=0;
while p<=u do begin
      vf:=c[p];
      q:=v[vf];
      while q<>nil do begin
            if not (viz[q^.info])or(d[q^.info]>d[vf]+q^.dist) then begin
                  d[q^.info]:=d[vf]+q^.dist;
                  if not viz[q^.info] then begin
                                      viz[q^.info]:=true;
                                      inc(u);
                                      c[u]:=q^.info;
                                      end;
                  end;
          q:=q^.urm;
          end;

    inc(p);
end;
end;

function verif:boolean;
var i:word;
begin
verif:=true;
for i:=1 to n do if tz[i]<>d[i] then begin
                                verif:=false;
                                break;
                                end;
end;
begin
assign(f,'distante.in');reset(f);
assign(g,'distante.out');rewrite(g);
read(f,t);
for tt:=1 to t do begin
    bellford;
    for i:=1 to n do v[i]:=nil;
    ok:=verif;
    if ok then writeln(g,'DA')
          else writeln(g,'NU');
end;
close(g);
end.