Программистское безумие !Ни тебе списков, ни тебе бакфортов.
Вообще даже переменных никаких нет ! Ни одной !Все шахматные позиции хранятся на стеке, упакованные в ячейку.
Одна ячейка - одна позиция. Содержимое стека - история игры !
На самом дне стека лежит ноль. Стек хранит промежуточные позиции
в игре. А на верху стека важны два элемента. Второй сверху - это
позиция в которой мы играем. А на самой вершине стека - позиция,
в которую ведет ход, который мы уже рассмотрели.
Позиция кодируется так. Под одну клетку доски отводится два бита.
00 - пустая, 01 - черные, 02 - белые. Итого 24 бита.
Самые старшие 8 бит ячейки это индексы циклов I,J при которых
мы эту позицию рассматривали (по 4 бита на индекс). Поэтому все
еще нерассмотренные позиции по отношению к данной будут,
как число, беззнаково больше, чем рассмотренные. В результате
простым беззнаковым сравнением можно отделить все рассмотренные
позиции на данном ходу от нерассмотренных. Чтобы не повторить позицию,
встречавшуюся уже на предыдущих ходах просматривается стек на всю
глубину с помощью PICK пока не встретится ноль, который помечает дно стека.
Если найден ход, то на стек просто кладется ноль (новая позиция
становаится текущей и такой, в которой еще ни один ход не разобран).
Если все ходы в текущей позиции разобраны, возможных ходов больше
нет или все они ведут к тем позициям, что уже были раньше, то со
стека отбрасывается верхний элемент. Происходит откат на ход и
проверяются еще нерассмотренные варианты на данном ходу.
Короче говоря, программа работает и даже мгновенно находит три решения
(в 94, 98 и 210 ходов), а потом погрязает в долгих вычислениях и
мне таки было лень дожидаться конца рассчетов. Но досчитает, ни куда
не денется.
Программа написана только CORE-овыми словами. Никаких либ не требует.
Выводит решения в наглядном виде - в виде шахматных досок со сменяющимися
позициями. Алгоритмы в ней - сплошной вынос мозга ;-)
Код:
CREATE BOARD \ Доска
2 C, 2 C, 2 C, \ 2 - белые
0 C, 0 C, 0 C, \ 0 - пусто
0 C, 0 C, 0 C,
1 C, 1 C, 1 C, \ 1 - черные
HEX
: WB DEPTH 1 AND 1+ ; ( -- x ) \ Вовращает: 2 - ход белых, 1 - ход черных
: HORSE? ( i j -- flag ) \ Возвращает TRUE если ход i->j есть ход конем
OVER 3 MOD OVER 3 MOD - ABS ROT 3 / ROT 3 / - ABS * 2 =
;
: PACK ( -- x ) \ Упаковка позиции с доски
0 C 0 DO 2* 2* BOARD I + C@ 3 AND + LOOP
;
: UNPACK ( x -- ) \ Распаковка позиции на доску
0 B DO DUP 3 AND BOARD I + C! 2/ 2/ TRUE +LOOP DROP
WB 3 XOR C 0 DO \ Цикл заполняет 4-ками позиции под боем на данном ходу
DUP BOARD I + C@ =
IF
C 0 DO
BOARD I + C@ 0= IF J I HORSE? IF 4 BOARD I + C! THEN THEN
LOOP
THEN
LOOP DROP
;
: TURN ( -- ) \ Найден новый ход - THROW ,не найден и нужен откат - EXIT
WB C 0 DO
DUP BOARD I + C@ =
IF
C 0 DO
BOARD I + C@ 0=
IF
J I HORSE?
IF
0 BOARD J + C! DUP BOARD I + C!
PACK J 1C LSHIFT + I 18 LSHIFT + SWAP >R 2DUP U<
IF
NIP PACK 54002A =
IF
." Solution in " DEPTH 2 - DECIMAL . ." turns :" CR CR 4 BASE !
0 DEPTH 3 - DO
I PICK 0 <# # # # A HOLD D HOLD # # # A HOLD
D HOLD # # # A HOLD D HOLD # # # #> TYPE CR CR
TRUE +LOOP
ELSE
2 BEGIN
1+ 2DUP PICK DUP 0= THROW XOR FFFFFF AND 0=
UNTIL DROP
THEN
ELSE DROP
THEN
OVER UNPACK R>
THEN
THEN
LOOP
THEN
LOOP DROP
;
: MAIN
BEGIN
OVER
WHILE
OVER UNPACK
['] TURN CATCH IF 0 ELSE DROP THEN
REPEAT
\ 2DROP DECIMAL \ Вернем контекст к исходному виду, если нужно
;
0 PACK 0 MAIN BYE