Cod sursa(job #1622964)

Utilizator robertadRoxana Rodile robertad Data 1 martie 2016 16:13:38
Problema Distante Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.42 kb
program distante;
type matrice=array[1..3,1..200000] of longint;
var c:array[1..500000] of longint;
    bufin,bufout:array[1..1 shl 17] of char;
    d,start,v:array[1..50000] of longint;
    n,m,nr,sursa:longint;
    f,g:text;
procedure bellman;
var t:matrice;
    i,st,sf,p,nod,k,j,co,l:longint;
    viz:array [1..50000] of 0..1;
    ok:boolean;
  begin
    l:=1;
    for k:=1 to m do
          begin
            readln(f,i,j,co);
            t[1,l]:=j;
            t[2,l]:=start[i];
            t[3,l]:=co;
            start[i]:=l;
            inc(l);
            t[1,l]:=i;
            t[2,l]:=start[j];
            t[3,l]:=co;
            start[j]:=l;
            inc(l);
          end;
    for i:=1 to n do
      d[i]:=maxlongint;
    d[sursa]:=0;
    st:=0;
    sf:=1;
    c[1]:=sursa;
    ok:=true;
    while (st<sf) do
      begin
       inc(st);
       nod:=c[st];
       viz[nod]:=0;
       p:=start[nod];
       while (p<>0) do
         begin
           if d[nod]+t[3,p]<d[t[1,p]] then
                                      begin
                                        d[t[1,p]]:=d[nod]+t[3,p];
                                        if viz[t[1,p]]=0 then
                                                         begin
                                                           inc(sf);
                                                           c[sf]:=t[1,p];
                                                           viz[t[1,p]]:=1;
                                                         end;
                                      end;
           p:=t[2,p];
         end;
      end;
                for i:=1 to n do
                  if v[i]<>d[i] then
                                begin
                                  ok:=false;
                                  break;
                                end;
    if ok=true then
                writeln(g,'DA')
                else
                writeln(g,'NU');
  end;
procedure citire;
var i,j,k,c,h:longint;
  begin
    assign(f,'distante.in');
    assign(g,'distante.out');
    settextbuf(f,bufin);
    settextbuf(g,bufout);
    reset(f);
    rewrite(g);
    readln(f,nr);
    for h:=1 to nr do
      begin
        readln(f,n,m,sursa);
        for i:=1 to n do
           read(f,v[i]);
      for i:=1 to n do
        start[i]:=0;
      bellman;
     end;
  end;
begin
  citire;
  close(f);
  close(g);
end.