网络流24题之六 最长递增子序列

问题描述：
给定正整数序列
（1）计算其最长递增子序列的长度 s。
（2）计算从给定的序列中最多可取出多少个长度为 s 的递增子序列。
（3）如果允许在取出的序列中多次使用 x 1 和 x n ，则从给定序列中最多可取出多少个长
度为 s 的递增子序列。
? 编程任务：
设计有效算法完成（1） （2） （3）提出的计算任务。
?数据输入：
由文件 input.txt 提供输入数据。文件第 1 行有 1 个正整数 n，表示给定序列的长度。接
下来的 1 行有 n 个正整数
结果输出:
程序运行结束时，将任务（1） （2） （3）的解答输出到文件 output.txt 中。第 1 行是最长
递增子序列的长度 s。第 2 行是可取出的长度为 s 的递增子序列个数。第 3 行是允许在取出
的序列中多次使用 x 1 和 x n 时可取出的长度为 s 的递增子序列个数。
输入文件示例  输出文件示例
input.txt  output.txt
4
3 6 2 5
2
2

3

【问题分析】
第一问时LIS，动态规划求解，第二问和第三问用网络最大流解决。
【建模方法】
首先动态规划求出F[i]，表示以第i位为开头的最长上升序列的长度，求出最长上升序列长度K。
1、把序列每位i拆成两个点<i.a>和<i.b>，从<i.a>到<i.b>连接一条容量为1的有向边。
2、建立附加源S和汇T，如果序列第i位有F[i]=K，从S到<i.a>连接一条容量为1的有向边。
3、如果F[i]=1，从<i.b>到T连接一条容量为1的有向边。
4、如果j>i且A[i] < A[j]且F[j]+1=F[i]，从<i.b>到<j.a>连接一条容量为1的有向边。
求网络最大流，就是第二问的结果。把边(<1.a>,<1.b>)(<N.a>,<N.b>)(S,<1.a>)(<N.b>,T)这四条边的容量修改为无穷大，再求一次网络最大流，就是第三问结果。

打完这题后我明白了如果要某个东西只能用一次的话就可以拆点。

代码：

var
  ans,i,j,n,w,s,t:longint;
  c:array[0..1000,0..1000] of longint;
  d,a,f:array[0..1000] of longint;

function bfs:boolean;
var
  head,tail,i,u:longint;
  state:array[1..1000] of longint;
begin
  head:=0;
  tail:=1;
  state[1]:=s;
  fillchar(d,sizeof(d),0);
  d[s]:=1;
  repeat
    inc(head);
    u:=state[head];
    for i:=s to t do
      if (d[i]=0)and(c[u,i]>0) then
      begin
        d[i]:=d[u]+1;
        inc(tail);
        state[tail]:=i;
        if i=t then exit(true);
      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
  ret,f,i:longint;
begin
  if x=t then exit(maxf);
  ret:=0;
  for i:=s to t do
    if (d[i]=d[x]+1)and(c[x,i]>0) then
    begin
      f:=dfs(i,min(maxf-ret,c[x,i]));
      ret:=ret+f;
      dec(c[x,i],f);
      inc(c[i,x],f);
      if ret=maxf then break;
    end;
  dfs:=ret;
end;

begin
  assign(input,'alis.in');
  assign(output,'alis.out');
  reset(input);
  rewrite(output);
  readln(n);
  for i:=1 to n do
    read(a[i]);
  for i:=1 to n do
  begin
    f[i]:=1;
    for j:=1 to i-1 do
      if (a[j]<a[i])and(f[j]+1>f[i]) then
        f[i]:=f[j]+1;
    if f[i]>w then w:=f[i];
  end;
  writeln(w);
  s:=0;
  t:=n*2+1;
  for i:=1 to n do
  begin
    c[i*2-1,i*2]:=1;
    if f[i]=1 then
      c[s,i*2-1]:=1;
    if f[i]=w then
      c[i*2,t]:=1;
  end;
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if (a[i]<a[j])and(f[i]+1=f[j]) then
        c[i*2,j*2-1]:=1;
  while bfs do ans:=ans+dfs(s,maxlongint);
  writeln(ans);
  ans:=0;
  fillchar(c,sizeof(c),0);
  for i:=1 to n do
  begin
    c[i*2-1,i*2]:=1;
    if f[i]=1 then
      c[s,i*2-1]:=1;
    if f[i]=w then
      c[i*2,t]:=1;
  end;
  c[s,1]:=maxlongint;
  c[1,2]:=maxlongint;
  c[n*2-1,n*2]:=maxlongint;
  if c[n*2,t]>0 then c[n*2,t]:=maxlongint;
  for i:=1 to n-1 do
    for j:=i+1 to n do
      if (a[i]<a[j])and(f[i]+1=f[j]) then
        c[i*2,j*2-1]:=1;
  while bfs do ans:=ans+dfs(s,maxlongint);
  writeln(ans);
  close(input);
  close(output); 
end.