Cod sursa(job #416332)

Utilizator zseeZabolai Zsolt zsee Data 12 martie 2010 16:27:57
Problema Lowest Common Ancestor Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.46 kb
program lca;
var be,ki:text;
     n,m:longint;
     apa:array[1..100000] of longint;
     lvl:array[1..100000] of integer;
     rbuf,wbuf:array[1..20480] of byte;
     r:boolean;

procedure olvas;
var i:longint;
begin
 readln(be,n,m);
 r:=true;
 for i:=2 to n do
   begin
    read(be,apa[i]);
    if apa[i] < apa[i-1] then r:=false;
   end;
end;

function level(k:longint):integer;
var l:integer;
begin
 if k=1 then
     begin
      level:=0;
      exit;
     end;
 if lvl[k]<>0 then
      begin
       level:=lvl[k];
       exit;
      end;
  l:=level( apa[k] )+1;
  lvl[k]:=l;
  level:=l;
end;

function lca(a,b:longint):longint;
var la,lb:integer;
begin
 la:=level(a);
 lb:=level(b);
 while la > lb do
    begin
     dec(la);
     a:=apa[a];
    end;
 while lb > la do
    begin
     dec(lb);
     b:=apa[b];
    end;
 while a <> b do
   begin
    a:=apa[a];
    b:=apa[b];
   end;
 lca:=a;
end;

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

procedure megold;
var x,y,i:longint;
begin
 if not r then
     for i:=1 to m do
      begin
       read(be,x,y);
       writeln(ki,lca(x,y));
      end
  else
   for i:=1 to m do
      begin
       read(be,x,y);
       writeln(ki,min(x,y));
      end;
end;

begin
 assign(be,'lca.in');
 settextbuf(be,rbuf);
 reset(be);
 assign(ki,'lca.out');
 settextbuf(ki,wbuf);
 rewrite(ki);
 olvas;
 megold;
 close(ki);
end.