ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1171. Lost in Space

Strange!!! when n<=15 my program always right but when n=16 than answers a little large than right answer
Послано 8848mzy 6 май 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.