Cod sursa(job #1414570)

Utilizator ButnaruButnaru George Butnaru Data 2 aprilie 2015 19:26:32
Problema Lowest Common Ancestor Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.51 kb
program lca;
type
lista=^date;
date=record
m:longint;
next:lista;
end;
struct=record pos,val:longint; end;
     tabel=array[0..100001] of longint;
     tab=array[0..17,0..100001] of struct;
     tab1=array[0..100001] of lista;
     buf=array[0..1 shl 17] of char;
var t,pos,eulerr,v:tabel; ff1,ff2:buf; rmq:tab;
    n,m,i,j,x,y,nr,aux:longint;
    tt:tab1; a:lista;
    f1,f2:text;
procedure euler(nod,lv:longint);
var a:lista;
begin
a:=tt[nod]; nr:=nr+1; pos[nod]:=nr;
rmq[0,nr].val:=lv; eulerr[nr]:=nod; rmq[0,nr].pos:=nr;
while a<>nil do begin
euler(a^.m,lv+1);
nr:=nr+1; rmq[0,nr].val:=lv; rmq[0,nr].pos:=nr; eulerr[nr]:=nod;
a:=a^.next;
end; end;
function min(a,b:struct):struct;
begin
if a.val>b.val then min:=b else min:=a;
end;
function query(x,y:longint):longint;
var dif,aux:longint;
begin
if x>y then begin dif:=x; x:=y; y:=dif; end;
dif:=v[y-x+1]; aux:=1 shl dif;
query:=eulerr[min(rmq[dif,x],rmq[dif,y-aux+1]).pos];
end;
begin
assign (f1,'lca.in');
assign (f2,'lca.out');
reset (f1);
rewrite (f2);
settextbuf(f1,ff1);
settextbuf(f2,ff2);
readln (f1,n,m);
for i:=2 to n do begin
read (f1,x); new(a); a^.m:=i; a^.next:=tt[x]; tt[x]:=a;
end;
nr:=0; euler(1,0); i:=1;
while 1 shl i<=nr do begin
aux:=1 shl (i-1); j:=1;
while j+aux<=nr do begin
rmq[i,j]:=min(rmq[i-1,j],rmq[i-1,j+aux]);
j:=j+1;
end;
i:=i+1;
end;
for i:=2 to n do v[i]:=v[i div 2]+1;
for i:=1 to m do begin
readln (f1,x,y);
x:=pos[x]; y:=pos[y];
writeln (f2,query(x,y));
end;
close (f1);
close (f2);
end.