Cod sursa(job #715827)

Utilizator ionutz32Ilie Ionut ionutz32 Data 17 martie 2012 19:58:24
Problema Lowest Common Ancestor Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.8 kb
type ref=^nod;
nod=record
    nr:longint;
    adr:ref;
    end;
var t:array[1..17,0..100005] of longint;
v:array[0..100005] of ref;
niv:array[0..100005] of longint;
n,m,i,j,x,y,aux,p:longint;
f,g:text;
u:ref;
procedure nivel(nod:longint);
          var u:ref;
          begin
          u:=v[nod];
          while u<>nil do
                begin
                niv[u^.nr]:=niv[nod]+1;
                nivel(u^.nr);
                u:=u^.adr;
                end;
          end;
begin
assign(f,'lca.in');
assign(g,'lca.out');
reset(f);rewrite(g);
read(f,n,m);
for i:=2 to n do
    begin
    read(f,t[1,i]);
    new(u);
    u^.nr:=i;
    u^.adr:=v[t[1,i]];
    v[t[1,i]]:=u;
    end;
j:=2;
while 1 shl (j-1)<=n-1 do
      begin
      for i:=1 to n do
          t[j,i]:=t[j-1,t[j-1,i]];
      inc(j);
      end;
niv[1]:=1;
nivel(1);
for i:=1 to m do
    begin
    readln(f,x,y);
    if niv[x]>niv[y] then
       begin
       aux:=x;
       x:=y;
       y:=aux;
       end;
    aux:=1;
    p:=1;
    while aux<=niv[y]-1 do
          begin
          aux:=aux shl 1;
          inc(p);
          end;
    dec(p);
    aux:=aux shr 1;
    while niv[y]>niv[x] do
          begin
          if niv[t[p,y]]>=niv[x] then
             y:=t[p,y];
          dec(p);
          end;
    if x=y then
       begin
       writeln(g,x);
       continue;
       end;
    aux:=1;
    p:=1;
    while aux<=niv[x]-1 do
          begin
          aux:=aux shl 1;
          inc(p);
          end;
    aux:=aux shr 1;
    dec(p);
    while t[1,x]<>t[1,y] do
          begin
          if t[p,x]<>t[p,y] then
             begin
             x:=t[p,x];
             y:=t[p,y];
             end;
          dec(p);
          end;
    writeln(g,t[1,x]);
    end;
close(f);close(g);
end.