PWALK - Dạo chơi đồng cỏ

Tác giả: ladpro98

Ngôn ngữ: Pascal

program lubenica;
uses    math;
type    e=record
        v,w,link:longint;
        end;
const   maxn=10000;
        fi='';
var     adj:array[0..maxn] of e;
        head,q,d,cha,w:array[0..maxn] of longint;
        b,sum:array[0..maxn,0..200] of longint;
        check:array[0..maxn] of boolean;
        inp:text;
        n,m,log,k,tt,res,u,v:longint;

procedure input;
var     //inp:text;
        i,x,y,w:longint;

begin
        assign(inp,fi);
        reset(inp);
        readln(inp,n,k);
        for i:=1 to n-1 do
        begin
                readln(inp,x,y,w);
                inc(m);
                adj[m].v:=y;
                adj[m].w:=w;
                adj[m].link:=head[x];
                head[x]:=m;
                inc(m);
                adj[m].v:=x;
                adj[m].w:=w;
                adj[m].link:=head[y];
                head[y]:=m;
        end;
end;

procedure init;
var     l,r,i,u,j:longint;
        v:e;
begin
        l:=1;r:=1;
        q[1]:=1;
        d[1]:=0;
        check[1]:=true;
        while l<=r do
        begin
                u:=q[l];inc(l);
                i:=head[u];
                while i>0 do
                begin
                        v:=adj[i];
                        if (not check[v.v]) then
                        begin
                                check[v.v]:=true;
                                inc(r);
                                q[r]:=v.v;
                                d[v.v]:=d[u]+1;
                                cha[v.v]:=u;
                                w[v.v]:=v.w;
                        end;
                        i:=v.link;
                end;
        end;
        log:=trunc(ln(n)/ln(2))+1;
        for i:=0 to n do
        begin
                b[i,0]:=cha[i];
                sum[i,0]:=w[i];
                for j:=1 to log do
                b[i,j]:=-1;
        end;
        for j:=1 to log do
        for i:=0 to n do
        begin
                b[i,j]:=b[b[i,j-1],j-1];
                sum[i,j]:=sum[i,j-1]+sum[b[i,j-1],j-1];
        end;
end;

function getbit(i,j:longint):longint;
begin
        exit(i shr (j-1) and 1);
end;

procedure lca(u,v:longint);
var     t,i:longint;
begin
        res:=0;
        if d[u]>=d[v] then
        begin
                if d[u]>d[v] then
                begin
                        t:=d[u]-d[v];
                        for i:=log downto 1 do
                        if getbit(t,i)=1 then
                        begin
                                inc(res,sum[u,i-1]);
                                u:=b[u,i-1];
                        end;
                end;
                if u=v then exit;
                for i:=log downto 0 do
                if b[u,i]<>b[v,i] then
                begin
                        inc(res,sum[u,i]+sum[v,i]);
                        u:=b[u,i];
                        v:=b[v,i];
                end;
                if b[u,0]=b[v,0] then inc(res,sum[u,0]+sum[v,0]);
        end
        else lca(v,u);
end;

begin
        input;
        init;
        for tt:=1 to k do
        begin
                readln(inp,u,v);
                lca(u,v);
                writeln(res);
        end;
end.

Download