NOIP2007提高组 矩阵取数 Pascal语言的程序

求NOIP2007提高组 矩阵取数 Pascal语言的程序 不需要高精度部分

不用高精度是不行的,不能够AC,因为就算QWORD也装不下.
【pascal程序给你了.带题解】
【题解】
显然取数的规则决定了他有最优子结构,即取了一个数后,剩下的又可以看成是规模更小的子问题
而且每一排的问题性质是一样的,我就单看一排
设f[I,j]是按规则计分的情况下从i到j这一段能取得的最大值,
则:f[I,j]=max
{a[I]*2+f[i+1,j]*2,
F[I,j-1]*2+a[j]*2}
初始值f[I,i]=a[i]*2
优化的时候可以把方程里面的2提出来,毕竟是高精度运算,能少算一点就少算一点,
【程序】
program game;
const mn=80;
nn=10000;
type nt=array [0..100] of longint;
ntt=^nt;
var a:array [1..mn,1..mn] of longint;
f:array [1..mn,1..mn,1..mn] of {longint}ntt;
n,m:integer;
procedure rd;
var i,j:integer;
begin
readln(n,m);
fillchar(a,sizeof(a),0);
for i:=1 to n do
begin
for j:=1 to m do read(a[i,j]);
readln;
end;
end;
procedure two(var a,b:nt);
var i,l:integer;
x:longint;
begin
l:=b[0];
fillchar(a,sizeof(a),0);
x:=0;
for i:=1 to l do
begin
x:=x+b[i]*2;
a[i]:=x mod nn;
x:=x div nn;
end;
if x>0 then begin inc(l); a[l]:=x end;
a[0]:=l;
end;
procedure plus1(var a,b:nt;t:longint);
var i:integer;
begin
a:=b;
inc(a[1],t);
i:=1;
for i:=1 to a[0] do
begin
inc(a[i+1],a[i] div nn);
a[i]:=a[i] mod nn;
end;
if a[i+1]0 then inc(a[0]);
end;
procedure plus2(var a,c:nt);
var l,i:integer;
begin
if a[0]>c[0] then l:=a[0] else l:=c[0];
for i:=1 to l do
begin
inc(a[i],c[i]);
inc(a[i+1],a[i] div nn);
a[i]:=a[i] mod nn;
end;
if a[l+1]0 then inc(l);
a[0]:=l;
end;
function ma(a,b:nt):integer;
var i:longint;
begin
if a[0]>b[0] then exit(1);
if a[0]1) and (a[i]=b[i]) do dec(i);
if a[i]>b[i] then exit(1) else exit(2);
end;
end;
procedure dp;
var d,tt,i,j,k:integer;
t:longint;
sum,t1,t2:nt;
procedure fill(var a:nt);
begin fillchar(a,sizeof(a),0); end;
begin
for i:=1 to n do
for j:=1 to m do
begin
new(f[i,j,j]);
fill(f[i,j,j]^);
f[i,j,j]^[0]:=1;
f[i,j,j]^[1]:=a[i,j]*2;
end;
for d:=1 to m-1 do
for i:=1 to m-d do
begin
j:=i+d;
for k:=1 to n do
begin
plus1(t1,f[k,i+1,j]^,a[k,i]);
plus1(t2,f[k,i,j-1]^,a[k,j]);
tt:=ma(t1,t2);
new(f[k,i,j]);
if tt=1 then two(f[k,i,j]^,t1)
else if tt=2 then two(f[k,i,j]^,t2);
end;
end;
fillchar(sum,sizeof(sum),0);
sum[0]:=1;
for i:=1 to n do
plus2(sum,f[i,1,m]^);
write(sum[sum[0]]);
for t:=sum[0]-1 downto 1 do
begin
write(sum[t] div 1000);
write(sum[t] div 100 mod 10);
write(sum[t] div 10 mod 10);
write(sum[t] mod 10);
end;
end;
begin
assign(input,'game.in');reset(input);
assign(output,'game.out');rewrite(output);
rd;
dp;
close(input); close(output);
end.
温馨提示:答案为网友推荐,仅供参考
第1个回答  2014-10-10
type st=array[0..30] of longint; var ans:st;f:array[1..80,1..80] of st;a:array[1..80] of longint; m,n:longint; procedure add(var x:st;y,z:st); var temp,i:longint; begin temp:=0; if y[0]>z[0] then x[0]:=y[0] else x[0]:=z[0]; for i:=1 to x[0] do begin temp:=y[i]+z[i]+temp; x[i]:=temp mod 10000; temp:=temp div 10000; end; if temp>0 then begin inc(x[0]); x[x[0]]:=temp;end; end; procedure mul(var x:st); var temp,i:longint; begin temp:=0; for i:=1 to x[0] do begin temp:=x[i]*2+temp; x[i]:=temp mod 10000; temp:=temp div 10000; end; while temp>0 do begin inc(x[0]);x[x[0]]:=temp mod 10000;temp:=temp div 10000;end; end; procedure plus(var x:st;y:st;z:longint); var i:longint; begin x:=y;inc(x[1],z);i:=1; while x[i]>=10000 do begin x[i+1]:=x[i] div 10000+x[i+1]; x[i]:=x[i] mod 10000; inc(i); if x[0]<i then x[0]:=i; end; end; function compare(a,b:st):boolean; var i:longint; begin if a[0]>b[0] then exit(true); if a[0]<b[0] then exit(false); for i:=a[0] downto 1 do if a[i]>b[i] then exit(true) else if a[i]<b[i] then exit(false); exit(false); end; procedure dp; var i,j:longint;max,min:st; begin fillchar(f,sizeof(f),0); for i:=1 to m do begin f[i,i][0]:=1;f[i,i][1]:=a[i]*2;end; for i:=m-1 downto 1 do for j:=i+1 to m do begin plus(max,f[i+1,j],a[i]); mul(max); plus(min,f[i,j-1],a[j]); mul(min); if compare(min,max) then max:=min; f[i,j]:=max; end; add(ans,ans,f[1,m]); end; procedure re; var i,j:longint; begin readln(n,m); for i:=1 to n do begin for j:=1 to m do read(a[j]); readln; dp; end; end; procedure print; var i:longint; begin write(ans[ans[0]]); for i:=ans[0]-1 downto 1 do begin write(ans[i] div 1000 mod 10); write(ans[i] div 100 mod 10); write(ans[i] div 10 mod 10); write(ans[i] mod 10); end; end; begin re;print; end. 高精度也给粘上了,不高兴删了,dp的问题,将就着看吧本回答被提问者采纳