Cod sursa(job #376198)

Utilizator ionutz32Ilie Ionut ionutz32 Data 20 decembrie 2009 22:10:36
Problema Radiatie Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.96 kb
type muchie=record
     x,y:word;
     c:longint;
     end;
ref=^nod;
nod=record
    nr:word;
    cost:longint;
    adr:ref;
    end;
var a:array[1..15000] of ref;
u,c,sf,u2:ref;
tt,rg:array[1..15000] of word;
s:array[1..15000] of byte;
v:array[1..30000] of muchie;
aux:muchie;
n,m,k,i,j,piv,b,x,y:longint;
f,g:text;
ok:boolean;
function sort2(min,max:word):word;
         begin
         piv:=v[min+(max-min) shr 1].c;
         i:=min-1;
         j:=max+1;
         ok:=true;
         repeat
               repeat
                     inc(i);
               until v[i].c>=piv;
               repeat
                     dec(j);
               until v[j].c<=piv;
               if i<j then
                  begin
                  aux:=v[i];
                  v[i]:=v[j];
                  v[j]:=aux;
                  end
               else
                   begin
                   ok:=false;
                   sort2:=j;
                   end;
         until ok=false;
         end;
procedure sort1(min,max:word);
          var p:word;
          begin
          if min<max then
             begin
             p:=sort2(min,max);
             sort1(min,p);
             sort1(p+1,max);
             end;
          end;
function str(nod:word):word;
         var nod2,aa:word;
         begin
         nod2:=nod;
         while nod<>tt[nod] do
               nod:=tt[nod];
         while nod2<>nod do
               begin
               aa:=tt[nod2];
               tt[nod2]:=nod;
               nod2:=aa;
               end;
         str:=nod;
         end;
begin
assign(f,'radiatie.in');
assign(g,'radiatie.out');
reset(f);rewrite(g);
readln(f,n,m,k);
for i:=1 to n do
    begin
    tt[i]:=i;
    rg[i]:=1;
    end;
for i:=1 to m do
    readln(f,v[i].x,v[i].y,v[i].c);
sort1(1,m);
i:=0;
repeat
      repeat
            inc(i);
      until str(v[i].x)<>str(v[i].y);
      if rg[v[i].x]>rg[v[i].y] then
         begin
         tt[v[i].y]:=v[i].x;
         inc(rg[v[i].x],rg[v[i].y]);
         end
      else
          begin
          tt[v[i].x]:=v[i].y;
          inc(rg[v[i].y],rg[v[i].x]);
          end;
      if a[v[i].x]=nil then
         begin
         new(a[v[i].x]);
         a[v[i].x]^.nr:=v[i].y;
         a[v[i].x]^.cost:=v[i].c;
         a[v[i].x]^.adr:=nil;
         end
      else
          begin
          new(u);
          u^.nr:=v[i].y;
          u^.cost:=v[i].c;
          u^.adr:=a[v[i].x];
          a[v[i].x]:=u;
          end;
      if a[v[i].y]=nil then
         begin
         new(a[v[i].y]);
         a[v[i].y]^.nr:=v[i].x;
         a[v[i].y]^.cost:=v[i].c;
         a[v[i].y]^.adr:=nil;
         end
      else
          begin
          new(u);
          u^.nr:=v[i].x;
          u^.cost:=v[i].c;
          u^.adr:=a[v[i].y];
          a[v[i].y]:=u;
          end;
      inc(b);
until b=n-1;
for i:=1 to k do
    begin
    readln(f,x,y);
    new(c);
    c^.nr:=x;
    c^.cost:=0;
    c^.adr:=nil;
    sf:=c;
    fillchar(s,sizeof(s),0);
    s[x]:=1;
    ok:=true;
    repeat
          u:=a[c^.nr];
          while u<>nil do
                begin
                if s[u^.nr]=0 then
                   begin
                   s[u^.nr]:=1;
                   new(u2);
                   u2^.nr:=u^.nr;
                   if u^.cost>c^.cost then
                      u2^.cost:=u^.cost
                   else
                       u2^.cost:=c^.cost;
                   u2^.adr:=nil;
                   sf^.adr:=u2;
                   sf:=u2;
                   if u2^.nr=y then
                      begin
                      ok:=false;
                      break;
                      end;
                   end;
                u:=u^.adr;
                end;
          if ok=false then
             break;
          u:=c;
          c:=c^.adr;
          dispose(u);
    until ok=false;
    writeln(g,sf^.cost);
    end;
close(f);close(g);
end.