Описание
На шахматной доске стоит кубик, занимая своим основанием в точности одно из полей доски. На его гранях написаны неотрицательные целые числа, не превосходящие 1000. Кубик можно перемещать на смежные поля, перекатывая через соответствующее ребро в основании. При движении кубика вычисляется сумма чисел, попавших в его основание (каждое число считается столько раз, сколько раз кубик оказывался лежащим на данной грани)

Задание
Требуется найти такой путь движения кубика между двумя заданными полями доски, при котором вычисленная сумма будет минимальной. Числа, стоящие в основании кубика в начальной и конечной позициях, также входят в сумму


Входные данные
Во входном файле через пробел записаны координаты начального и конечного полей и 6 чисел, написанных на передней (в начальный момент), задней, верхней, правой, нижней и левой гранях кубика соответственно. Координаты полей указываются в стандартной шахматной нотации (см. пример). Начальное и конечное поля различны

Выходные данные
Выведите в выходной файл минимально возможную сумму и соответствующий ей путь. Путь должен быть задан последовательным перечислением координат полей, по которым движется кубик (включая начальное и конечное поля). Координаты полей записываются в том же формате, что и во входных данных, и разделяются пробелом


Например:

ROLLCUBE.IN
е2 e3 0 8 1 2 1 1

ROLLCUBE.OUT
5 е2 d2 d1 e1 е2 e3




Идеи
Построение перечислителя, кратчайший путь в графе

Комментарии
Состояние кубика на доске определяется полем, на котором стоит кубик, и номерами граней, служащих ему в данный момент основанием и передней (ближней к нам) гранью. Построим граф, вершины которого будут соответствовать возможным состояниям кубика, а ребра - допустимым переходам между ними (эти переходы определяются перекатыванием кубика через одно из ребер в основании). Каждому ребру (а,b) полученного графа припишем вес, равный числу, находящемуся на основании кубика в состоянии а. Теперь можно воспользоваться алгоритмом Дейкстры [Липский 88, п.3.3] для нахождения кратчайших путей из начальной вершины в вершины, соответствующие расположению кубика на конечном поле




Решение

{$A+,B-,D+,E+,F-,G-,I-,L+,N+,O-,P-,Q+,R+,S+,T-,V+,X+,Y+}
{$M 65520,0,655360}

program rollcube;
uses Crt;
type Cub=record back,forw,left,right,up,down:INteger;End;
type pos=record a:char;b:Byte;End;
type spos=record a:char;b:byte;c:cub;End;
var i,j,k:INteger;
origCb,cc,cb:cub;
cur:INteger;
n:Integer;
result: array [1..24] of array ['a'..'h',1..8] of Integer;
prev  : array [1..24] of array ['a'..'h',1..8] of Spos;
scObr : array [1..24] of Cub;
res   : Text;
Ok    : array [1..24] of array ['a'..'h',1..8] of Boolean;
start,finish:Pos;

Function Eq(a,b:cub):Boolean;
Begin
 eq:=false;
 if a.up<>b.up Then Exit;
 if a.left<>b.left Then Exit;
 if a.right<>b.right Then Exit;
 if a.down<>b.down Then Exit;
 if a.back<>b.back Then Exit;
 if a.forw<>b.forw Then Exit;
 eq:=true;
End;

Function SearchFor(nm:Cub):Integer;
Var i:Integer;
Begin
 For i:=1 to 24 do
  Begin
   if eq(ScObr[i],nm) Then Begin searchFor:=i;Exit;End;
  End;
End;

Procedure RestoreWay(n:INteger;p:Pos);
Var way:array [1..64] of Spos;
cur:INteger;
i:Integer;
fn:INteger;
Begin
 way[1].a:=p.a;way[1].b:=p.b;way[1].c:=scobr[n];cur:=1;
 fn:=searchFor(OrIgcb);
 repeat
  Inc(cur);
  way[cur]:=prev[SearchFor(way[cur-1].c)][way[cur-1].a,way[cur-1].b]
 until (way[cur].a=start.a) and (way[cur].b=start.b) and (Eq(way[cur].c,origCb));
 For i:=cur downto 1 do
  Begin
   WRite(res,way[i].a,way[i].b,' ');
  End;
 WRiteln(res);
End;

Function MoveLeft(Var C:cub):Integer;
Var n:cub;
Begin
 n:=c;
 n.down:=c.left;n.left:=c.up;n.up:=c.right;n.right:=c.down;
 c:=n;
 MoveLeft:=n.down;
End;

Function MoveRight(Var C:cub):Integer;
Var n:cub;
Begin
n:=c;
 n.down:=c.right;n.right:=c.up;n.up:=c.left;n.left:=c.down;
 c:=n;
 Moveright:=n.down;
End;

