Dp 神奇的状态转移……

Program fd;
const
   mo=1000000007;
var
   n,i,j:longint;
   c,tot:array[1..15] of longint;
   f:array[0..15,0..15,0..15,0..15,0..15,0..15] of int64;
function dfs(a1,a2,a3,a4,a5,last:longint):int64;
var
   i,j:longint;
   ans,q:int64;
   a:array[1..5] of longint;
begin
   if f[a1,a2,a3,a4,a5,last]>0 then exit(f[a1,a2,a3,a4,a5,last]);
   a[1]:=a1;a[2]:=a2;a[3]:=a3;a[4]:=a4;a[5]:=a5;
   ans:=0;
   for i:=1 to 5 do
      if (a[i]>0) then
      begin
         if (last=i+1) and (a[i]=1) then continue;

  //     if (last=i+1) then dec(a[i]);
         dec(a[i]);
         if i>1 then inc(a[i-1]);


         q:=dfs(a[1],a[2],a[3],a[4],a[5],i);
         inc(a[i]);
         if i>1 then dec(a[i-1]);

         if last=i+1 then ans:=(ans+(a[i]-1)*q) mod mo
         else ans:=(ans+a[i]*q) mod mo;


  //     if (last=i+1) then inc(a[i]);
      end;
   f[a1,a2,a3,a4,a5,last]:=ans;
   exit(ans);
end;
begin
   read(n);
   fillchar(tot,sizeof(tot),0);
   for i:=1 to n do
   begin
      read(c[i]);
      inc(tot[c[i]]);
   end;
   fillchar(f,sizeof(f),0);
   for i:=1 to n do f[0,0,0,0,0,i]:=1;
   writeln(dfs(tot[1],tot[2],tot[3],tot[4],tot[5],0));



end.

高精Dp

Program P2506;
type
   arr=record
       a:array[1..10000] of longint;
       len:longint;
       end;
const
   base=1000;
var
   i,j,n:longint;
   f:array[0..250] of arr;
function max(a,b:longint):longint;
begin
   if a<b then exit(b) else exit(a);
end;
Procedure add(a,b:arr;var c:arr);
var
   i,j,len:longint;
begin
   fillchar(c,sizeof(c),0);
   for i:=1 to max(a.len,b.len) do
   begin
      inc(c.a[i],a.a[i]+2*b.a[i]);
      inc(c.a[i+1],c.a[i] div base);
      c.a[i]:=c.a[i] mod base;
   end;
   i:=max(a.len,b.len);
   while (c.a[i+1]>0) do
   begin
      inc(i);
      inc(c.a[i+1],c.a[i] div base);
      c.a[i]:=c.a[i] mod base;
   end;
   while (i>1) and (c.a[i]=0) do dec(i);
   c.len:=i;

end;
begin
   fillchar(f,sizeof(f),0);
   for i:=0 to 250 do f[i].len:=1;
   f[1].a[1]:=1;
   f[0].a[1]:=1;
   for i:=2 to 250 do add(f[i-1],f[i-2],f[i]);
   while not eof do
   begin
      readln(n);
      write(f[n].a[f[n].len]);
      for i:=f[n].len-1 downto 1 do
      begin
         if f[n].a[i]<100 then write('0');
         if f[n].a[i]<10 then write('0');
         write(f[n].a[i]);
      end;
      writeln;
   end;

end.

双向LIS……居然数组又开小了……

Program P1836;
var
   n,i,j,ans:longint;
   a:array[1..1000] of double;
   ll,lr:array[1..1000] of longint;
function min(a,b:longint):longint;
begin
   if a<b then exit(a) else exit(b);
end;
begin
   fillchar(ll,sizeof(ll),0);
   fillchar(lr,sizeof(lr),0);

   read(n);
   for i:=1 to n do read(a[i]);
   ll[1]:=1;
   for i:=2 to n do
   begin
      for j:=1 to i-1 do
         if a[j]<a[i] then if (ll[j]>=ll[i]) then
            ll[i]:=ll[j]+1;
      if ll[i]=0 then inc(ll[i]);
   end;
   lr[n]:=1;
   for i:=n-1 downto 1 do
   begin
      for j:=i+1 to n do
         if a[j]<a[i] then if (lr[j]>=lr[i]) then
            lr[i]:=lr[j]+1;
      if lr[i]=0 then inc(lr[i]);
   end;
   ans:=n;
   for i:=1 to n do
      ans:=min(ans,n-(ll[i]+lr[i]-1));
   for i:=1 to n do
      for j:=i+1 to n do
         ans:=min(ans,n-(ll[i]+lr[j]));
   writeln(ans);
end.

这题居然不用高精度就能过……测试数据好弱

Program P1837;
var
   c,g,i,j,k,p:longint;
   li,w:array[1..20] of longint;
   f:array[1..20,-7500..7500] of longint;
