具体可以见漆子超的论文
/************************************************************** Problem: 2599 User: BLADEVIL Language: Pascal Result: Accepted Time:16052 ms Memory:16928 kb ****************************************************************/ //By BLADEVIL var n, m :longint; pre, other, len :array[0..400010] of longint; last :array[0..200010] of longint; l, top :longint; size, stack, yy, ll :array[0..200010] of longint; ff :array[0..400010] of boolean; root :longint; b :array[0..1000001] of longint; old :longint; ans :longint; procedure connect(x,y,z:longint); begin inc(l); pre[l]:=last[x]; last[x]:=l; other[l]:=y; len[l]:=z; end; procedure dfs_size(x,fa:longint); var q, p :longint; begin size[x]:=1; inc(top); stack[top]:=x; q:=last[x]; while q<>0 do begin p:=other[q]; if (ff[q]) or (p=fa) then begin q:=pre[q]; continue; end; dfs_size(p,x); inc(size[x],size[p]); q:=pre[q]; end; yy[x]:=fa; end; procedure getroot(u:longint); var ms, s, x, p, q :longint; i :longint; begin top:=0; dfs_size(u,0); ms:=maxlongint; for i:=1 to top do begin x:=stack[i]; s:=size[u]-size[x]; q:=last[x]; while q<>0 do begin p:=other[q]; if (ff[q]) or (p=yy[x]) then begin q:=pre[q]; continue; end; if size[p]>s then s:=size[p]; q:=pre[q]; end; if s<ms then begin ms:=s; root:=x; end; end; end; procedure dfs_value(x,fa,lz,dep:longint); var q, p :longint; begin if lz>m then exit; if dep>=ans then exit; if b[m-lz]>=0 then if b[m-lz]+dep<ans then ans:=b[m-lz]+dep; if (b[lz]<0) or (dep<b[lz]) then begin inc(top); stack[top]:=lz; ll[top]:=dep; end; q:=last[x]; while q<>0 do begin p:=other[q]; if (p=fa) or (ff[q]) then begin q:=pre[q]; continue; end; dfs_value(p,x,lz+len[q],dep+1); q:=pre[q]; end; end; procedure solve(u:longint); var i, q, p :longint; begin getroot(u); if top=1 then exit; top:=0; q:=last[root]; while q<>0 do begin p:=other[q]; if ff[q] then begin q:=pre[q]; continue; end; old:=top+1; dfs_value(p,root,len[q],1); for i:=old to top do if (b[stack[i]]<0) or (b[stack[i]]>ll[i]) then b[stack[i]]:=ll[i]; q:=pre[q]; end; for i:=1 to top do b[stack[i]]:=-1; q:=last[root]; while q<>0 do begin p:=other[q]; if ff[q] then begin q:=pre[q]; continue; end; ff[q]:=true; ff[q xor 1]:=true; solve(p); q:=pre[q]; end; end; procedure main; var i :longint; x, y, z :longint; begin read(n,m); l:=1; fillchar(b,sizeof(b),$ff); b[0]:=0; for i:=1 to n-1 do begin read(x,y,z); inc(x); inc(y); connect(x,y,z); connect(y,x,z); end; ans:=maxlongint; solve(1); if ans>10000000 then writeln(-1) else writeln(ans); end; begin main; end.