一些生成树问题

poj2349

题意：给你平面上一些点，两点距离为边权，现给出n个点和k，n表示点数，k表示联通快数量，要求一个d，使将权值大于d的边去掉，原图划分为k个联通快，并使d最小。

结论：建立最小生成树，树中第k长边为d值，因为前k-1个可以成块

var s,n,m,k,t:longint;
    x,y,b:array[1..500]of longint;
    l,r:array[1..250000]of longint;
    d:array[1..250000]of int64;
procedure inf;
begin
 assign(input,'2349.in');reset(input);
 assign(output,'2349.out');rewrite(output)
end;
procedure ouf;
begin
 close(input);close(output)
end;
procedure origin;
begin
 fillchar(x,sizeof(x),0);fillchar(y,sizeof(y),0);
 fillchar(l,sizeof(l),0);fillchar(r,sizeof(r),0);
 fillchar(d,sizeof(d),0);fillchar(b,sizeof(b),0);
end;
procedure qsort(ll,rr:longint);
var i,j,dd,c:longint;
begin
 i:=ll;j:=rr;dd:=d[(ll+rr)>>1];
 repeat
  while d[i]<dd do inc(i);
  while dd<d[j] do dec(j);
  if not(i>j) then begin
   c:=l[i];l[i]:=l[j];l[j]:=c;
   c:=r[i];r[i]:=r[j];r[j]:=c;
   c:=d[i];d[i]:=d[j];d[j]:=c;
   inc(i);dec(j)
  end
 until i>j;
 if i<rr then qsort(i,rr);
 if ll<j then qsort(ll,j)
end;
function dist(i,j:longint):longint;
begin
 exit(sqr(x[i]-x[j])+sqr(y[i]-y[j]))
end;
function find(x:longint):longint;
begin
 if x<>b[x] then b[x]:=find(b[x]);find:=b[x]
end;
function init:double;
var i,j,ll,rr,ans:longint;
begin
 readln(k,n);
 origin;
 if n=k then exit(0);
 for i:=1 to n do readln(x[i],y[i]);
 m:=0;
 for i:=1 to n-1 do
  for j:=i+1 to n do begin
   inc(m);l[m]:=i;r[m]:=j;d[m]:=dist(i,j)
  end;
 qsort(1,m);
 for i:=1 to n do b[i]:=i;s:=0;ans:=0;
 for i:=1 to m do begin
  ll:=find(b[l[i]]);rr:=find(b[r[i]]);
  if ll<>rr then begin
   inc(s);
   if n-s=k then exit(sqrt(d[i]));
   b[rr]:=ll;ans:=d[i]
  end
 end;
 exit(sqrt(ans))
end;
begin
 inf;
 readln(t);
 for t:=1 to t do writeln(init:0:2);
 ouf
end.           

度限制最小生成树

poj1639

题意：小矮人聚会什么的，其实就是求对“park”节点有度数限制，询问最小生成树。

汪汀集训队论文。

假设我们已知度为p的最小生成树，如何推出度为p+1的最小生成树

枚举与v0（即park节点）相连的不在生成树中的边，根据环切性质，它所代替的是这个环上非与v0相连的最大边，我们统计一下费用，选取费用最小的边既是p+1的最小生成树。如何求出环上最大边？通过bfs，可以在o（v）时间内处理出当前情况下的值，最多做k次。

而初始度数可以先删去v0点求最小生成树，在每个联通快向v0点连边权最小的边。

这道题输入很讨厌，不给点的标号，而是名字，因此可以用字符串哈希，不过我用的是字母树。

var l,r,w:array[1..3000]of longint;
    g:array[0..50,0..50]of longint;
    f:array[1..50,1..50]of boolean;
    v:array[1..50]of boolean;
    d,pre,b,st:array[1..50]of longint;
    next:array[0..3000,'A'..'z']of longint;
    sora:array[0..3000]of longint;
    n,s,ss,ans,k,p:longint;
