Cod sursa(job #416325)

Utilizator zseeZabolai Zsolt zsee Data 12 martie 2010 16:13:20
Problema Lowest Common Ancestor Scor 90
Compilator fpc Status done
Runda Arhiva educationala Marime 1.14 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..32000] of byte;

procedure olvas;
var i:longint;
begin
 readln(be,n,m);
 for i:=2 to n do read(be,apa[i]);
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;

procedure megold;
var x,y,i:longint;
begin
 for i:=1 to m do
   begin
    read(be,x,y);
    writeln(ki,lca(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.