POJ - 1741 Tree

Description
Give a tree with n vertices,each edge has a length(positive integer less than 1001).
Define dist(u,v)=The min distance between node u and v.
Give an integer k,for every pair (u,v) of vertices is called valid if and only if dist(u,v) not exceed k.
Write a program that will count how many pairs which are valid for a given tree.

Input
The input contains several test cases. The first line of each test case contains two integers n, k. (n<=10000) The following n-1 lines each contains three integers u,v,l, which means there is an edge between node u and v of length l.
The last test case is followed by two zeros.

Output
For each test case output the answer on a single line.

Sample Input

5 4
1 2 3
1 3 1
1 4 2
3 5 1
0 0

Sample Output

8

题目大意：求树上距离小于k的点对个数

裸题，树的点分治

 const
     maxn=;
 var
     n,k,cut,cuts,ans,num,tot:longint;
     next,last,w:array[..maxn*]of longint;
     first,size,a:array[..maxn]of longint;
     flag:array[..maxn]of boolean;

 function max(x,y:longint):longint;
 begin
     if x>y then exit(x);
     exit(y);
 end;

 procedure dfs1(x:longint);
 var
     i,s:longint;
 begin
     size[x]:=;
     i:=first[x];
     flag[x]:=false;
     s:=;
     while i<> do
       begin
         if flag[last[i]] then
         begin
           dfs1(last[i]);
           inc(size[x],size[last[i]]);
           s:=max(s,size[last[i]]);
         end;
         i:=next[i];
       end;
     if max(num-size[x],s)<cuts then
     begin
       cut:=x;
       cuts:=max(num-size[x],s);
     end;
     flag[x]:=true;
 end;

 procedure swap(var x,y:longint);
 var
     t:longint;
 begin
     t:=x;x:=y;y:=t;
 end;

 procedure sort(l,r:longint);
 var
     i,j,y:longint;
 begin
     i:=l;
     j:=r;
     y:=a[(l+r)>>];
     repeat
       while a[i]<y do
         inc(i);
       while a[j]>y do
         dec(j);
       if i<=j then
       begin
         swap(a[i],a[j]);
         inc(i);
         dec(j);
       end;
     until i>j;
     if i<r then sort(i,r);
     if j>l then sort(l,j);
 end;

 procedure dfs2(x,d:longint);
 var
     i:longint;
 begin
     inc(a[]);
     a[a[]]:=d;
     flag[x]:=false;
     i:=first[x];
     while i<> do
       begin
         if flag[last[i]] then dfs2(last[i],d+w[i]);
         i:=next[i];
       end;
     flag[x]:=true;
 end;

 function calc(x,d:longint):longint;
 var
     l,r:longint;
 begin
     calc:=;
     a[]:=;
     dfs2(x,d);
     sort(,a[]);
     l:=a[];
     for r:= to a[] do
       begin
         while (a[l]+a[r]>k) and (l>) do
           dec(l);
         if l<r then inc(calc,l)
         else inc(calc,r-);
       end;
 end;

 procedure work;
 var
     i:longint;
 begin
     inc(ans,calc(cut,));
     flag[cut]:=false;
     i:=first[cut];
     while i<> do
       begin
         if flag[last[i]] then dec(ans,calc(last[i],w[i]));
         i:=next[i];
       end;
     i:=first[cut];
     while i<> do
       begin
         if flag[last[i]] then
         begin
           dfs1(last[i]);
           num:=last[i];
           cuts:=num;
           cut:=last[i];
           dfs1(last[i]);
           work;
         end;
         i:=next[i];
       end;
 end;

 procedure insert(x,y,z:longint);
 begin
     inc(tot);
     last[tot]:=y;
     next[tot]:=first[x];
     first[x]:=tot;
     w[tot]:=z;
 end;

 procedure init;
 var
     i,x,y,z:longint;
 begin
     read(n,k);
     if n= then halt;
     tot:=;
     for i:= to n do
       begin
         first[i]:=;
         flag[i]:=true;
       end;
     ans:=;
     for i:= to n- do
       begin
         read(x,y,z);
         insert(x,y,z);
         insert(y,x,z);
       end;
     cut:=;
     cuts:=n;
     dfs1();
     work;
     writeln(ans);
 end;

 begin
     while true do
       init;
 end.