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 1016. Cube on the Walk

Here is my wrong program... well it seems pretty good for me but...
Posted by Costel::icerapper@k.ro 22 Feb 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.