网络流24题之四 魔术球问题 最小路径覆盖

问题描述：
假设有 n 根柱子，现要按下述规则在这 n 根柱子中依次放入编号为 1，2，3，…的球。
（1）每次只能在某根柱子的最上面放球。
（2）在同一根柱子中，任何 2 个相邻球的编号之和为完全平方数。
试设计一个算法，计算出在 n 根柱子上最多能放多少个球。例如，在 4 根柱子上最多可
放 11 个球。
编程任务：
对于给定的 n，计算在 n 根柱子上最多能放多少个球。
数据输入：
由文件 input.txt 提供输入数据。文件第 1 行有 1 个正整数 n，表示柱子数。
结果输出:
程序运行结束时，将 n 根柱子上最多能放的球数以及相应的放置方案输出到文件
output.txt 中。文件的第一行是球数。接下来的 n 行，每行是一根柱子上的球的编号。
输入文件示例  输出文件示例
input.txt  output.txt
4 11
1 8
2 7 9
3 6 10

4 5 11

【问题分析】
枚举答案转化为判定性问题，然后最小路径覆盖，可以转化成二分图最大匹配，从而用最大流解决。
【建模方法】
枚举答案A，在图中建立节点1..A。如果对于i<j有i+j为一个完全平方数，连接一条有向边(i,j)。该图是有向无环图，求最小路径覆盖。如果刚好满足最小路径覆盖数等于N，那么A是一个可行解，在所有可行解中找到最大的A，即为最优解。
具体方法可以顺序枚举A的值，当最小路径覆盖数刚好大于N时终止，A-1就是最优解。
【建模分析】
由于是顺序放球，每根柱子上的球满足这样的特征，即下面的球编号小于上面球的编号。抽象成图论，把每个球看作一个顶点，就是编号较小的顶点向编号较大的顶点连接边，条件是两个球可以相邻，即编号之和为完全平方数。每根柱子看做一条路径，N根柱子要覆盖掉所有点，一个解就是一个路径覆盖。

这题给的数据因为没有special judge，但有很多种方案，所以过不了，但是最小路径覆盖数是一样的，所以也就不管了。

打完这题后我懂得了一个重要的思想：一个图加点后的最小路径覆盖数一定是非递减的。

代码：

type
  arr=array[1..100000] of record
    x,y,z,next,p:longint;
  end;

const
  maxn=10000;

var
  i,j,s,t,e,a,n,ans:longint;
  side:arr;
  d,last:array[0..maxn+1] of longint;
  v:array[0..maxn+1] of boolean;

function bfs:boolean;
var
  head,tail,u,i:longint;
  state:array[1..maxn+2] of longint;
begin
  head:=0;
  tail:=1;
  state[1]:=s;
  fillchar(d,sizeof(d),0);
  d[s]:=1;
  repeat
    inc(head);
    u:=state[head];
    i:=last[u];
    while i>0 do
      with side[i] do
      begin
        if (z>0)and(d[y]=0) then
        begin
          d[y]:=d[u]+1;
          inc(tail);
          state[tail]:=y;
          if y=t then exit(true);
        end;
        i:=next;
      end;
  until head>=tail;
  bfs:=false;
end;

function min(x,y:longint):longint;
begin
  if x<y then exit(x)
         else exit(y);
end;

function dfs(x,maxf:longint):longint;
var
  f,i,ret:longint;
begin
  if x=t then exit(maxf);
  ret:=0;
  i:=last[x];
  while i>0 do
    with side[i] do
    begin
      if (z>0)and(d[y]=d[x]+1) then
      begin
        f:=dfs(y,min(maxf-ret,z));
        ret:=ret+f;
        dec(z,f);
        inc(side[p].z,f);
        if ret=maxf then exit(ret);
      end;
      i:=next;
    end;
  dfs:=ret;
end;

procedure dfs1(x:longint);
var
  i:longint;
begin
  v[x]:=false;
  i:=last[x];
  while i>0 do
    with side[i] do
    begin
      if (z=0)and(side[p].z=1)and(v[maxn+1-y])and(y>a) then
      begin
        write(maxn+1-y,' ');
        dfs1(maxn+1-y);
        break;
      end;
      i:=next;
    end;
end;

procedure insert(x,y:longint);
begin
  inc(e);
  side[e].x:=x; side[e].y:=y; side[e].z:=1; side[e].p:=e+1;
  side[e].next:=last[x]; last[x]:=e;
  inc(e);
  side[e].x:=y; side[e].y:=x; side[e].z:=0; side[e].p:=e-1;
  side[e].next:=last[y]; last[y]:=e;
end;

begin
  //assign(input,'ball.in');
  //assign(output,'ball.out');
  reset(input);
  rewrite(output);
  readln(n);
  a:=n;
  for i:=1 to a-1 do
    for j:=i+1 to a do
      if sqr(trunc(sqrt(i+j)))=i+j then
        insert(i,maxn-j+1);
  s:=0;
  t:=maxn+1;
  for i:=1 to a do
  begin
    insert(s,i);
    insert(maxn-i+1,t);
  end;
  while true do
  begin
    while bfs do ans:=ans+dfs(s,maxlongint);
    if a-ans>n then break;
    inc(a);
    for i:=1 to a-1 do
      if sqr(trunc(sqrt(i+a)))=i+a then
        insert(i,maxn-a+1);
    insert(s,a);
    insert(maxn-a+1,t);
  end;
  writeln(a-1);
  dec(a);
  fillchar(v,sizeof(v),true);
  for i:=1 to a do
    if v[i] then
    begin
      write(i,' ');
      dfs1(i);
      writeln;
    end;
  close(input);
  close(output);
end.