Strange!!! when n<=15 my program always right but when n=16 than answers a little large than right answer
when n<=15 my program always right but when n=16 than answers a little large than right answer
here is my program
const
space:array[1..4,1..4]of word=((1,2,4,8),($10,$20,$40,$80),
($100,$200,$400,$800),($1000,$2000,$4000,$8000));
var food:array [0..16,1..4,1..4] of byte;
down:array [0..16,1..4,1..4] of boolean;
f,been:array [0..16,1..4,1..4,0..256] of word;
opt,found:array [0..16,1..4,1..4,1..4,1..4,0..16] of word;
path:array [0..65536] of word;
d:array [0..16] of string[16];
n,x,y:byte;
procedure init;
var i,j,k,temp:integer;
begin
fillchar(food,sizeof(food),0);
readln(n);
for i:=n downto 1 do begin
for j:=1 to 4 do for k:=1 to 4 do read(food[i,j,k]);
for j:=1 to 4 do for k:=1 to 4 do begin
read(temp);
if (temp=1) or (i=1) then down[i,j,k]:=true else down[i,j,k]:=false;
end;
end;
readln(x,y);
end;
procedure search(floor,sx,sy,nx,ny,long:byte;get,hash:word);
begin
hash:=hash or space[nx,ny];
if path[hash] and space[nx,ny]>0 then exit;
path[hash]:=path[hash] or space[nx,ny];
get:=get+food[floor,nx,ny];
if (opt[floor,sx,sy,nx,ny,long]=65535) or (get>opt[floor,sx,sy,nx,ny,long]) then begin
opt[floor,sx,sy,nx,ny,long]:=get;found[floor,sx,sy,nx,ny,long]:=hash;
end;
if (nx<4) and (hash and space[nx+1,ny]=0) then search(floor,sx,sy,nx+1,ny,long+1,get,hash);
if (nx>1) and (hash and space[nx-1,ny]=0) then search(floor,sx,sy,nx-1,ny,long+1,get,hash);
if (ny<4) and (hash and space[nx,ny+1]=0) then search(floor,sx,sy,nx,ny+1,long+1,get,hash);
if (ny>1) and (hash and space[nx,ny-1]=0) then search(floor,sx,sy,nx,ny-1,long+1,get,hash);
end;
procedure prepar;
var i,sx,sy,nx,ny,s:integer;
begin
fillchar(opt,sizeof(opt),0);fillchar(found,sizeof(found),0);
for i:=0 to n do for sx:=1 to 4 do for sy:=1 to 4 do for s:=0 to 256 do f[i,sx,sy,s]:=65535;
for i:=1 to n do
for sx:=1 to 4 do for sy:=1 to 4 do begin
fillchar(path,sizeof(path),0);
for nx:=1 to 4 do for ny:=1 to 4 do for s:=0 to 15 do opt[i,sx,sy,nx,ny,s]:=65535;
search(i,sx,sy,sx,sy,0,0,0);
end;
end;
procedure solve;
var i,sx,sy,nx,ny,step,k,s:longint;
begin
fillchar(f,sizeof(f),0);fillchar(been,sizeof(been),0);
for sx:=1 to 4 do for sy:=1 to 4 do for s:=0 to 15 do f[n,sx,sy,s]:=opt[n,x,y,sx,sy,s];
for i:=n-1 downto 0 do
for sx:=1 to 4 do for sy:=1 to 4 do if down[i+1,sx,sy] then
for nx:=1 to 4 do for ny:=1 to 4 do
for k:=0 to 15 do if opt[i,sx,sy,nx,ny,k]<65535 then
for step:=1+k to 16*(n-i)+k do begin
s:=f[i+1,sx,sy,step-k-1]+opt[i,sx,sy,nx,ny,k];
if (f[i+1,sx,sy,step-k-1]<65535) and ((s>f[i,nx,ny,step]) or (f[i,nx,ny,step]=65535)) then begin
f[i,nx,ny,step]:=s;
been[i,nx,ny,step]:=sx*1000+sy*100+k;
end;
end;
end;
function find(floor,sx,sy,nx,ny,long:byte):string[16];
var s:word;
begin
s:=found[floor,sx,sy,nx,ny,long];
if (sx=nx) and (sy=ny) and (long=0) then find:=''
else begin
if (sx<4) and (s and space[sx+1,sy]>0) then find:='S'+find(floor,sx+1,sy,nx,ny,long-1);
if (sy<4) and (s and space[sx,sy+1]>0) then find:='E'+find(floor,sx,sy+1,nx,ny,long-1);
if (sx>1) and (s and space[sx-1,sy]>0) then find:='N'+find(floor,sx-1,sy,nx,ny,long-1);
if (sy>1) and (s and space[sx,sy-1]>0) then find:='W'+find(floor,sx,sy-1,nx,ny,long-1);
end;
end;
procedure print;
var max:real;
step,ans_step,i,s,c,sx,sy,nx,ny:longint;
begin
max:=0;
for step:=n to 16*n do
if f[0,1,1,step]/step>max then begin max:=f[0,1,1,step]/step;ans_step:=step;end;
writeln(max:0:4);
writeln(ans_step-1);
step:=ans_step;
s:=been[0,1,1,step];
sx:=1;sy:=1;
c:=s mod 100;s:=s div 100;ny:=s mod 10;nx:=s div 10;
for i:=0 to n-1 do begin
if i>0 then d[i]:=find(i,nx,ny,sx,sy,c);
step:=step-c-1;
sx:=nx;sy:=ny;
s:=been[i+1,sx,sy,step];
c:=s mod 100;s:=s div 100;ny:=s mod 10;nx:=s div 10;
end;
d[n]:=find(n,x,y,sx,sy,step);
for i:=n downto 2 do write(d[i],'D');
writeln(d[1]);
end;
begin
init;
prepar;
solve;
print;
end.