Cod sursa(job #386409)

Utilizator guralivuion ion guralivu Data 24 ianuarie 2010 19:59:32
Problema Distante Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.67 kb
program pascal;
var f,g:text;   a:array[0..50000,0..50000] of integer;
    d,c:array[0..50000] of longint;
    viz:array[0..50000] of byte;
    poz,z,i,j,k,q,s,n,min,t,m,x,y:longint; ok:boolean;

  procedure completare;
  begin
  for i:=1 to n do
   for j:=1 to n do
     if i<>j then a[i,j]:=1000;
  end;

  procedure verificare;
  begin
  ok:=true;
  for z:=1 to n do
    if d[z]<>c[z] then begin ok:=false; break; end;
    if not ok then writeln(g,'NU') else
                   writeln(g,'DA');
  end;

  procedure dijkstra;
  begin
    viz[s]:=1;
    for j:=1 to n do d[j]:=a[s,j];

    for j:=1 to n-1 do
      begin
         min:=1000;
         for z:=1 to n do
         if viz[z]=0 then
          if d[z]<min then
                begin
                min:=d[z];
                poz:=z;
                end;

         viz[poz]:=1;
         for z:=1 to n do
         if (viz[z]=0)  then
           if d[z]>d[poz]+a[poz,z] then d[z]:=d[poz]+a[poz,z];
      end;

    verificare;
  end;

  procedure stergere;
  begin
  for i:=1 to n do
   for j:=1 to n do a[i,j]:=0;

  for i:=1 to n do begin d[i]:=0; viz[i]:=0; end;
  end;

  procedure citire;
  begin
  assign(f,'distante.in'); reset(f);
  assign(g,'distante.out'); rewrite(g);
  readln(f,t);
   for q:=1 to t do
         begin
         readln(f,n,m,s);
         stergere;
         completare;
         for j:=1 to n do read(f,c[j]);
         readln(f);
         for j:=1 to m do
             begin
             readln(f,x,y,k);
             a[x,y]:=k;
             a[y,x]:=k;
             end;
        dijkstra;
        end;
  end;

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