ENG  RUSTimus Online Judge
Online Judge
Problems
Authors
Online contests
About Online Judge
Frequently asked questions
Site news
Webboard
Links
Problem set
Submit solution
Judge status
Guide
Register
Update your info
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

Discussion of Problem 1171. Lost in Space

Strange!!! when n<=15 my program always right but when n=16 than answers a little large than right answer
Posted by 8848mzy 6 May 2005 11:32
  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.