Cod sursa(job #7287)

Utilizator girl_styleBianca Boeriu girl_style Data 21 ianuarie 2007 13:18:56
Problema Radiatie Scor 0
Compilator fpc Status done
Runda preONI 2007, Runda 1, Clasele 11-12 Marime 3.34 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;

var n,m,k:integer;
    x:array[0..15001] of lista;
    max:longint;
    viz:array[1..15000] of 0..1;
    l:lis;
    sir:array[1..15000] of integer;
    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:lis;
begin
  nr:=0;
  p:=l;
  d:=nil;
  for i:=1 to n do
    sir[i]:=i;
  while nr<n 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
        if d=nil then
         begin
          l:=p^.next;
          dispose(p);
         end
                 else
         begin
          d^.next:=p^.next;
          dispose(p);
         end;
    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);
  citire;
  close(output);
end.