begin
   fillchar(f,sizeof(f),0);
   read(c,g);
   for i:=1 to c do read(li[i]);
   for i:=1 to g do read(w[i]);
   for i:=1 to c do f[1,li[i]*w[1]]:=1;
   for i:=2 to g do
      for j:=1 to c do
      begin
         p:=li[j]*w[i];
         if p<0 then
         begin
            for k:=-7500 to 7500+p do
               if f[i-1,k-p]>0 then
                  inc(f[i,k],f[i-1,k-p])
         end
         else
         begin
            for k:=-7500+p to 7500 do
               if f[i-1,k-p]>0 then
                  inc(f[i,k],f[i-1,k-p]);
         end;
      end;
   writeln(f[g,0]);
end.

限制背包

Program P1014;
const
   maxv=120000;
   n=6;
var
   a:array[1..6] of longint;
   i,j,k,l,v:longint;
   f:array[0..maxv] of boolean;
function max(a,b:longint):longint;
begin
   if a>b then exit(a) else exit(b);
end;
procedure CompletePack(cost:longint);
var
   i:longint;
begin
   for i:=cost to v do
      f[i]:=f[i] or f[i-cost];
end;
procedure ZeroOnePack(cost:longint);
var
   i:longint;
begin
   if cost=0 then exit;
   for i:=v downto cost do
   begin
      f[i]:=f[i] or f[i-cost];
   end;
end;

procedure main;
var
   i,j,k,l,sum,p:longint;
begin
   v:=v div 2;
   for i:=1 to n do
   begin
      if i*a[i]>=v then
      begin
         CompletePack(i);
         continue;
      end;
      sum:=1;
      k:=0;
      while (a[i]-sum+1>0) do begin inc(k); sum:=sum*2; end;
      dec(k);
      sum:=1;
      for j:=0 to k-1 do
      begin
         ZeroOnePack(sum*i);
         sum:=sum*2;
      end;
      ZeroOnePack((a[i]-sum+1)*i);
      if f[v] then
      begin
         writeln('Can be divided.');
         exit;
      end;
   end;
   if not(f[v]) then writeln('Can''t be divided.')
   else writeln('Can be divided.')
end;
begin
   for i:=1 to n do read(a[i]);
   j:=1;
   while (a[1]+a[2]+a[3]+a[4]+a[5]+a[6]<>0) do
   begin
      writeln('Collection #',j,':');

      fillchar(f,sizeof(f),false);
      f[0]:=true;
      v:=0;
      for i:=1 to n do inc(v,i*a[i]);
      if (v mod 2=1) then writeln('Can''t be divided.')
      else
      begin
         main;
      end;

      writeln;
      for i:=1 to n do read(a[i]);
      inc(j);
   end;
end.

POJ上的重题还真多

Program P2593;
var
   n,i,j,m,m2,p:longint;
   a,b,c:array[0..100000] of longint;
begin
   read(n);
   a[0]:=-100001;
   while (n>0) do
   begin
      j:=0;
      m:=0;
      for i:=1 to n do
      begin
         read(a[i]);
         if a[i]<0 then inc(j);
         if a[i]>a[m] then m:=i;
      end;


      if j>n-2 then
      begin
         p:=a[m];
         m2:=0;
         for i:=1 to n do if (i<>m) and (a[m2]<a[i]) then m2:=i;
         inc(p,a[m2]);
         writeln(p);
      end
      else
      begin
         p:=0;
         m:=-100001;
         for i:=1 to n do
         begin
            inc(p,a[i]);
            if (p<0) then p:=0;
            if m<p then m:=p;
            b[i]:=m;
         end;
         p:=0;
         m:=-100001;
         for i:=n downto 1 do
         begin
            inc(p,a[i]);
            if (p<0) then p:=0;
            if m<p then m:=p;
            c[i]:=m;
         end;
         m:=0;
         for i:=1 to n-1 do
            if m<b[i]+c[i+1] then m:=b[i]+c[i+1];
         writeln(m);
      end;
      read(n);
   end;
end.

题目要求两段子序列和

分段就行 O(n)

话说这回数组又开小了，居然提示Runtime Error

Program P2479;
var
   t,n,i,j,m,m2,p:longint;
   a,b,c:array[0..50000] of longint;
begin
   read(t);
   a[0]:=-100001;
   while (t>0) do
   begin
      read(n);
      j:=0;
      m:=0;
      for i:=1 to n do
      begin
         read(a[i]);
         if a[i]<0 then inc(j);
         if a[i]>a[m] then m:=i;
      end;


      if j>n-2 then
      begin
         p:=a[m];
         m2:=0;
         for i:=1 to n do if (i<>m) and (a[m2]<a[i]) then m2:=i;
         inc(p,a[m2]);
         writeln(p);
      end
      else
      begin
         p:=0;
         m:=-100001;
         for i:=1 to n do
         begin
            inc(p,a[i]);
            if (p<0) then p:=0;
            if m<p then m:=p;
            b[i]:=m;
         end;
         p:=0;
         m:=-100001;
         for i:=n downto 1 do
         begin
            inc(p,a[i]);
            if (p<0) then p:=0;
            if m<p then m:=p;
            c[i]:=m;
         end;
         m:=0;
         for i:=1 to n-1 do
            if m<b[i]+c[i+1] then m:=b[i]+c[i+1];
         writeln(m);
      end;
      dec(t);
   end;
end.