ac1242.pas

这是在网络上搜集到的在东京大学的ACM上面解决的一些题目的源码

{$Q-,R-}
program tju1242;
const
  maxn=30000;
  maxe=100000;
  maxq=100000;
var
  edge:array[1..maxe]of record v1,v2:word;pre1,pre2:longint;del:byte;end;
  query:array[1..maxq+maxe-maxn+1]of record oper:shortint;v1,v2,lca:word;pre1,pre2:longint;end;
  el,ql:array[1..maxn]of longint;
  deg,father,root:array[1..maxn]of word;
  dfn:array[1..maxn]of record st,ed:word;end;
  level:array[1..maxn]of record value,delta:word;end;
  n,e,q,i,x,p,treeroot:longint;
procedure pathcomp(x:word);
  var
    r,t:word;
  begin
    r:=x;while root[r]<>r do r:=root[r];
    while x<>r do begin t:=root[x];root[x]:=r;x:=t;end;
  end;
procedure dfs(x:word);
  var
    p,y:longint;
  begin
    inc(n);dfn[x].st:=n;
    level[n].value:=level[dfn[father[x]].st].value+1;level[n].delta:=0;
    p:=el[x];
    while p>0 do begin
      if edge[p].del=0 then begin
        y:=edge[p].v1+edge[p].v2-x;
        if father[y]=0 then begin
          father[y]:=x;
          edge[p].del:=1;
          dfs(y);
        end
        else begin
          inc(q);
          with query[q] do begin
            oper:=0;
            v1:=x;v2:=y;
            pre1:=ql[x];ql[x]:=q;
            pre2:=ql[y];ql[y]:=q;
          end;
          edge[p].del:=2;
        end;
      end;
      if x=edge[p].v1 then p:=edge[p].pre1 else p:=edge[p].pre2;
    end;
    dfn[x].ed:=n;
  end;
procedure tarjan(x:word);
  var
    p,y:longint;
  begin
    root[x]:=x;
    p:=ql[x];
    while p>0 do begin
      y:=query[p].v1+query[p].v2-x;
      if root[y]>0 then begin pathcomp(y);query[p].lca:=root[y];end;
      if x=query[p].v1 then p:=query[p].pre1 else p:=query[p].pre2;
    end;
    p:=el[x];
    while p>0 do begin
      if edge[p].del=1 then begin
        y:=edge[p].v1+edge[p].v2-x;
        edge[p].del:=2;
        tarjan(y);
      end;
      if x=edge[p].v1 then p:=edge[p].pre1 else p:=edge[p].pre2;
    end;
    root[x]:=root[father[x]];
  end;
procedure exalt(p,d,l,r:word);
  begin
    if r-l=d*4-2 then
      inc(level[p].delta)
    else begin
      if l<p then if r<p then exalt(p-d,d shr 1,l,r) else exalt(p-d,d shr 1,l,p-1);
      if (p>=l) and (p<=r) then dec(level[p].value);
      if r>p then if l>p then exalt(p+d,d shr 1,l,r) else exalt(p+d,d shr 1,p+1,r);
    end;
  end;
function getlevel(x:word):integer;
  var
    p,d:word;
  begin
    getlevel:=0;
    x:=dfn[x].st;p:=treeroot;d:=p shr 1;
    while p<>x do begin
      if p<=n then dec(getlevel,level[p].delta);
      if p<x then inc(p,d) else dec(p,d);
      d:=d shr 1;
    end;
    inc(getlevel,level[p].value-level[p].delta);
  end;
begin
  repeat
    fillchar(el,sizeof(el),0);
    fillchar(ql,sizeof(ql),0);
    fillchar(deg,sizeof(deg),0);
    read(n,e);
    treeroot:=1;while treeroot*2<=n do treeroot:=treeroot*2;
    for i:=1 to e do
      with edge[i] do begin
        read(v1,v2);
        pre1:=el[v1];el[v1]:=i;
        pre2:=el[v2];el[v2]:=i;
        del:=0;
        inc(deg[v1]);inc(deg[v2]);
      end;

    q:=0;
    repeat
      inc(q);
      with query[q] do begin
        read(oper);if oper<0 then break;
        read(v1,v2);
        pre1:=ql[v1];ql[v1]:=q;
        pre2:=ql[v2];ql[v2]:=q;
        if oper=0 then begin
          if deg[v1]<deg[v2] then x:=v1 else x:=v2;
          p:=el[x];
          while (edge[p].del>0) or (edge[p].v1+edge[p].v2<>v1+v2) do
            if x=edge[p].v1 then p:=edge[p].pre1 else p:=edge[p].pre2;
          edge[p].del:=2;
          dec(deg[v1]);dec(deg[v2]);
        end;
      end;
    until false;
    dec(q);

    fillchar(father,sizeof(father),0);father[1]:=1;
    n:=0;dfs(1);
    fillchar(root,sizeof(root),0);
    tarjan(1);

    for i:=1 to n do root[i]:=i;
    for i:=q downto 1 do
      with query[i] do begin
        pathcomp(v1);v1:=root[v1];
        pathcomp(v2);v2:=root[v2];
        pathcomp(lca);lca:=root[lca];
        case oper of
          0:begin
              while v1<>lca do begin
                exalt(treeroot,treeroot shr 1,dfn[v1].st,dfn[v1].ed);
                root[v1]:=lca;pathcomp(father[v1]);v1:=root[father[v1]];
              end;
              while v2<>lca do begin
                exalt(treeroot,treeroot shr 1,dfn[v2].st,dfn[v2].ed);
                root[v2]:=lca;pathcomp(father[v2]);v2:=root[father[v2]];
              end;
            end;
          1:lca:=getlevel(v1)+getlevel(v2)-getlevel(lca)*2;//the answer
        end;
      end;

    for i:=1 to q do
      with query[i] do
        if oper=1 then writeln(lca);
  until seekeof;
end.