Cod sursa(job #8315)

Utilizator girl_styleBianca Boeriu girl_style Data 24 ianuarie 2007 13:51:24
Problema Radiatie Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.49 kb
type lista=^elem;
      elem=record
        u:integer;
        c:longint;
        urm:lista;
      end;

     lis=^eie;
      eie=record
        a,b:integer;
        c:longint;
        next:lis;
      end;

    siir=array[1..15000] of 0..1;
    syr=^siir;

    aray=array[1..15000] of integer;
    bya=^aray;

var n,m,k,i:integer;
    x:array[0..15001] of lista;
    max:longint;
    viz:syr;
    l:lis;
    sir:bya;
    ies:boolean;

procedure pune(a,b:integer;c:longint);
var d,e,f:lista;
begin
  new(f);
  f^.u:=b;
  f^.c:=c;
  if x[a]=nil then
    begin
      x[a]:=f;
      f^.urm:=nil;
    end
              else
    begin
      d:=x[a];
      e:=nil;
      while (d<>nil) and (d^.c<c) do
        begin
          e:=d;
          d:=d^.urm;
        end;
      if e=nil then
       begin
        f^.urm:=x[a];
        x[a]:=f;
       end
               else
       begin
        f^.urm:=e^.urm;
        e^.urm:=f;
       end;
    end;
end;

procedure drum(a,b:integer);
var d:lista;
begin
  if a<>b then
  begin
  d:=x[a];
  while d<>nil do
   begin
    if viz^[d^.u]=0 then
     begin
       viz^[d^.u]:=1;
       if (d^.c>max) then
         max:=d^.c;
       drum(d^.u,b);
       viz^[d^.u]:=0;
       if ies then
         exit;
     end;
    d:=d^.urm;
   end;
  end
          else
  ies:=true;
end;

function min(a,b:integer):integer;
begin
  if a<b then
    min:=a
         else
    min:=b;
end;

function maxi(a,b:integer):integer;
begin
  if a>b then
    maxi:=a
         else
    maxi:=b;
end;

procedure krusc;
var nr,i,x,y:integer;
    p,d,e:lis;
begin
  nr:=0;
  p:=l;
  new(sir);
  for i:=1 to n do
    sir^[i]:=i;
  while nr<n-1 do
    begin
      if (sir^[p^.a]<>sir^[p^.b]) then
       begin
        x:=min(sir^[p^.a],sir^[p^.b]);
        y:=maxi(sir^[p^.a],sir^[p^.b]);
        for i:=1 to n do
          if sir^[i]=y then
            sir^[i]:=x;
        d:=p;
        p:=p^.next;
        inc(nr);
       end
                              else
         begin
          e:=d^.next;
          d^.next:=d^.next^.next;
          dispose(e);
         end;
    end;
  d^.next:=nil;
  while p<>nil do
    begin
      e:=p;
      p:=p^.next;
      dispose(e);
    end;
end;

procedure pune_(var l:lis; a,b:integer;c:longint);
var d,e,f:lis;
begin
  new(f);
  f^.a:=a;
  f^.b:=b;
  f^.c:=c;
  if l=nil then
    begin
      l:=f;
      f^.next:=nil;
    end
              else
    begin
      d:=l;
      e:=nil;
      while (d<>nil) and (d^.c<c) do
        begin
          e:=d;
          d:=d^.next;
        end;
      if e=nil then
       begin
        f^.next:=l;
        l:=f;
       end
               else
       begin
        f^.next:=e^.next;
        e^.next:=f;
       end;
    end;
end;

procedure citire;
var i,a,b:integer;
    p:lis;
    c:longint;
begin
  assign(input,'radiatie.in');
  reset(input);
  readln(n,m,k);
  for i:=1 to m do
    begin
      readln(a,b,c);
      pune_(l,a,b,c);
    end;
  krusc;
  while l<>nil do
    begin
      pune(l^.a,l^.b,l^.c);
      pune(l^.b,l^.a,l^.c);
      p:=l;
      dispose(p);
      l:=l^.next;
    end;
  for i:=1 to k do
    begin
      readln(a,b);
      max:=0;
      ies:=false;
      drum(a,b);
      writeln(max);
    end;
  close(input);
end;

begin
  assign(output,'radiatie.out');
  rewrite(output);
  new(viz);
  for i:=1 to n do
    viz^[i]:=0;
  citire;
  close(output);
end.