Function MoveForw(Var C:cub):Integer;
Var n:cub;
Begin
n:=c;
 n.down:=c.forw;n.forw:=c.up;n.up:=c.back;n.back:=c.down;
 c:=n;
 MoveForw:=n.down;
End;

Function MoveBack(Var C:cub):Integer;
Var n:cub;
Begin
n:=c;
 n.down:=c.back;n.back:=c.up;n.up:=c.forw;n.forw:=c.down;
 c:=n;
 MoveBack:=n.down;
End;

Procedure ToPos(Var f:sPos;a:char;b:Byte;c:Cub);
Begin
f.a:=a;f.b:=b;f.c:=c;
End;
 
Procedure rescan(jm:byte;l:Char;d:Byte);
Var s:Integer;
dd:Integer;
cb:Cub;
orc:cub;
p:Char;
nm:INteger;
Begin
 s:=result[jm][l][d];cb:=ScObr[jm];orc:=cb;
 if l>'a' Then
  Begin
   dd:=s+moveleft(cb);
   nm:=searchFor(cb);
   p:=pred(l);
   if ddThen
    Begin result[nm][p,d]:=dd; ToPos(prev[nm][p,d],l,d,orc);end;
   cb:=SCObr[jm];
  End;
 if l<'h' Then
  Begin
   dd:=s+moveright(cb);
    nm:=searchFor(cb);
   p:=Succ(l);
   if ddThen
    Begin result[nm][p,d]:=dd;ToPos(prev[nm][p,d],l,d,orc);end;
   cb:=ScObr[jm];
  End;
 if d<8 Then
  Begin
   dd:=s+moveBack(cb);
   nm:=searchFor(cb);
   if ddThen
    Begin result[nm][l,d+1]:=dd;ToPos(prev[nm][l,d+1],l,d,orc);end;
   cb:=ScObr[jm];
  End;
 if d>1 Then
  Begin
   dd:=s+moveForw(cb);
    nm:=searchFor(cb);
   if ddThen
    Begin result[nm][l,d-1]:=dd;ToPos(prev[nm][l,d-1],l,d,orc);end;
   cb:=ScObr[jm];
  End;
End;

Var t:Integer;

Function Solve(c:Cub;s,f:Pos):INteger;
Var chm,ch:Char;
i,im:Integer;
jm,j:Integer;
min:Integer;
t:INteger;
Function Exist:Boolean;
Var i:INteger;
Begin
 for i:=1 to 24 do
  Begin
   if ok[i][f.a,f.b] Then Begin Exist:=true;t:=i;Exit;End;
  End;
 Exist:=false;
End;

Begin
 repeat
  Min:=32000;
  For j:=1 to 24 do
  For ch:='a' to 'h' do
   For i:=1 to 8 do
    Begin
     if (result[j][ch][i]and (not ok[j][ch][i]) Then
      Begin jm:=j;im:=i;chm:=ch;Min:=result[j][ch,i];End;
    End;
  ok[jm][chm][im]:=true;
  rescan(jm,chm,im);
 until Exist;
 solve:=t;
End;

Var s:string[3];
ch:char;

Begin
 Assign(input,'rollcube.in');
 Reset(input);
 Assign(res,'rollcube.out');Rewrite(res);Close(res);
 {на передней грани, далее - на задней, верхней,
  правой, нижней и левой гранях соответстсвенно}
 n := 1;
 For i:=1 to n do
  Begin
   Read(s);
   start.a:=s[1];start.b:=byte(s[2])-48;
   Read(s);
   finish.a:=s[1];Finish.b:=byte(s[2])-48;
   With cb do readln(forw,back,up,right,down,left);
   For k:=1 to 24 do
   For ch:='a' to 'h' do
    for j:=1 to 8 do Begin ok[k][ch][j]:=false;result[k][ch,j]:=32000;End;
   cc:=cb;Cur:=1;origCb:=cb;
   For k:=1 to 4 do
    Begin
      For j:=1 to 4 do
       Begin
        scobr[cur]:=cc;Inc(cur);
        MoveLeft(cc);
       End;
      MoveForw(cc);
    End;
   cc:=cb;
   MoveRight(cc);MoveForw(cc);
   For j:=1 to 4 do
    Begin
      scobr[cur]:=cc;Inc(cur);
      MoveLeft(cc);
    End;
   MoveBack(cc);MoveBack(cc);
   For j:=1 to 4 do
    Begin
      scobr[cur]:=cc;Inc(cur);
      MoveLeft(cc);
    End;
   t:=searchFor(cb);
   with start do
    Begin result[t][a,b]:=cb.down;End;
   t:=Solve(cb,start,finish);
   Append(res);
   Write(res,result[t][finish.a][finish.b],' ');
   RestoreWay(t,finish);
   Close(res);
  End;
End.

 

© Особенности национальных задач по информатике