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

Обсуждение задачи 1016. Кубик на прогулке

Here is my wrong program... well it seems pretty good for me but...
Послано Costel::icerapper@k.ro 22 фев 2002 19:40
program timus1016;
const
  maxnway=200;
  FW=1;
  BW=2;
  TOP=3;
  RIGHT=4;
  BOTTOM=5;
  LEFT=6;
type
  ts8=string[8];
  tfaces=array[1..6]of word; {FW,BW,TOP,RIGHT,BOTTOM,LEFT}
  moves=array[1..4]of shortint;
  tmoves=array[1..4]of tfaces;
  tsfaces=array[1..6]of string;
const
  sfaces:tsfaces=('FW','BW','TOP','RIGHT','BOTTOM','LEFT');
  l:ts8=('abcdefgh');
  tx:moves=(-1,+1, 0, 0); {1-left 2-right}
  ty:moves=( 0, 0,-1,+1); {3-fw   4-bw}
  rotates:tmoves=
  ((FW,BW,RIGHT,BOTTOM,LEFT,TOP), {left}
   (FW,BW,LEFT,TOP,RIGHT,BOTTOM), {right}
   (TOP,BOTTOM,BW,RIGHT,FW,LEFT), {fw}
   (BOTTOM,TOP,FW,RIGHT,BW,LEFT));{bw}
type
  list=^art;
  art=record
            urm,pred:list;
            cost:longint;
            poz:byte;
            faces:tfaces;
            nway:longint;
      end;
var
  startpoz,endpoz:byte;
  startface:tfaces;
  head,tale:list;
  added:longint;

procedure write_poz(pozz:byte);forward;

function GetOneCoord:byte;
var
  c:char;
  x:byte;
begin
  read(c);read(x);
  GetOneCoord:=(pos(c,l)-1)*8+x-1;
  read(c);
end;

procedure GetOneFace(var f:tfaces);
var
  i:byte;
begin
  for i:=1 to 6 do
    read(f[i]);
end;

procedure read_data;
begin
  startpoz:=GetOneCoord;
  endpoz:=GetOneCoord;
  GetOneFace(startface);
  readln;
end;

function GetManhattan(p1,p2:byte):byte;
var
  x1,y1,x2,y2:byte;
begin
  x1:=p1 div 8; y1:=p1 mod 8;
  x2:=p2 div 8; y2:=p2 mod 8;
  GetManhattan:=abs(x1-x2)+abs(y1-y2);
end;

procedure init_data;
begin
  added:=0;
  new(head);
  head^.faces:=startface;
  head^.nway:=1;
  head^.poz:=startpoz;
  head^.cost:=startface[bottom]+1;
  head^.urm:=nil;
  head^.pred:=nil;
  tale:=head;
end;

function headpoz:byte;
begin
  headpoz:=head^.poz;
end;

function Inside(x,y:byte):boolean;
begin
  Inside:=(x>0)and(x<9)and(y>0)and(y<9);
end;

procedure RotateFace(var f:tfaces;k:byte);
var
  f2:tfaces;
  i:byte;
begin
  for i:=1 to 6 do
    f2[i]:=f[rotates[k,i]];
  f:=f2;
end;

procedure AddNode(var p:list);
var
  u,t:list;
begin
  u:=head; t:=u^.urm;
  while (t<>nil) and (p^.cost>t^.cost) do
  begin
    u:=t;
    t:=t^.urm;
  end;
  u^.urm:=p;
  p^.urm:=t;
  p^.pred:=head;
end;

procedure RotateDice(i:byte); {i is the index of rotation}
var
  p:list;
  f:tfaces;
  x,y:byte;
  ii:byte;
begin
  if (head^.nway+1)>maxnway then
    exit;
  new(p);
  p^.nway:=head^.nway+1;
  p^.poz:=head^.poz+(tx[i]*8)+ty[i];
  f:=head^.faces;
  RotateFace(f,i);
  p^.faces:=f;
  p^.cost:=head^.cost+p^.faces[bottom]+1;
  AddNode(p);
{
      inc(added);
      writeln('A ',added,'-a adaugare');
      write('POZ=  '); write_poz(p^.poz);writeln;
      for ii:=1 to 6 do
        write(sfaces[ii],' = ',p^.faces[ii],'   ');
      writeln;
      writeln('COST= ',p^.cost);
}
end;

procedure ExpandHead;
var
  i:byte;
  pozz:byte;
  x,y:byte;
begin
  pozz:=headpoz;
  x:=(pozz div 8) + 1;
  y:=(pozz mod 8) + 1;
  for i:=1 to 4 do {the for different types of move}
    if Inside(x+tx[i],y+ty[i]) then
      RotateDice(i);
end;

procedure solve__it;
begin
  while (head^.poz<>endpoz) do
  begin
    ExpandHead;
    head:=head^.urm;
  end;
end;

procedure write_poz(pozz:byte);
var
  x,y:byte;
  c:char;
begin
  x:=(pozz div 8) + 1;
  y:=(pozz mod 8) + 1;
  c:=chr(x-1+ord('a'));
  write(c);
  write(y);
  write(' ');
end;

procedure write_nodes(p:list);
begin
  if p=nil then
    exit;
  write_nodes(p^.pred);
  write_poz(p^.poz);
end;

procedure write_sol;
begin
  write(head^.cost-head^.nway,' ');
  write_nodes(head);
  writeln;
end;

begin
  read_data;
  init_data;
  solve__it;
  write_sol;
end.