Cod sursa(job #22258)

Utilizator hitmannCiocas Radu hitmann Data 25 februarie 2007 23:34:08
Problema Distante Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.66 kb
program distante;
const
pinfinit=maxlongint;
type pnod=^nod;
     nod=record
         nod:byte;
         i:longint;
         urm:pnod;
         end;
var a:array[1..50000]of pnod;
    d,d1:array[1..50000]of longint;
    s:array[1..100]of integer;
    i,j,poz,r,n,m,head,tail:longint;
    p:pnod;
    t,q:byte;
    ok:boolean;
    min:longint;
    c:array[1..50000]of integer;
    f,g:text;
procedure citire;
var z,y,x:longint;
begin
read(f,n,m,r);
for i:=1 to n do begin
                 read(f,d1[i]);
                 s[i]:=0;
                 a[i]:=nil;
                 end;
for i:=1 to m do
 begin read(f,x,y,z); new(p); p^.nod:=y; p^.i:=z; p^.urm:=a[x]; a[x]:=p;
 new(p); p^.i:=z; p^.nod:=x; p^.urm:=a[y]; a[y]:=p; end;
end;
begin {pp}
assign(f,'distante.in'); reset(f); assign(g,'distante.out'); rewrite(g);
read(f,t);
for q:=1 to t do
begin
citire;
s[r]:=1;
p:=a[r];
head:=1;
tail:=1;
c[tail]:=r;
for i:=1 to n do
 begin
   if i<>r then
           begin inc(tail); c[tail]:=i; end;
 d[i]:=pinfinit;
 end;
while p<>nil do
 begin
 d[p^.nod]:=p^.i;
 p:=p^.urm;
 end;
d[r]:=0;
for j:=1 to n-1 do
begin
min:=pinfinit;
poz:=0;
for i:=1  to n do
 if s[i]=0 then if d[i]<min then begin poz:=i; min:=d[i]; end;
if poz <> 0 then
 begin
 s[poz]:=1;
p:=a[poz];
while p<>nil do
 begin
if s[p^.nod]=0 then if d[p^.nod]>d[poz]+p^.i then  d[p^.nod]:=d[poz]+p^.i;
 p:=p^.urm;
 end;
 end;
inc(head);
end; {end dij}
ok:=true;
i:=1;
while (i<=n)and ok do
     begin
     if d[i]<>d1[i] then ok:=false;
     inc(i);
     end;
if ok then writeln(g,'DA')
      else writeln(g,'NU');
end;
close(g); close(f);
end.