Скачать программы    Все программы автора

КАЗИНО

 В верхнем левом углу прямоугольного поля размерами N´M размещается игральний кубик, разворот которого изображен на рисунке. Кубик ориентирован так, что передней грани соответствует единица, а слева находится грань, которой соответствует двойка. Клетки поля квадратные, их размеры совпадают с размерами грани кубика.

Кубик может двигаться по полю, переворачиваясь через одно из ребер, и попадать при этом в соседнюю снизу, сверху, справа или слева клетку поля. Например, если из начального состояния кубик двигается направо, то передней станет грань с двойкой, а если вниз — то с тройкой. Кубик не может выходить за пределы поля.

Задание

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

Входные данные

Первая строка входного файла CASINO.DAT содержит два натуральных числа N и M (2£N, M£50), которые определяют высоту и ширину поля соответственно. Далее задается поле, которое представлено N строками, каждая из которых состоит из M чисел, каждое из которых равно 0 либо 1. В случае, когда клетке поля соответствует число 1, кубику запрещено посещать данную клетку. В противном случае эта клетка может встречаться в пути кубика. Начальной клетке всегда соответствует число 0.

Выходные данные

Первая строка выходного файла CASINO.SOL должна содержать натуральное число W — длину найденого пути. Далее в файле должны находиться W строк, каждая из которых задает координату клетки поля на текущем шаге. Координата представляет собой пару натуральных чисел: номер строки и номер столбца клетки поля.

В случае, когда искомого пути не существует, выходной файл должен содержать строку с числом -1.

Пример входных и выходных данных

{ Problem: CASINO}

program casino;

const

MAX_N = 50; {maximum field size}

STATE_NUM = 24; {the number of possible brick positions}

FILE_IN = 'casino.dat';

FILE_OUT = 'casino.sol';

type

TDirection = (DIR_UP, DIR_RIGHT, DIR_DOWN, DIR_LEFT);

TState = byte; {1..STATE_NUM;}

TPosition = record

row : byte;

column : byte;

end;

TMarks = array[1..STATE_NUM] of boolean;

const

States : array[1..STATE_NUM, 1..2] of integer = (

{ 1} (1,2), { 2} (1,3), { 3} (1,4), { 4} (1,5),

{ 5} (2,1), { 6} (2,3), { 7} (2,4), { 8} (2,6),

{ 9} (3,1), {10} (3,2), {11} (3,5), {12} (3,6),

{13} (4,1), {14} (4,2), {15} (4,5), {16} (4,6),

{17} (5,1), {18} (5,3), {19} (5,4), {20} (5,6),

{21} (6,2), {22} (6,3), {23} (6,4), {24} (6,5));

Sides : array[1..6, 1..4] of integer = (

(2, 3, 5, 4),

(1, 4, 6, 3),

(1, 2, 6, 5),

(1, 5, 6, 2),

(1, 3, 6, 4),

(2, 4, 5, 3)

); 

type

TQueueElement = record

pos : TPosition;

state : TState;

prev : Word;

end;

PQueueElement = ^TQueueElement;

TVec = array[1..5] of TQueueElement;

TQueue = array[1..MAX_N*MAX_N*STATE_NUM div 5] of ^TVec;

var

n : Integer; {field height}

m : Integer; {field width}

field : array[1..MAX_N, 1..MAX_N] of Boolean;

waves : array[1..MAX_N, 1..MAX_N] of TMarks;

pqueue : ^TQueue;

qSize : Integer;

qCurr : Integer;

currSolId : integer;

solFound : Boolean;

{-------------------------------------------------------------}

{Dynamic init}

procedure DynInit;

var

i : integer;

begin

new(pqueue);

for i:=1 to MAX_N*MAX_N*STATE_NUM div 5 do

new(pqueue^[i]);

end;

{Dynamic dispose}

procedure DynDispose;

var

i : integer;

begin

for i:=1 to MAX_N*MAX_N*STATE_NUM div 5 do

Dispose(pqueue^[i]);

Dispose(pqueue);

end;

{Dynamic work}

procedure GetQueueElement(x : Word; var ppos : PQueueElement);

begin

ppos := @pqueue^[ ( (x-1) div 5 ) + 1 ]^[ ( (x-1) mod 5 ) + 1];

end;

{=============================================================}

procedure Init;

var

fin : Text;

i, j : Integer;

value : Integer;

begin

Assign(fin, FILE_IN);

Reset(fin);

ReadLn(fin, n, m);

FillChar(waves, sizeof(waves), false);

for i:=1 to n do

begin

for j:=1 to m do

begin

Read(fin, value);

if value = 0

then field[i,j]:=true

else field[i,j]:=false;

end;

end;

Close(fin);

solFound := false;

currSolId := 0;

DynInit;

end; 

