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