用单调性优化动态规划 poj3017

题意：将长度为n的序列分成若干段，使每段之和不大于m，且使各段中最大值之和最小，输出该值。

显然的方程f[i]:=min(f[j]+max(j+1,i));f[i]表示前i个中划分出的最小值，max(l,r)只l，r中的最大值，转移条件为sum[j+1,i]<=m。

这个方程时间复杂度为o（n^2）的，承受不了，所以要优化。

设b[i]为能转移到i的最小的j，由于所有的数均为正整数，所以b数组是递增的，同时，f数组也可证出是非降的（设将a[i]从f[i]中拿出即可得到f[i-1]，则若a[i]为f[i]最后一段中最大的，则f[i-1]<f[i]，若不是则f[i-1]=f[i]，得证）。

考虑一种情况，我们用f[j]推f[i]时，a[j]<=max(j+1,i)，则将a[j]并入后一段不会对最大值造成影响，而f[j-1]<=f[j]，由f[j-1]推f[i]必定更优。

因此根据以上性质，我们维护一个单调队列，通过b值从队首退元素，通过a值递减，从队尾退元素，因为a是递减的所以有个很优美的性质max(j+1,i)=j在队列中后一个j‘的a值，有了这个性质不管是转移还是维护都好实现——转移时直接加，维护时，只需对最后一个元素修改。

队首决策不一定最优，所以用数据结构维护，我用的是线段树。

var a,d,b:array[0..100000]of longint;
    f,s:array[0..100000]of int64;
    b1:array[1..262144]of int64;
    n,m,m1:int64;
function search(x:longint):longint;
var l,r,mid:longint;
begin
 l:=1;r:=x;
 while l<=r do begin
  mid:=(l+r)>>1;
  if s[x]-s[mid-1]>m then l:=mid+1 else r:=mid-1
 end;
 exit(l)
end;
procedure origin;
var i:longint;
begin
 fillchar(b,sizeof(b),0);fillchar(s,sizeof(s),0);
 s[0]:=0;for i:=1 to n do s[i]:=s[i-1]+a[i];
 i:=1;
 while (s[i]<=m)and(i<=n) do begin b[i]:=0;inc(i) end;
 for i:=i to n do b[i]:=search(i)-1;
 m1:=1;
 while m1<n+2 do m1:=m1<<1;m1:=m1-1;
 fillchar(b1,sizeof(b1),127)
end;
function mini(x,y:longint):longint;
begin
 if x<y then exit(x) else exit(y)
end;
procedure update(x:longint);
var w:longint;
begin
 w:=f[d[x]]+a[d[x+1]];
 x:=x+m1;b1[x]:=w;x:=x>>1;
 while x<>0 do begin
  b1[x]:=mini(b1[x<<1],b1[x<<1+1]);x:=x>>1
 end
end;
function ask(l,r:longint):longint;
begin
 if l>r then exit(maxlongint);
 l:=l+m1-1;r:=r+m1+1;ask:=maxlongint;
 while not(l xor r =1) do begin
  if l and 1=0 then if b1[l+1]<ask then ask:=b1[l+1];
  if r and 1=1 then if b1[r-1]<ask then ask:=b1[r-1];
  l:=l>>1;r:=r>>1
 end
end;
procedure dp;
var h,r:longint;
    i:longint;
    min:int64;
begin
 fillchar(d,sizeof(d),61);fillchar(f,sizeof(f),61);
 h:=1;r:=1;d[1]:=0;a[0]:=m+1;f[0]:=0;
 for i:=1 to n do begin
  if i=8 then
   h:=h;
  while d[h]<b[i] do inc(h);
  if d[h]<>b[i] then begin dec(h);d[h]:=b[i];update(h) end;
  while (a[d[r]]<=a[i])and(r>h) do dec(r);
  min:=ask(h,r-1);
  if f[d[r]]+a[i]<min then min:=f[d[r]]+a[i];
  f[i]:=min;inc(r);d[r]:=i;update(r-1)
 end
end;
procedure init;
var i:longint;
    flag:boolean;
begin
 readln(n,m);
 fillchar(a,sizeof(a),0);
 flag:=false;
 for i:=1 to n do begin
  read(a[i]);
  if a[i]>m then flag:=true
 end;
 if flag then begin writeln(-1);exit end;
 origin;
 dp;
 writeln(f[n])
end;
begin
 init
end.