Cod sursa(job #699488)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 29 februarie 2012 19:38:57
Problema Distante Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.88 kb
type muchie=^nod;
     nod=record c, n:longint; a:muchie; end;

var v:array [1..50000] of muchie;
    r:array [1..50000] of longint;
    ver:array[1..50000] of longint;
    q:array [0..1, 0..50000] of longint;
    viz:array [1..50000] of boolean;
    p:muchie;
    ok:boolean;
    i, j, n, m, sw1, sw2, x, y, z, t, s, ii:longint;
    f, g:text;
    buf1, buf2:array [1.. 1 shl 17] of char;

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

read (f, t);
for ii := 1 to t do
  begin
  read (f, n, m, s);
  for i := 1 to n do
    begin
    v[i]:=nil;
    r[i]:=maxlongint;
    end;
  r[s]:=0;

  for i := 1 to n do read (f, ver[i]);

  for i := 1 to m do
    begin
    read (f, x, y, z);
    new (p); p^.n:=y; p^.c:=z; p^.a:=v[x]; v[x]:=p;
    new (p); p^.n:=x; p^.c:=z; p^.a:=v[y]; v[y]:=p;
    end;

  sw1:=0; sw2:=1; q[0, 1]:=s; q[0, 0]:=1;

  while q[sw1, 0]>0 do
    begin
    q[sw2, 0]:=0;
    for i := 1 to n do viz[i]:=false;

    for i := 1 to q[sw1, 0] do
      begin
      x:=q[sw1, i];
      p:=v[x];
      while p <> nil do
        begin
        if r[x]+p^.c=ver[p^.n] then
          begin
          r[p^.n]:=r[x]+p^.c;
          if viz[p^.n] = false then
            begin
            viz[p^.n]:=true;
            inc (q[sw2, 0]);
            q[sw2, q[sw2, 0]]:=p^.n;
            end;
          end;
        p:=p^.a;
        end;
      end;
    sw1:=sw1 xor 1;
    sw2:=sw2 xor 1;
    end;

  ok:=true; i:=1;
  while i <= n do
    begin
    if (r[i]=maxlongint) or (i=s) then
      begin
      if ver[i]<> 0 then ok:=false;
      end
                                  else
      begin
      if ver[i]<>r[i] then ok :=false;
      end;
    inc (i);
    end;
  if ok then writeln (g, 'DA') else writeln (g, 'NU');
  end;

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