Cod sursa(job #407339)

Utilizator hungntnktpHungntnktp hungntnktp Data 2 martie 2010 11:27:59
Problema Lowest Common Ancestor Scor 70
Compilator fpc Status done
Runda Arhiva educationala Marime 2.3 kb
{DINH QUANG DAT TIN 07-10}
{LCA}
{$M 60000000,0}
{$inline on}
CONST
 TFI='lca.in';
 TFO='lca.out';
 MAX=100001;
TYPE
 arr1int=array[0..MAX] of longint;
 pnode = ^node;
 node = record
         v:longint;
         next:pnode;
        end;
VAR
 fi,fo:text;
 root,q,n:longint;
 ke:array[0..MAX] of pnode;
 d,trace,w,head:arr1int;
 free:array[0..MAX] of boolean;

PROCEDURE       add(u,v:longint);
var
 t:pnode;
begin
 new(t);
 t^.v:=v;
 t^.next:=ke[u];
 ke[u]:=t;
end;

PROCEDURE       input;
var
 i,v:longint;
begin
 read(fi,n,q);
 for i:= 2 to n do
  begin
   read(fi,v);
   add(v,i);
  end;
end;

PROCEDURE       dfs1(u:longint);
var
 t:pnode;
 v:longint;
begin
 t:=ke[u];
 w[u]:=1;
 while t<>nil do
  begin
   v:=t^.v;
   t:=t^.next;
   if trace[v]=0 then
    begin
     trace[v]:=u;
     d[v]:=d[u]+1;
     dfs1(v);
     w[u]:=w[u]+w[v];
    end;
  end;
end;

PROCEDURE       dfs2(u:longint);
var
 t:pnode;
 vv,v:longint;
begin
 head[u]:=root;
 vv:=0;
 if w[u]=1 then exit;
 t:=ke[u];
 while t<>nil do
  begin
   v:=t^.v;
   t:=t^.next;
   if (trace[v]=u) and (w[v]>w[vv]) then vv:=v;
  end;
 dfs2(vv);
 t:=ke[u];
 while t<>nil do
  begin
   v:=t^.v;
   t:=t^.next;
   if (trace[v]=u) and ( v<>vv) then
    begin
     root:=v;
     dfs2(v);
    end;
  end;
end;

PROCEDURE       init;
begin
 fillchar(trace,sizeof(trace),0);
 fillchar(free,sizeof(free),true);
 trace[1]:=-1;
 dfs1(1);
 root:=1;
 dfs2(1);
end;

FUNCTION        find(u,v:longint):longint;
var
 x,u1,v1,i,ii:longint;
begin
 i:=u;
 repeat
  i:=head[i];
  free[i]:=false;
  if i=1 then break;
  i:=trace[i];
 until false;
 i:=v;
 repeat
  x:=i;
  i:=head[i];
  if not free[i] then
   begin
    ii:=i;
    v1:=x;
    break;
   end;
  if i=1 then break;
  i:=trace[i];
 until false;

 i:=u;
 repeat
  x:=i;
  i:=head[i];
  if i=ii then u1:=x;
  free[i]:=true;
  if i=1 then break;
  i:=trace[i];
 until false;
 if d[u1]<d[v1] then find:=u1 else find:=v1;
end;

PROCEDURE       process;
var
 i,u,v,res:longint;
begin
 for i:= 1 to q do
  begin
   read(fi,u,v);
   res:=find(u,v);
   writeln(fo,res);
  end;
end;

BEGIN
 assign(fi,tfi);reset(fi);
 assign(fo,tfo);rewrite(fo);
  input;
  init;
  process;
 close(fo);
 close(fi);
END.