Cod sursa(job #796587)

Utilizator Buzu_Tudor_RoCont vechi Buzu_Tudor_Ro Data 11 octombrie 2012 21:03:42
Problema Distante Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.24 kb
Program p2;
var fi,fo:text;
    p,g:0..15;
    i,n,m,s:longint;
    d,q:array[0..50005] of longint;
    a,b,c:array[0..100003] of longint;

Procedure verific;
var i,k:longint; t:boolean;
begin
    if d[s]<>0 then writeln(fo,'NU')
               else begin
                    t:=true;
                    for i:=1 to n do q[i]:=0;
                    for i:=1 to m do if d[a[i]]+c[i]<d[b[i]] then t:=false
                        else if (d[a[i]]+c[i]=d[b[i]]) then q[b[i]]:=1;
                    if t=false then writeln(fo,'NU')
                               else begin
                                    k:=0;
                                    for i:=1 to n do k:=k+q[i];
                                    if k=n-1 then writeln(fo,'DA');
                                    end;
                    end;
end;

begin
    assign(fi,'distante.in'); reset(fi);
    assign(fo,'distante.out'); rewrite(fo);
    readln(fi,p);

    for g:=1 to p do begin
                     readln(fi,n,m,s);
                     for i:=1 to n do read(fi,d[i]);
                     for i:=1 to m do readln(fi,a[i],b[i],c[i]);
                     verific;
                     readln(fi);
                     end;
    close(fi); close(fo);
end.