function CanMove(pos : TPosition; dir : TDirection) : boolean;

begin

CanMove := false;

if (pos.row = 1) and (dir = DIR_UP) then exit;

if (pos.row = n) and (dir = DIR_DOWN) then exit;

if (pos.column = 1) and (dir = DIR_LEFT) then exit;

if (pos.column = m) and (dir = DIR_RIGHT) then exit;

if (dir = DIR_UP) and (not field[pos.row-1, pos.column]) then exit;

if (dir = DIR_DOWN) and (not field[pos.row+1, pos.column]) then exit;

if (dir = DIR_LEFT) and (not field[pos.row, pos.column-1]) then exit;

if (dir = DIR_RIGHT) and (not field[pos.row, pos.column+1]) then exit;

CanMove := true;

end;

procedure GetStateByPair(up, left : integer; var state : TState);

var

i : integer;

begin

for i:=1 to STATE_NUM do

if (States[i,1] = up) and (States[i,2] = left) then

begin

state := i;

exit;

end;

end;

function CubeSide(upper, side, many : integer) : integer;

var

i : integer;

begin

for i:=1 to 4 do

if Sides[upper, i] = side then

break;

if (i+many) mod 4 = 0

then CubeSide := Sides[upper, 4]

else CubeSide := Sides[upper, (i+many) mod 4];

end;

procedure MoveBrick(var state : TState; dir : TDirection);

var

up, left : integer;

nu, nl : integer;

begin

up := States[state, 1];

left := States[state, 2];

case dir of

DIR_UP :

begin

nl:=left;

nu:=CubeSide(left,up,1);

end;

DIR_RIGHT :

begin

nl:=CubeSide(left,up,2);

nu:=left;

end;

DIR_LEFT :

begin

nl:=up;

nu:=CubeSide(up,left,2);

end;

DIR_DOWN :

begin

nl:=left;

nu:=CubeSide(left,up,3);

end;

end;

GetStateByPair(nu, nl, state);

end;

procedure Move(var pos : TPosition; var state : TState; dir : TDirection);

begin

case dir of

DIR_UP : Dec(pos.row);

DIR_RIGHT : Inc(pos.column);

DIR_LEFT : Dec(pos.column);

DIR_DOWN : Inc(pos.row);

end;

MoveBrick(state, dir);

end;

procedure Run;

var

dir : TDirection;

pos, newPos : TPosition;

state, newState : TState;

pqe, pqe1, pqe2, pqe3 : PQueueElement;

begin

GetQueueElement(1, pqe);

pqe^.pos.row:=1;

pqe^.pos.column:=1;

pqe^.state:=1;

pqe^.prev:=0;

qSize:=1;

qCurr:=1;

waves[1,1][1] := true;

while ((qSize>=qCurr) and (not solFound)) do

begin

GetQueueElement(qCurr, pqe1);

pos := pqe1^.pos;

state := pqe1^.state;

for dir:=DIR_UP to DIR_LEFT do

if CanMove(pos, dir) then

begin

newPos := pos;

newState := state;

Move(newPos, newState, dir);

if not waves[newPos.row, newPos.column][newState] then

begin

{ Add the element to the queue }

Inc(qSize);

waves[newPos.row, newPos.column][newState] := true;

GetQueueElement(qSize, pqe2);

pqe2^.prev := qCurr;

pqe2^.pos := newPos;

pqe2^.state := newState;

end;

if (currSolId<>0) then

GetQueueElement(currSolId, pqe3);

if ((currSolId = 0) or (newState > pqe3^.state)) and

(newPos.row = n) and

(newPos.column = m) then

begin

currSolId := qSize;

if newState >= 21 then

begin

{ Solution has been found }

solFound := true;

exit;

end;

end;

end;

Inc(qCurr);

end;

if currSolId <> 0 then

solFound := true;

end;

procedure Done;

var

fout : Text;

number : integer;

prev, curr, next : integer;

i : integer;

pqe : PQueueElement;

begin

Assign(fout, FILE_OUT);

Rewrite(fout);

if not solFound then

WriteLn(fout, '-1')

else

begin

GetQueueElement(currSolId, pqe);

next := currSolId;

curr := pqe^.prev;

number := 0;

while curr <> 0 do

begin

inc (number);

GetQueueElement(curr, pqe);

prev := pqe^.prev;

pqe^.prev := next;

next := curr;

curr := prev;

end;

WriteLn(fout, number);

GetQueueElement(1, pqe);

curr:=pqe^.prev;

for i:=1 to number do

begin

GetQueueElement(curr, pqe);

WriteLn(fout, pqe^.pos.row, ' ', pqe^.pos.column);

curr := pqe^.prev;

end;

end;

Close(fout);

DynDispose;

end;

begin

Init;

Run;

Done;

end.