Cod sursa(job #7132)

Utilizator andrei_blanaruAndrei Blanaru andrei_blanaru Data 21 ianuarie 2007 12:41:39
Problema Radiatie Scor 0
Compilator fpc Status done
Runda preONI 2007, Runda 1, Clasele 11-12 Marime 3 kb
type ref=^elem;
     elem=record
            dest:integer;
            cost:longint;
            urm:ref;
          end;
     lista=^buc;
     buc=record
           a,b:integer;
           urm:lista;
         end;
var g:array [1..15000] of ref;
    cs:array [1..15000,1..15000] of ^longint;
    cm:array [1..15000] of longint;
    poz,h:array [1..15000] of integer;
    n,m,k,l:integer;
    qw:lista;

procedure pune(a,b,c:longint);
var p:ref;
begin
  new(p);
  p^.dest:=b;
  p^.cost:=c;
  p^.urm:=g[a];
  g[a]:=p;
end;


procedure citire;
var i,a,b:integer;
    c:longint;
    p,q:lista;
begin
  assign(input,'radiatie.in');
  reset(input);
  readln(n,m,k);
  for i:=1 to m do
    begin
      readln(a,b,c);
      pune(a,b,c);
      pune(b,a,c);
    end;
  new(qw);
  p:=qw;
  for i:=1 to k do
    begin
      readln(a,b);
      new(q);
      q^.a:=a;  q^.b:=b;  q^.urm:=nil;
      p^.urm:=q;  p:=q;
      new(cs[a,b]);
      cs[a,b]^:=maxlongint;
    end;
  qw:=qw^.urm;
end;

procedure schimb(i,j:integer);
var c:integer;
begin
  c:=h[i];  h[i]:=h[j];  h[j]:=c;
  poz[h[i]]:=i;  poz[h[j]]:=j;
end;

function max(a,b:longint):longint;
begin
  if a>b
    then  max:=a
    else  max:=b;
end;

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

procedure duinsus(k:integer);
begin
  if (k>1)and(cm[h[k div 2]]>cm[h[k]])
    then  begin
            schimb(k div 2,k);
            duinsus(k div 2);
          end;
end;

procedure duinjos(k:integer);
var p:integer;
begin
  p:=k;
  if (2*k<=l)and(cm[h[2*k]]<cm[h[p]])
    then  p:=2*k;
  if (2*k+1<=l)and(cm[h[2*k+1]]<cm[h[p]])
    then  p:=2*k+1;
  if p<>k
    then  begin
            schimb(p,k);
            duinjos(p);
          end;
end;

procedure drum(s:integer);
var i:integer;
    p:ref;
begin
  for i:=1 to n do
    cm[i]:=maxlongint;
  cm[s]:=0;
  for i:=1 to n do
    begin
      poz[i]:=i;
      h[i]:=i;
    end;
  schimb(1,s);
  l:=n;
  while (l>0)and(cm[h[1]]<>maxlongint) do
    begin
      p:=g[h[1]];
      while p<>nil do
        begin
          if cm[p^.dest]=maxlongint
            then  begin
                    cm[p^.dest]:=max(cm[h[1]],p^.cost);
                    duinsus(poz[p^.dest]);
                  end
            else  begin
                    cm[p^.dest]:=min(cm[p^.dest],max(cm[h[1]],p^.cost));
                    duinjos(poz[p^.dest]);
                  end;
          p:=p^.urm;
        end;
      schimb(1,l);
      dec(l);
      duinjos(1);
    end;
  for i:=1 to n do
    begin
      if cs[s,i]<>nil
        then  cs[s,i]^:=cm[i];
      if cs[i,s]<>nil
        then  cs[i,s]^:=cm[i];
    end;
end;

procedure prel;
begin
  while qw<>nil do
    begin
      if cs[qw^.a,qw^.b]^=maxlongint
        then  drum(qw^.a);
      writeln(cs[qw^.a,qw^.b]^);
      qw:=qw^.urm;
    end;
end;


begin
  citire;
  assign(output,'radiate.out');
  rewrite(output);
  prel;
  close(output);
end.