poj 1330 Nearest Common Ancestors LCA tarjan/RMQ ST

题意：给出一棵树，求两点间的最近公共祖先。

基于并查集的离线求LCA的tarjan算法：

const
  maxn=10000;

var
  e,p,q,n,l,t,root:longint;
  v:array[1..maxn] of boolean;
  f,last:array[1..maxn] of longint;
  side:array[1..maxn] of record
    x,y,next:longint;
  end;

procedure add(x,y:longint);
begin
  inc(e);
  side[e].x:=x; side[e].y:=y; side[e].next:=last[x]; last[x]:=e;
end;

procedure init;
var
  i,x,y:longint;
begin
  readln(n);
  e:=0;
  fillchar(last,sizeof(last),0);
  fillchar(v,sizeof(v),true);
  for i:=1 to n-1 do
  begin
    readln(x,y);
    add(x,y);
    v[y]:=false;
  end;
  readln(p,q);
  for i:=1 to n do
    if v[i] then
    begin
      root:=i;
      break;
    end;
end;

function find(x:longint):longint;
begin
  if f[x]=x then exit(x);
  find:=find(f[x]);
  f[x]:=find;
end;

procedure dfs(x:longint);
var
  i:longint;
begin
  v[x]:=true;
  if (x=p)and(v[q])or(x=q)and(v[p]) then
    if x=p
      then writeln(find(q))
      else writeln(find(p));
  i:=last[x];
  while i>0 do
    with side[i] do
    begin
      dfs(y);
      f[find(y)]:=x;
      i:=next;
    end;
end;

procedure tarjan;
var
  i:longint;
begin
  for i:=1 to n do
    f[i]:=i;
  fillchar(v,sizeof(v),false);
  dfs(root);
end;

begin
  readln(t);
  for l:=1 to t do
  begin
    init;
    tarjan;
  end;
end.

把LCA问题转换成RMQ问题就是把树转换成欧拉序列，也就是从根节点开始dfs，每递归到一个节点就加入队列，那么最后就会形成一个有2n+1个元素的数列。设节点x在数列中出现的第一个位置为pos[x]，因为节点x和y的LCA一定在pos[x]和pos[y]之间，所以x和y的LCA就是区间[pos[x],pos[y]]的最小值。

然后再用基于倍增思想的ST算法求RMQ。

f[i,j]表示从j开始往后2^i个数中的最小值。f[i,j]=min(f[i-1,j],f[i-1,j+1 shl (i-1)])

代码：

const
  maxn=10000;

var
  t,l,e,n,root,dep,p,q,a1:longint;
  f,g:array[0..20,1..maxn*3] of longint;
  mi:array[0..20] of longint;
  pos,last,a,b:array[1..maxn*3] of longint;
  v:array[1..maxn] of boolean;
  side:array[1..maxn] of record
    x,y,next:longint;
  end;

procedure add(x,y:longint);
begin
  inc(e);
  side[e].x:=x; side[e].y:=y; side[e].next:=last[x]; last[x]:=e;
end;

procedure init;
var
  i,x,y:longint;
begin
  readln(n);
  e:=0;
  fillchar(last,sizeof(last),0);
  fillchar(v,sizeof(v),true);
  for i:=1 to n-1 do
  begin
    readln(x,y);
    v[y]:=false;
    add(x,y);
  end;
  readln(p,q);
  for i:=1 to n do
    if v[i] then
    begin
      root:=i;
      break;
    end;
end;

procedure dfs(x:longint);
var
  i:longint;
begin
  inc(a1);
  a[a1]:=dep;
  b[a1]:=x;
  pos[x]:=a1;
  i:=last[x];
  while i>0 do
    with side[i] do
    begin
      inc(dep);
      dfs(y);
      dec(dep);
      inc(a1);
      a[a1]:=dep;
      b[a1]:=x;
      i:=next;
    end;
end;

procedure build;
begin
  a1:=0;
  dep:=1;
  dfs(root);
end;

procedure st;
var
  m,s,i,j:longint;
begin
  m:=trunc(ln(a1)/ln(2));
  mi[0]:=1;
  for i:=1 to m do
    mi[i]:=mi[i-1]*2;
  for i:=1 to a1 do
  begin
    f[0,i]:=a[i];
    g[0,i]:=b[i];
  end;
  for i:=1 to m do
    for j:=1 to a1-mi[i]+1 do
      if f[i-1,j]<f[i-1,j+mi[i-1]]
        then begin
               f[i,j]:=f[i-1,j];
               g[i,j]:=g[i-1,j];
             end
        else begin
               f[i,j]:=f[i-1,j+mi[i-1]];
               g[i,j]:=g[i-1,j+mi[i-1]];
             end;
  if pos[p]>pos[q] then
  begin
    p:=p xor q; q:=p xor q; p:=p xor q;
  end;
  s:=trunc(ln(pos[q]-pos[p]+1)/ln(2));
  if f[s,pos[p]]<f[s,pos[q]-mi[s]+1]
    then writeln(g[s,pos[p]])
    else writeln(g[s,pos[q]-mi[s]+1]);
end;

begin
  readln(t);
  for l:=1 to t do
  begin
    init;
    build;
    st;
  end;
end.