procedure qsort(ll,rr:longint);
var i,j,ww,c:longint;
begin
 i:=ll;j:=rr;ww:=w[(ll+rr)>>1];
 repeat
  while w[i]<ww do inc(i);
  while ww<w[j] do dec(j);
  if not(i>j) then begin
   c:=w[i];w[i]:=w[j];w[j]:=c;
   c:=l[i];l[i]:=l[j];l[j]:=c;
   c:=r[i];r[i]:=r[j];r[j]:=c;
   inc(i);dec(j)
  end
 until i>j;
 if i<rr then qsort(i,rr);
 if ll<j then qsort(ll,j)
end;
function find(x:longint):longint;
begin
 if b[x]<>x then b[x]:=find(b[x]);find:=b[x]
end;
procedure bfs;
var h,r,i,ne:longint;
begin
 fillchar(d,sizeof(d),0);fillchar(pre,sizeof(pre),0);fillchar(st,sizeof(st),0);
 h:=0;r:=0;
 for i:=2 to s do
  if f[1,i] then begin
   d[i]:=1;
   inc(r);st[r]:=i
  end;
 d[1]:=1;
 repeat
  inc(h);ne:=st[h];
  for i:=2 to s do
   if (f[ne,i])and(d[i]=0) then begin
    if g[ne,i]>g[pre[ne],ne] then begin
     d[i]:=i;pre[i]:=ne
    end
    else d[i]:=d[ne];
    inc(r);st[r]:=i
   end
 until h>=r
end;
procedure readit(i:longint);
var k:longint;
    x:char;
begin
 read(x);k:=0;
 while x<>' ' do begin
  if next[k,x]<>0 then k:=next[k,x]
  else begin
   inc(ss);next[k,x]:=ss;k:=ss
  end;
  read(x)
 end;
 if sora[k]<>0 then l[i]:=sora[k] else begin inc(s);sora[k]:=s;l[i]:=s end;
 read(x);k:=0;
 while x<>' ' do begin
  if next[k,x]<>0 then k:=next[k,x]
  else begin
   inc(ss);next[k,x]:=ss;k:=ss
  end;
  read(x)
 end;
 if sora[k]<>0 then r[i]:=sora[k] else begin inc(s);sora[k]:=s;r[i]:=s end;
 readln(w[i]);
 g[l[i],r[i]]:=w[i];g[r[i],l[i]]:=w[i]
end;
procedure origin;
begin
 s:=1;
 next[0,'P']:=1;next[1,'a']:=2;next[2,'r']:=3;next[3,'k']:=4;
 sora[4]:=1;ss:=4
end;
procedure swap(var a,b:longint);
var c:longint;
begin
 c:=a;a:=b;b:=c
end;
procedure init;
var i,cos,min,mini,ll,rr,ne,tot:longint;
begin
 readln(n);
 origin;
 for i:=1 to n do readit(i);
 qsort(1,n);
 for i:=1 to s do b[i]:=i;
 ans:=0;
 fillchar(f,sizeof(f),false);
 for i:=1 to n do begin
  ll:=find(l[i]);rr:=find(r[i]);
  if (ll<>1)and(rr<>1)and(ll<>rr) then begin
   ans:=ans+w[i];
   b[ll]:=rr;
   f[l[i],r[i]]:=true;f[r[i],l[i]]:=true
  end
 end;
 readln(k);
 p:=0;
 fillchar(v,sizeof(v),true);
 for i:=1 to n do begin
  ll:=find(l[i]);rr:=find(r[i]);
  if ll>rr then swap(ll,rr);
  if (ll=1)and(v[rr]) then begin
   v[rr]:=false;
   ans:=ans+w[i];
   f[1,r[i]]:=true;f[r[i],1]:=true;
   f[1,l[i]]:=true;f[l[i],1]:=true;
   inc(p)
  end
 end;
 tot:=ans;
 while p<k do begin
  bfs;
  min:=maxlongint;mini:=0;
  for i:=2 to s do
   if (not f[1,i])and(g[1,i]<>0) then begin
    ne:=d[i];
    cos:=g[1,i]-g[pre[ne],ne];
    if cos<min then begin
     min:=cos;mini:=i
    end
   end;
  tot:=tot+cos;
  f[1,mini]:=true;f[mini,1]:=true;
  f[d[mini],pre[d[mini]]]:=false;f[pre[d[mini]],d[mini]]:=false;
  inc(p);
  if tot<ans then ans:=tot
 end;
 writeln('Total miles driven: ',ans)
end;
begin
 init
end.