Cod sursa(job #386439)

Utilizator guralivuion ion guralivu Data 24 ianuarie 2010 20:19:45
Problema Distante Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.42 kb
program pas;
var a:array[0..10000,0..10000] of integer;
    v,d,s:Array[0..50000] of longint;
    f,g:text;
    ok:boolean;
    t,m,n,r,i,j:longint;

procedure citire;
var i,j,x,y:longint;
    z:integer;
begin
    readln(f,n,m,r);
    For i:=1 to n do
     read(f,v[i]);
    readln(f);
    For i:=1 to n do
     For j:=1 to n do
      a[i,j]:=10001;
    For i:=1 to m do
     begin
      readln(f,x,y,z);
      a[x,y]:=z;
      a[y,x]:=z;
     end;
end;

procedure djk;
var i,j,min,p:longint;
begin
    s[r]:=1;
    d[r]:=10001;
    For i:=1 to n do
     begin
      d[i]:=a[r,i];
     end;
    For i:=1 to n-1 do
    begin
     min:=10001;
     For j:=1 to n do
      If s[j]<>1 then
       If d[j]<min then
        begin
         p:=j;
         min:=d[j];
        end;
     s[p]:=1;
     For j:=1 to n do
      If j<>r then
       If d[j]>d[p]+a[p,j] then
        begin
         d[j]:=d[p]+a[p,j];
        end;
    end;
end;

begin
    assign(f,'distante.in');
    reset(f);
    assign(g,'distante.out');
    rewrite(g);
    readln(f,t);
    For i:=1 to t do
     begin
      citire;
      djk;
      ok:=true;
      For j:=1 to n do
       If j<>r then
        If d[j]<>v[j] then
         begin
          ok:=false;
          break;
         end;
      If ok then
       writeln(g,'DA')
      else
       writeln(g,'NU');
     end;
    close(f);
    close(g);
end.