一些动规题
ps：代码有点丑。
二维偏序的最长上升子序列
看到标题是不是觉得很水呢。。。
但是如果其中一维是dfs序，即在树上呢。。。
而且，还得缩环成树。。。
先缩环，一维dfs，二维线段树or单调栈。
{$M 100000000}
uses math;
var t,b,rt,w,tail,tail1,v,q,p,st,f:array[1..300000]of longint;
d:array[1..524288]of longint;
v1:array[1..200000]of boolean;
next,next1,sora,sora1:array[1..500000]of longint;
ans,s1,sta,m1,ss,ss1,n,r:longint;
procedure inf;
begin
assign(input,'travel.in');reset(input);
assign(output,'travel.out');rewrite(output)
end;
procedure ouf;
begin
close(input);close(output)
end;
procedure origin;
var i:longint;
begin
for i:=1 to n do tail[i]:=i;ss:=n;
for i:=1 to n do tail1[i]:=i;ss1:=n;
m1:=1;
while m1<=n+2 do m1:=m1<<1
end;
procedure qsort(l,r:longint);
var i,j,x,c:longint;
begin
i:=l;j:=r;x:=w[(l+r)>>1];
repeat
while w[i]<x do inc(i);
while x<w[j] do dec(j);
if not(i>j) then begin
c:=w[i];w[i]:=w[j];w[j]:=c;
c:=p[i];p[i]:=p[j];p[j]:=c;
inc(i);dec(j)
end
until i>j;
if i<r then qsort(i,r);
if l<j then qsort(l,j)
end;
procedure qsort2(l,r:longint);
var i,j,x,c:longint;
begin
i:=l;j:=r;x:=q[st[(l+r)>>1]];
repeat
while q[st[i]]<x do inc(i);
while x<q[st[j]] do dec(j);
if not(i>j) then begin
c:=st[i];st[i]:=st[j];st[j]:=c;
inc(i);dec(j)
end
until i>j;
if i<r then qsort2(i,r);
if l<j then qsort2(l,j)
end;
procedure link(x,y:longint);
begin
inc(ss);next[tail[x]]:=ss;tail[x]:=ss;sora[ss]:=y
end;
procedure link2(x,y:longint);
begin
inc(ss1);next1[tail1[x]]:=ss1;tail1[x]:=ss1;sora1[ss1]:=y;
next[tail[x]]:=next[y];tail[x]:=tail[y]
end;
procedure dfs2(x:longint);
var rr,i:longint;
begin
v[x]:=1;
inc(r);st[r]:=x;
if v[rt[x]]=2 then begin dec(r);v[x]:=2;exit end;
if v[rt[x]]=0 then begin
dfs2(rt[x]);
if sta=0 then dec(r)
else if sta=x then begin
inc(s1);b[x]:=s1;v1[x]:=true;
rr:=r;
while st[r]<>x do dec(r);
for i:=r+1 to rr do begin
b[st[i]]:=s1;
link2(x,st[i])
end;
dec(r)
end;
v[x]:=2;
exit
end;
if v[rt[x]]=1 then begin
sta:=rt[x];
// dec(r);
v[x]:=2
end;
end;
function ask(l,r:longint):longint;
begin
if l>r then exit(0);
l:=l+m1-1;r:=r+m1+1;ask:=0;
while not(l xor r=1) do begin
if l and 1=0 then ask:=max(ask,d[l+1]);
if r and 1=1 then ask:=max(ask,d[r-1]);
l:=l>>1;r:=r>>1
end
end;
procedure change(x,w:longint);
begin
x:=x+m1;d[x]:=w;
x:=x>>1;
while x<>0 do begin
d[x]:=max(d[x<<1],d[x<<1+1]);
x:=x>>1
end
end;
procedure dfs(x:longint);
var i,ne:longint;
begin
if not v1[x] then begin
f[x]:=ask(1,q[x]-1)+1;
change(t[x],f[x]);
end;
i:=x;
while i<>0 do begin
i:=next[i];ne:=sora[i];
if b[ne]=0 then dfs(ne)
end;
change(t[x],0)
end;
procedure doit(x:longint);
var sum,tot,i,ne:longint;
begin
fillchar(d,sizeof(d),0);
r:=1;st[r]:=x;
i:=x;
while next1[i]<>0 do begin
i:=next1[i];ne:=sora1[i];
inc(r);st[r]:=ne
end;
qsort2(1,r);
sum:=0;tot:=0;
for i:=1 to r do begin
ne:=st[i];
if q[ne]<>q[st[i-1]] then begin
sum:=sum+tot;
f[ne]:=sum+1;change(t[ne],f[ne]);
tot:=1
end
else begin
f[ne]:=sum+1;change(t[ne],f[ne]);
inc(tot)
end
end
end;
procedure init;
var i,x:longint;
begin
readln(n);
origin;
for i:=1 to n do begin
read(w[i]);
p[i]:=i
end;
qsort(1,n);
for i:=1 to n do begin
if w[i]<>w[i-1] then q[p[i]]:=i
else q[p[i]]:=q[p[i-1]];
t[p[i]]:=i
end;
for i:=1 to n do begin
read(x);
rt[i]:=x;
link(x,i)
end;
fillchar(v,sizeof(v),0);fillchar(st,sizeof(st),0);
fillchar(b,sizeof(b),0);s1:=0;
fillchar(v1,sizeof(v1),false);
for i:=1 to n do
if v[i]=0 then begin
r:=0;sta:=0;
dfs2(i)
end;
for i:=1 to n do
if (v1[i])or(rt[i]=i) then begin
if rt[i]<>i then doit(i) else begin change(t[i],1);b[i]:=i end;
dfs(i)
end;
ans:=0;
for i:=1 to n do ans:=max(ans,f[i]);
writeln(ans)
end;
begin
inf;
init;
ouf
end.
在n*m的图上，求一个点数为k的联通块，每个格子有一个权值。使得这些格子的任意 2 个，都可仅通过上、下、左、右中的两种方向互达，并使权值最大。
丑丑的dp，f[i,l,r,k]表示到第i行，第i行左端点为l，右端点为r，有k个格子的最大值。分成4种转移方程后，互相转。写得很想吐。我还把l，r状压在一起。
uses math;
const ss:array[1..120]of longint=
(1,2,3,4,6,7,8,12,14,15,
16,24,28,30,31,32,48,56,60,62,
63,64,96,112,120,124,126,127,128,192,
224,240,248,252,254,255,256,384,448,480,
496,504,508,510,511,512,768,896,960,992,
1008,1016,1020,1022,1023,1024,1536,1792,1920,1984,
2016,2032,2040,2044,2046,2047,2048,3072,3584,3840,
3968,4032,4064,4080,4088,4092,4094,4095,4096,6144,
7168,7680,7936,8064,8128,8160,8176,8184,8188,8190,
8191,8192,12288,14336,15360,15872,16128,16256,16320,16352,
16368,16376,16380,16382,16383,16384,24576,28672,30720,31744,
32256,32512,32640,32704,32736,32752,32760,32764,32766,32767);
kk:array[1..120]of longint=
(1,1,2,1,2,3,1,2,3,4,
1,2,3,4,5,1,2,3,4,5,
6,1,2,3,4,5,6,7,1,2,
3,4,5,6,7,8,1,2,3,4,
5,6,7,8,9,1,2,3,4,5,
6,7,8,9,10,1,2,3,4,5,
6,7,8,9,10,11,1,2,3,4,
5,6,7,8,9,10,11,12,1,2,
3,4,5,6,7,8,9,10,11,12,
13,1,2,3,4,5,6,7,8,9,
10,11,12,13,14,1,2,3,4,5,
6,7,8,9,10,11,12,13,14,15);
var f,g,e:array[1..4,1..15,1..120,1..225]of longint;
a:array[1..15,1..15]of longint;
c:array[1..15,1..120]of longint;
t,t2,t3,t4:array[1..120,1..120]of boolean;
anso,ansi,ansj,ans,n,m,k,maxs,k1,k2:longint;
b:array[0..15]of longint;
procedure inf;
begin
assign(input,'Bigagrib.in');reset(input);
assign(output,'Bigagrib.out');rewrite(output)
end;
procedure ouf;
begin
close(input);close(output)
end;
function check1(s,ns:longint):boolean;
var a,b:array[0..15]of longint;
k,k1:longint;
begin
if s and ns=0 then exit(false);
fillchar(a,sizeof(a),0);fillchar(b,sizeof(b),0);
k:=s;
while k<>0 do begin
inc(a[0]);a[a[0]]:=k and 1;
k:=k>>1
end;
k:=ns;
while k<>0 do begin
inc(b[0]);b[b[0]]:=k and 1;
k:=k>>1
end;
if a[0]<b[0] then exit(false);
for k:=1 to a[0] do
if a[k]=1 then break;
for k1:=1 to b[0] do
if b[k1]=1 then break;
if b[k]=1 then exit(true)
else exit(false)
end;
function check2(s,ns:longint):boolean;
var a,b:array[0..15]of longint;
k,k1:longint;
begin
if s and ns=0 then exit(false);
fillchar(a,sizeof(a),0);fillchar(b,sizeof(b),0);
k:=s;
while k<>0 do begin
inc(a[0]);a[a[0]]:=k and 1;
k:=k>>1
end;
k:=ns;
while k<>0 do begin
inc(b[0]);b[b[0]]:=k and 1;
k:=k>>1
end;
if a[0]<b[0] then exit(false);
for k:=1 to a[0] do
if a[k]=1 then break;
for k1:=1 to b[0] do
if b[k1]=1 then break;
if k<=k1 then exit(true)
else exit(false)
end;
function check3(s,ns:longint):boolean;
var a,b:array[0..15]of longint;
k,k1:longint;
begin
if s and ns=0 then exit(false);
fillchar(a,sizeof(a),0);fillchar(b,sizeof(b),0);
k:=s;
while k<>0 do begin
inc(a[0]);a[a[0]]:=k and 1;
k:=k>>1
end;
k:=ns;
while k<>0 do begin
inc(b[0]);b[b[0]]:=k and 1;
k:=k>>1
end;
if a[0]>b[0] then exit(false);
for k:=1 to a[0] do
if a[k]=1 then break;
for k1:=1 to b[0] do
if b[k1]=1 then break;
if k1<k then exit(false);
if b[a[0]]=1 then exit(true)
else exit(false)
end;
function check4(s,ns:longint ): boolean;
var a,b:array[0..15]of longint;
k,k1:longint;
begin
if s and ns=0 then exit(false);
fillchar(a,sizeof(a),0);fillchar(b,sizeof(b),0);
k:=s;
while k<>0 do begin
inc(a[0]);a[a[0]]:=k and 1;
k:=k>>1
end;
k:=ns;
while k<>0 do begin
inc(b[0]);b[b[0]]:=k and 1;
k:=k>>1
end;
if a[0]>b[0] then exit(false);
for k:=1 to a[0] do
if a[k]=1 then break;
for k1:=1 to b[0] do
if b[k1]=1 then break;
if k>=k1 then exit(true)
else exit(false)
end;
procedure origin;
var s,ns,i,j,p,x:longint;
begin
for i:=1 to n do
for j:=1 to maxs do
if kk[j]<=k then begin
p:=m;x:=ss[j];
while x<>0 do begin
c[i,j]:=c[i,j]+a[i,p]*(x and 1);
x:=x>>1;dec(p)
end;
f[1,i,j,kk[j]]:=c[i,j];f[2,i,j,kk[j]]:=c[i,j];
f[3,i,j,kk[j]]:=c[i,j];f[4,i,j,kk[j]]:=c[i,j]
end;
for i:=1 to maxs do begin
if kk[i]<=k then
for j:=1 to maxs do
if kk[j]<=k then begin
s:=ss[i];ns:=ss[j];
if s<>ns then t[i,j]:=check1(s,ns) else t[i,j]:=true;
// *****
// ****
if s<>ns then t2[i,j]:=check2(s,ns) else t2[i,j]:=true;
// ******
// ***
if s<>ns then t3[i,j]:=check3(s,ns) else t3[i,j]:=true;
// *****
// *****
if s<>ns then t4[i,j]:=check4(s,ns) else t4[i,j]:=true
// ***
// ******
end
end
end;
procedure dfs(o,i,j,k:longint);
begin
if k=0 then exit;
dfs(g[o,i,j,k],i-1,e[o,i,j,k],k-kk[j]);
fillchar(b,sizeof(b),0);
k1:=ss[j];
while k1<>0 do begin
inc(b[0]);b[b[0]]:=k1 and 1;
k1:=k1>>1
end;
for k1:=1 to b[0] do
if b[k1]=1 then break;
for k2:=b[0] downto k1 do begin
writeln(i,' ',m-k2+1)
end
end;
procedure getout;
var i,j:longint;
begin
anso:=0;ansi:=0;ansj:=0;
for i:=1 to n do
for j:=1 to maxs do begin
if f[1,i,j,k]>ans then begin
ans:=f[1,i,j,k];
anso:=1;ansi:=i;ansj:=j
end;
if f[2,i,j,k]>ans then begin
ans:=f[2,i,j,k];
anso:=2;ansi:=i;ansj:=j
end;
if f[3,i,j,k]>ans then begin
ans:=f[3,i,j,k];
anso:=3;ansi:=i;ansj:=j
end;
if f[4,i,j,k]>ans then begin
ans:=f[4,i,j,k];
anso:=4;ansi:=i;ansj:=j
end
end
end;
procedure updata(o1,o2,i,j,p,i1,j1,p1:longint);
begin
if p1>k then exit;
if f[o1,i,j,p]+c[i1,j1]>f[o2,i1,j1,p1] then begin
f[o2,i1,j1,p1]:=f[o1,i,j,p]+c[i1,j1];
g[o2,i1,j1,p1]:=o1;
e[o2,i1,j1,p1]:=j
end
end;
procedure init;
var i,j,p,nj:longint;
begin
readln(n,m,k);
for i:=1 to n do begin
for j:=1 to m do read(a[i,j]);
readln
end;
fillchar(t,sizeof(t),false);fillchar(t2,sizeof(t2),false);fillchar(t3,sizeof(t3),false);fillchar(t4,sizeof(t4),false);
fillchar(c,sizeof(c),0);
fillchar(f,sizeof(f),0);
maxs:=1<<m-1;
for i:=1 to 120 do
if ss[i]=maxs then break;
maxs:=i;
origin;
for i:=1 to n-1 do
for j:=1 to maxs do
for p:=kk[j] to k do
for nj:=1 to maxs do begin
if f[1,i,j,p]<>0 then begin
if t[j,nj] then updata(1,1,i,j,p,i+1,nj,p+kk[nj]);
if t2[j,nj] then updata(1,2,i,j,p,i+1,nj,p+kk[nj])
end;
if f[2,i,j,p]<>0 then begin
if t2[j,nj] then updata(2,2,i,j,p,i+1,nj,p+kk[nj])
end;
if f[3,i,j,p]<>0 then begin
if t2[j,nj] then updata(3,2,i,j,p,i+1,nj,p+kk[nj]);
if t3[j,nj] then updata(3,3,i,j,p,i+1,nj,p+kk[nj])
end;
if f[4,i,j,p]<>0 then begin
if t[j,nj] then updata(4,1,i,j,p,i+1,nj,p+kk[nj]);
if t2[j,nj] then updata(4,2,i,j,p,i+1,nj,p+kk[nj]);
if t3[j,nj] then updata(4,3,i,j,p,i+1,nj,p+kk[nj]);
if t4[j,nj] then updata(4,4,i,j,p,i+1,nj,p+kk[nj]);
end
end;
ans:=0;
getout;
writeln(ans);
dfs(anso,ansi,ansj,k)
end;
begin
inf;
init;
ouf
end.