POJ1986 Distance Queries LCA pascal 解题报告

题目大意：给你一张N（1 ≤ N ≤ 40,000）个节点，M（1 ≤ M < 40,000）条无向边的农场地图（请无视后面的英文字母），农场是无环但不一定连通的（据说是这样的，但是不会问你无解的问题）。现在下面有K（1 ≤ K ≤ 10,000）个询问，对于每个询问，你需要输出这两个节点之间的路径长度

赤裸裸的lca，就是需要记录一下每个点到根节点的距离，设x为u v的最近公共祖先， 则dis[u,v]=dis[u,root]+dis[v,root]-s*dis[x,root]

然后就没有然后了，代码：

type
  rec=record
    x,y,w,next:longint;
    al:boolean;
  end;
  rec2=record
    x,y,next,ans:longint;
  end;
var
  i,j,k,n,m,want,root,tot,ttot,x,y,w:longint;
  g:array[0..100000] of rec;
  dis,link,first,fa:array[0..40005] of longint;
  b,v:array[0..40005] of boolean;
  que:array[0..30005] of rec2;
  procedure ins(x,y,w:longint);         //存储
  begin
    inc(tot);
    g[tot].x := x;
    g[tot].y := y;
    g[tot].w := w;
    g[tot].next:=first[x];
    first[x]:=tot;
    g[tot].al:=true;
  end;
  procedure inser(x,y:longint);          //另外一种存储
  begin
    inc(ttot);
    que[ttot].x:=x;
    que[ttot].y:=y;
    que[ttot].next:=link[x];
    link[x]:=ttot;
  end;
  procedure dfs(x:longint);              //通过深搜把点之间的权值计算好
  var
    i,j,k:longint;
  begin
    b[x]:=true;
    j:=first[x];
    while j<>0 do
    begin
      k:=g[j].y;
      if not b[k] then
      begin
        dis[k]:=dis[x]+g[j].w;
        dfs(k);
      end
      else g[j].al:=false;
      j:=g[j].next;
    end;
  end;
  function find(x:longint):longint;   //并查集
  begin
    if x=fa[x] then exit(fa[x]);
    fa[x]:=find(fa[x]);
    exit(fa[x]);
  end;
  procedure search(x:longint);        //lca
  var
    ff,i,j,k,tmp:longint;
  begin
    fa[x]:=x;
    j:=first[x];
    while j<>0 do
    begin
      if g[j].al then
      begin
        k:=g[j].y;
        search(k);
        fa[k]:=x;
      end;
      j:=g[j].next;
    end;
    b[x]:=true;
    j:=link[x];
    while j<>0 do
    begin
      k:=que[j].y;
      if b[k] then
      begin
        ff:=find(k);
        tmp:=dis[x]+dis[k]-2*dis[ff];
        que[j].ans:=tmp;
      end;
      j:=que[j].next;
    end;
  end;
begin
  readln(n,m);
  tot:= 0;
  ttot:= 0;
  fillchar(link,sizeof(link),0);
  fillchar(first,sizeof(first),0);
  for i:=1 to n do fa[i]:=i;
  fillchar(v,sizeof(v),false);
  for i:=1 to m do
  begin
    readln(x,y,w);
    ins(x,y,w);
    ins(y,x,w);
  end;
  fillchar(b,sizeof(b),false);
  fillchar(dis,sizeof(dis),0);
  for i:=1 to n do
    if not b[i] then
    begin
      v[i]:=true;
      dfs(i);
    end;
  readln(want);        //读入询问
  for i:=1 to want do
  begin
    readln(x,y);
    inser(x,y);
    inser(y,x);
  end;
  fillchar(b,sizeof(b),false);
  for i := 1 to n do if v[i] then search(i);
  for i := 1 to want do
    if que[i*2-1].ans<>0 then writeln(que[i*2-1].ans) else writeln(que[i*2].ans);        //输出
end.