Cod sursa(job #359005)

Utilizator ionutz32Ilie Ionut ionutz32 Data 25 octombrie 2009 14:05:24
Problema Distante Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.76 kb
type ref=^nod; nod=record nod,cost:word; adr:ref; end; const inf=50000005; var v:array[1..50000] of ref; 
br,heap,poz:array[1..50000] of word; d:array[1..50000] of longint; u:ref; t,n,m,i,a,b,c,s,j,x,aux:longint; f,g:text; 
procedure perc(p:word); begin while (p>1) and (d[heap[p]]<d[heap[p shr 1]]) do begin aux:=heap[p]; heap[p]:=heap[p shr 1]; 
heap[p shr 1]:=aux; poz[heap[p]]:=p; poz[heap[p shr 1]]:=p shr 1; end; end; procedure sift(p:word); var min:word; begin while 
(p<=x shr 1) and ((d[heap[p]]>d[heap[p*2]]) or (d[heap[p]]>d[heap[p*2+1]])) do begin if d[heap[p*2]]<d[heap[p*2+1]] then 
min:=p*2 else min:=p*2+1; aux:=heap[p]; heap[p]:=heap[min]; heap[min]:=aux; poz[heap[p]]:=p; poz[heap[min]]:=min; end; end; 
begin assign(f,'distante.in'); assign(g,'distante.out'); reset(f);rewrite(g); readln(f,t); for i:=1 to t do begin 
readln(f,n,m,s); for j:=1 to n do begin v[j]:=nil; poz[j]:=0; read(f,br[j]); end; readln(f); for j:=1 to m do begin 
readln(f,a,b,c); if v[a]=nil then begin new(v[a]); v[a]^.nod:=b; v[a]^.cost:=c; v[a]^.adr:=nil; end else begin new(u); 
u^.nod:=b; u^.cost:=c; u^.adr:=v[a]; v[a]:=u; end; if v[b]=nil then begin new(v[b]); v[b]^.nod:=a; v[b]^.cost:=c; 
v[b]^.adr:=nil; end else begin new(u); u^.nod:=a; u^.cost:=c; u^.adr:=v[b]; v[b]:=u; end; end; x:=1; heap[1]:=s; poz[s]:=1; 
for j:=1 to n do d[j]:=inf; d[s]:=0; while x>0 do begin a:=heap[1]; heap[1]:=heap[x]; poz[heap[1]]:=1; poz[a]:=0; dec(x); 
sift(1); u:=v[a]; while u<>nil do begin if d[u^.nod]>d[a]+u^.cost then begin d[u^.nod]:=d[a]+u^.cost; if poz[u^.nod]=0 then 
begin inc(x); heap[x]:=u^.nod; poz[u^.nod]:=x; perc(x); end else perc(x); end; u:=u^.adr; end; end; for j:=1 to n do if 
d[j]<>br[j] then break; if d[j]<>br[j] then writeln(g,'NU') else writeln(g,'DA'); end; close(f);close(g); end.