Cod sursa(job #182752)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 21 aprilie 2008 12:07:39
Problema Distante Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.6 kb
program catun;
const inf = 50000001;
type pnod = ^nod;
      nod = record
            info,cost : word;
            urm : pnod;
            end;
var T,l : shortint;
    urm : pnod;
    a,b,c,k,n,j,lvl : word;
    i,m : longint;
    f,g : text;
    p,H : array [1..50000] of pnod;
    D,D2 : array [1..50000] of longint;
    ok : boolean;
Procedure shift(n,x:word);
var son : word;
      c : pnod;
begin
repeat
son := 0;
if 2*x<=n then begin
               son := 2*x;
               if 2*x+1<=n then if H[2*x+1]^.cost<H[2*x]^.cost then son := 2*x+1;
               if H[son]^.cost>=H[x]^.cost then son := 0;
               end;
if son<>0 then begin
               c := H[son];
               H[son] := H[x];
               H[x] := c;
               x := son;
               end;
until son=0;
end;

procedure percolate(x:word);
var c : pnod;
begin
if x>1 then
if H[x div 2]^.cost<H[x]^.cost then begin
                                    c := H[x];
                                    H[x] := H[x div 2];
                                    H[x div 2] := c;
                                    percolate(x div 2);
                                    end;
end;


procedure delete;
begin
H[1] := H[lvl];
dec(lvl);
shift(lvl,1);
end;

procedure add(x:pnod);
begin
inc(lvl);
H[lvl] := x;
percolate(lvl);
end;

procedure dijkstra;
var k : word;
begin
k := H[1]^.info;
delete;

urm := p[k];

while urm<>nil do begin
if D[urm^.info] > D[k]+urm^.cost then begin
                                      D[urm^.info] := D[k]+urm^.cost;
                                      add(urm);
                                      end;
urm := urm^.urm;
end;

end;


begin
assign(f,'distante.in');
reset(f);
assign(g,'distante.out');
rewrite(g);

readln(f,T);

for l := 1 to T do begin
readln(f,n,m,k);

for j := 1 to n do begin
D[j] := inf;
read(f,D2[j]);
end;
readln(f);

for i := 1 to m do begin
readln(f,a,b,c);
new(urm);
urm^.info := b;
urm^.cost := c;
urm^.urm := p[a];
p[a] := urm;

new(urm);
urm^.info := a;
urm^.cost := c;
urm^.urm := p[b];
p[b] := urm;
end;

urm := p[k];
lvl := 0;
while urm<>nil do begin
inc(lvl);
H[lvl] := urm;
D[urm^.info] := urm^.cost;
urm := urm^.urm;
end;

for i := lvl div 2 downto 1 do
shift(lvl,i);

dijkstra;

ok := true;
D[k] := 0;
for i := 1 to n do begin
if D[i]=inf then D[i] := 0;
if D[i]<>D2[i] then begin
                    ok := false;
                    break;
                    end;
end;

if ok then writeln(g,'DA')
      else writeln(g,'NU');

end;
close(f);
close(g);
end.