Cod sursa(job #7214)

Utilizator andrei_infoMirestean Andrei andrei_info Data 21 ianuarie 2007 13:07:00
Problema Radiatie Scor 30
Compilator fpc Status done
Runda preONI 2007, Runda 1, Clasele 11-12 Marime 3.01 kb
//preoni runda 1 2007

type pnod = ^tnod;
     tnod = record
                x :integer;
                c:longint;
                next : pnod;
                end;
     rr = record
        head,last:pnod;
        end;
    d = record
                x,y,poz:integer;
                c:longint;
                end;
var n,m,k:integer;
    nod : array[1..15000] of rr;
    lmin : array[1..15000] of longint;
    kk : array[1..15000] of d;
    coada:rr;

procedure addlist(var r: rr; x:integer; c:longint);
var p:pnod;
begin
new(p); p^.x:=x; p^.c:=c; p^.next:=nil;
if r.head = nil then r.head:=p
else r.last^.next:=p;
r.last:=p;
end;

procedure bfs(x:integer);
var p:pnod;
    nnod:integer;
    min : longint;
begin
addlist(coada,x,0);
lmin[x]:=0;
while coada.head <> nil do
        begin
        nnod:=coada.head^.x;
        p:=coada.head; coada.head:=coada.head^.next;
        dispose(p);
        p:=nod[nnod].head;
        while p <> nil do
                begin
                min:=lmin[nnod];
                if p^.c > min then min:=p^.c;
                if min < lmin[p^.x] then
                        begin
                        lmin[p^.x]:=min;
                        addlist(coada,p^.x,min);
                        end;
                p:=p^.next;
                end;
        end;
end;

procedure Sort1(l, r: Integer);
var
  i, j, x: integer;
  y : d;
begin
  i := l; j := r; x := kk[(l+r) DIV 2].x;
  repeat
    while kk[i].x < x do i := i + 1;
    while x < kk[j].x do j := j - 1;
    if i <= j then
    begin
      y := kk[i]; kk[i] := kk[j]; kk[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort1(l, j);
  if i < r then Sort1(i, r);

end;

procedure Sort2(l, r: Integer);
var
  i, j, x: integer;
  y : d;
begin
  i := l; j := r; x := kk[(l+r) DIV 2].poz;
  repeat
    while kk[i].poz < x do i := i + 1;
    while x < kk[j].poz do j := j - 1;
    if i <= j then
    begin
      y := kk[i]; kk[i] := kk[j]; kk[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort2(l, j);
  if i < r then Sort2(i, r);
end;


procedure citire;
var i,x,y,j:integer;
    c:longint;
begin
assign(input,'radiatie.in'); reset(input);
assign(output,'radiatie.out'); rewrite(output);
readln(n,m,k);
for i:=1 to m do
        begin
        readln(x,y,c);
        addlist(nod[x],y,c);
        addlist(nod[y],x,c);
        end;
for i:=1 to k do
        begin
        readln(x,y);
        kk[i].x:=x; kk[i].y:=y; kk[i].poz:=i;
        end;
sort1(1,k);
i:=1;
while  i<=k do
        begin
        for j:=1 to n do
                lmin[j]:=2000000;
        bfs(kk[i].x);
        j:=i;
        while kk[j].x = kk[i].x do
                        begin
                        kk[j].c:=lmin[kk[j].y];
                        inc(j);
                        end;
        i:=j;
        end;
sort2(1,k);
for i:=1 to k do
        writeln(kk[i].c);

close(input); close(output);
end;

begin
citire;
end.