Cod sursa(job #22184)

Utilizator hitmannCiocas Radu hitmann Data 25 februarie 2007 22:04:31
Problema Distante Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.73 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..50000]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;
while (head<=tail)do
begin
min:=pinfinit;
poz:=0;
p:=a[c[head]];
 while p<>nil do
 begin
  if s[p^.nod]=0 then
      if p^.i<min then begin poz:=p^.nod; min:=p^.i; end;
 p:=p^.urm;
 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;
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.