Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Сб июл 21, 2018 13:59

...
Google Search
Forth-FAQ Spy Grafic

Часовой пояс: UTC + 3 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ Сообщений: 58 ]  На страницу Пред.  1, 2, 3, 4  След.
Автор Сообщение
 Заголовок сообщения:
СообщениеДобавлено: Пт май 18, 2007 15:10 
Всё таки дорешил (бэкфорт, само собой):
Код:
\ К конкурсу решения задач на форте (http://fforum.winglion.ru/viewtopic.php?p=7491#7491)

\ Задача о шести шахматных конях

\ Для запуска нужен дистрибутив SPF:
\ http://sourceforge.net/project/showfiles.php?group_id=17919

\ И апрельское обновление:
\ http://sourceforge.net/project/shownotes.php?release_id=497972&group_id=17919


REQUIRE HEAP-COPY ~ac/lib/ns/heap-copy.f
REQUIRE (:    ~yz/lib/inline.f
REQUIRE PRO   ~profit/lib/bac4th.f
REQUIRE __    ~profit/lib/cellfield.f
REQUIRE LOCAL ~profit/lib/static.f
REQUIRE ENUM  ~nn/lib/enum.f
REQUIRE seq{  ~profit/lib/bac4th-sequence.f
REQUIRE NOT   ~profit/lib/logic.f
REQUIRE iterateByCellValues ~profit/lib/bac4th-iterators.f
REQUIRE list+ ~pinka\lib\list.f


3 CONSTANT W \ ширина поля
4 CONSTANT H \ высота поля

50 CONSTANT MAX-MOVES \ максимальное кол-во ходов в переборе

: list=> ( list --> value \ <-- ) R> SWAP List-ForEach ; \ итератор по списку

\ Структура списка
0
__ board-link
__ board-addr
__ board-moves
CONSTANT board-elem

\ Откатываемое двойное присваивание
: 2B! ( d addr --> \ <-- ) PRO SWAP OVER B! CELL+ B! CONT ;

\ массив который хранит указатели на представление позиций для ходов
CREATE LAST-BOARDS MAX-MOVES CELLS ALLOT

W CONSTANT HORSES \ сколько коней у белых и у чёрных

CREATE STABLES \ значения текущих положений
HORSES 2 CELLS * ALLOT \ white horses
HORSES 2 CELLS * ALLOT \ black horses

: HORSE ( i -- x y ) 2 CELLS * STABLES + ;
: WHITE ( i -- i )  ;
: BLACK ( i -- i' ) HORSES + ;

: WHITE-HORSES ( --> i \ <-- i ) PRO \ белые лошадки
HORSES 0 DO I WHITE CONT DROP LOOP ;

: BLACK-HORSES ( --> i \ <-- i ) PRO \ чёрные лошадки
HORSES 0 DO I BLACK CONT DROP LOOP ;

: WCOORD (  --> x  \  <-- x )  PRO W 1+ 1 DO  I CONT DROP  LOOP ; \ пробег по горизонтали
: HCOORD (  --> y  \  <-- y )  PRO H 1+ 1 DO  I CONT DROP  LOOP ; \ пробег по вертикали

: BOARD ( --> y x \ <-- y x ) PRO HCOORD WCOORD CONT ; \ пробег по всей доске
\ требует "чистого" стека у WCOORD и HCOORD чтобы выдавать два числа

\ фильтр, пропускает только те значения координат которые могут составлять ход конём
: ?HORSE-MOVE ( x1 y1 y2 x2 <--> x1 y1 y2 x2 ) PRO
2OVER 2OVER
ROT - ABS  -ROT - ABS
*> 2RESTB <*> SWAP <*   1 2 D= ONTRUE CONT ;

\ генерировать все возможные ходы конём из координат x y
: HORSE-MOVES ( x y --> u v \ <-- u v ) PRO 2DROPB WCOORD HCOORD ( x y ) ?HORSE-MOVE CONT ;

\ занято белой лошадкой?
: ?IS-WHITE-HERE ( x y --> x y \ <-- x y ) PRO
LOCAL x  LOCAL y
2DUP y ! x !
S| CUT: WHITE-HORSES DUP HORSE 2@ x @ y @ D= ONTRUE -CUT CONT ;

\ занято чёрной лошадкой?
: ?IS-BLACK-HERE ( x y --> x y \ <-- x y ) PRO
LOCAL x  LOCAL y
2DUP y ! x !
S| CUT: BLACK-HORSES DUP HORSE 2@ x @ y @ D= ONTRUE -CUT CONT ;

\ занято ли вообще?
: ?CAN-MOVE-HERE ( x y --> x y \ <-- x y ) PRO S|
NOT: ?IS-WHITE-HERE -NOT \ НЕТ БЕЛЫХ лошадок в позиции x y
                         \ И
NOT: ?IS-BLACK-HERE -NOT \ НЕТ ЧЁРНЫХ лошадок в позиции x y
CONT ;

\ атаковано белым конём?
: ?IS-ATTACKED-BY-WHITE ( x y --> x y \ <-- x y ) PRO
LOCAL x  LOCAL y
2DUP y ! x !
S| CUT: WHITE-HORSES DUP HORSE 2@ x @ y @ 2DROPB ?HORSE-MOVE -CUT CONT ;

\ атаковано чёрным конём?
: ?IS-ATTACKED-BY-BLACK ( x y --> x y \ <-- x y ) PRO
LOCAL x  LOCAL y
2DUP y ! x !
S| CUT: BLACK-HORSES DUP HORSE 2@ x @ y @ 2DROPB ?HORSE-MOVE -CUT CONT ;

\ белый конь может пойти туда?
: ?CAN-WHITE-MOVE-HERE PRO
?CAN-MOVE-HERE
S| NOT: ?IS-ATTACKED-BY-BLACK -NOT CONT ;

\ чёрный конь может пойти туда?
: ?CAN-BLACK-MOVE-HERE PRO
?CAN-MOVE-HERE
S| NOT: ?IS-ATTACKED-BY-WHITE -NOT CONT ;

\ двинуть белого коня под номером i
: MOVE-WHITE-HORSE ( i --> \ <-- i ) PRO LOCAL h DUP
HORSE DUP h ! 2@ HORSE-MOVES ( x y )
?CAN-WHITE-MOVE-HERE  2DUP h @ 2B! CONT ;

\ двинуть чёрного коня под номером i
: MOVE-BLACK-HORSE ( i --> \ <-- i ) PRO LOCAL h DUP
HORSE DUP h ! 2@ HORSE-MOVES ( x y )
?CAN-BLACK-MOVE-HERE  2DUP h @ 2B! CONT ;

\ расставить коней по начальным стойлам
: INIT-POS
LOCAL i

i 0!
START{
WHITE-HORSES
i 1+! i @ OVER 1 SWAP HORSE 2!
}EMERGE

i 0!
START{
BLACK-HORSES
i 1+! i @ OVER H SWAP HORSE 2!
}EMERGE ;

\ выдать участок памяти куда записано представление текущей позиции доски
: DRAW-BOARD  ( --> addr u \ <-- )
PRO arr{ \ начинаем генерировать массив
BOARD ( y x ) 2DUP 2DROPB SWAP
S| PREDICATE ?IS-WHITE-HERE SUCCEEDS \ если белая лошадка
IF [CHAR] @ ELSE
S| PREDICATE ?IS-BLACK-HERE SUCCEEDS \ если чёрная лошадка
IF [CHAR] # ELSE
   BL       THEN THEN                \ если нету ничего
}arr CONT ;

: PRINT-BOARD ( addr u -- ) \ распечатать представление позиции доски

(: CR ."    " WCOORD DUP . SPACE ;)
BACK EXECUTE TRACKING RESTB EXECUTE
(: CR ."   -" WCOORD ." ---" ;)
BACK EXECUTE TRACKING RESTB EXECUTE

LOCAL i  i 0!
CELL / iterateByCellValues
i @ W /MOD SWAP 0= IF CR [CHAR] A + EMIT ."  |" ELSE DROP THEN
i 1+! DUP EMIT ."  |" ;

: SHOW-BOARD ( -- ) DRAW-BOARD PRINT-BOARD ;

INIT-POS ( 1 c   1 BLACK HORSE 2! ) \ SHOW-BOARD \EOF
\ DRAW-BOARD DUMP

\ Эти 2 определения равнозначны

: ?ARE-WE-DONE-YET ( -- f ) \ суммирующее определение
&{ BLACK-HORSES DUP HORSE 2@ ( x y ) NIP 1 = }& \ AND(y(все чёрные лошадки)=1)
&{ WHITE-HORSES DUP HORSE 2@ ( x y ) NIP H = }& \ AND(y(все белые  лошадки)=h)
AND ;

: ?ARE-WE-DONE-YET ( -- f ) PREDICATE \ определение квантором отрицания
S| NOT: BLACK-HORSES DUP HORSE 2@ ( x y ) NIP 1 = ONFALSE -NOT \ НЕТ таких БЕЛЫХ  ЛОШАДОК у которых игрек НЕ РАВЕН 1
S| NOT: WHITE-HORSES DUP HORSE 2@ ( x y ) NIP H = ONFALSE -NOT \ НЕТ таких ЧЁРНЫХ ЛОШАДОК у которых игрек НЕ РАВЕН H
SUCCEEDS ;

: ?ODD ( n -- f )  1 AND ;

:NONAME

LOCAL moves \ переменная хода

LOCAL cur-board
LOCAL cur-board#

LOCAL boards \ список позиций
boards 0!

LOCAL i

moves 0!

START{ \ главный цикл перебора
BEGIN
boards @ \ старое значение списка сохраняем

START{ \ цикл определения уникальности позиции
DRAW-BOARD cur-board# ! cur-board !
S| NOT:
boards list=> DROPB \ цикл по списку позиций
DUP board-moves @ ?ODD moves @ ?ODD = ONTRUE \
DUP board-moves @ moves @ > ONFALSE \ только среди позиций возникших в ранних ходах
DUP board-addr @ cur-board# @ cur-board @ cur-board# @ COMPARE 0= ONTRUE \ сравниваем позиции на равенство
-NOT \ нет позиций в списке, совпадающих с текущей
\ это значит что позиция уникальна, и надо

\ записывать новый элемент списка
board-elem ALLOCATE THROW >R \ создали элемент
cur-board @ cur-board# @ HEAP-COPY \ DRAW-BOARD снимает "свой" участок памяти из кучи, поэтому копируем явно
DUP R@ board-addr ! \ записываем в поле доску
moves @ CELLS LAST-BOARDS + ! \ также копию текущей доски пишем в историю текущего решения
moves @ R@ board-moves ! \ записываем текущий ход
R> boards list+

}EMERGE

boards @ = ONFALSE \ новая ли позиция? Определяется по изменению списка boards

?ARE-WE-DONE-YET IF \ сложилась ли у нас нужная позиция на доске?
CR CR DEPTH ." S: " . ."  R: " RP@ R0 @ - ABS CELL / . \ интересу ради печатаем глубину стеков
START{ i 0! \ начинаем цикл печати позиций этого решения
LAST-BOARDS moves @ iterateByCellValues DUP cur-board# @
CR CR i 1+! ." Move:" i @ . PRINT-BOARD }EMERGE
THEN

moves @ ?ODD                  IF
WHITE-HORSES MOVE-WHITE-HORSE ELSE \ чётное значение "хода" -- ходят белые
BLACK-HORSES MOVE-BLACK-HORSE THEN \ нечётное -- чёрные
moves KEEP moves 1+! \ переменную хода увеличиваем (KEEP её откатывает)

moves @ MAX-MOVES > ONFALSE \ ограничиваем перебор максимальной глубиной
AGAIN \ идти до упора -- пока весь перебор не исчерпает себя
}EMERGE

CR ." Maximum move: " MAX-MOVES .
CR ." Positions processed: "

+{ boards list=> FREE THROW  1 }+ .
; STARTLOG EXECUTE


Задержка была из-за того что пижонствовал и тупил (как впрочем и всегда из-за этого время теряем).

Пижноство заключалось в том что сначала я начал было использовать ~profit/lib/bac4th-sequence.f (хотя тут они и вправду очень к месту были бы), но потом столкнулся с уже известными проблемами реализации seq{ }seq и пришлось перейти от динамически генерируемых итераторов-структур к явно задаваемым спискам.

Тупство же моё оказалось хитрее и подлянистей. Собственно, итератор-список, а потом -- просто список был заведён для хранения вырабатываемых в процессе перебора положений на доске. И при генерации каждого следующего хода проверялось, не совпадает ли текущее положение на доске с уже положенными в список. И бяка в том что bac4th автоматически предполагает перебор в глубину, а при таком виде перебора позиция 34-го хода конём обработается раньше чем позиция 4-го. Из-за этого у меня более "поздние" позиции (по кол-ву ходов) захватывали положения доски более ранних. То есть из-за того что сделав 34 хода и достигнув положения на доске:

Код:
   1  2  3 
  ----------
A |  |@ |@ |
B |  |# |  |
C |  |@ |  |
D |  |# |# |
  ----------
   1  2  3 


... то потом (после откатов), мы бы не смогли пройти в такую же позицию на 2-м ходу, так как она уже "застолблена" раньше. Я даже сам смеялся что если у меня делать глубину поиска в 50 полу-ходов, то у меня находилось 1 решение, а если делать 60, то не находилось ни одного. Я ограничил проверку на уникальность позиций только позициями образовавшимися на предыдущих ходах и заработало.

В программе интересу ради печатается глубина стеков. Интересно что для глубины в 40-х ходов на стеке данных максимально оказывается 190 значений, а на стеке возвратов -- 3179 (прописью: три тысячи семьдесят девять). Это в том числе из-за того что я явно не делал структуру для хранения "истории" ходов коней: лошадки возвращаются назад на старые клетки откатным эффектом слова "B!". Вот так-то.

Можно попробовать реализовать и перебор в ширину. Он будет много эффективней.


Последний раз редактировалось profiT Ср май 30, 2007 20:52, всего редактировалось 1 раз.

Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт май 18, 2007 23:09 
Когда я играл с генетическим алгоритмом, то применял его для задачи обхода шахматной доски конем. Там в лоб (перебор с откатом) и за пол-суток не посчиталось, а через ГА решение было найдено за секунды :)
Входом и выходом ГА-алгоритма являются популяции хромосом. Каждая хромосома должна представлять "какое-нибудь" решение целевой задачи (возможно, не полное, или плохое). Свойство "быть решением" должно сохраняться при операциях кроссинговера и мутации.

Главным открытием было кодировать в хромосому не доску и клетки, а композицию функций-ходов (каждая функция-ход по своему преобразует входную точку в выходную). Это позволило напрямую резать и соединять куски — композиция оставалась правильной функцией :)


Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт май 18, 2007 23:21 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6344
Благодарил (а): 14 раз.
Поблагодарили: 99 раз.
Эх, а как красиво генетика должна ложиться на распределенную, многоядерную процессорную систему. :)


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт май 18, 2007 23:22 
Не в сети
Аватара пользователя

Зарегистрирован: Пт май 05, 2006 06:19
Сообщения: 192
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
ничо не понял про хромасомы, :) но звучит красиво

_________________
SPF


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт май 18, 2007 23:31 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6344
Благодарил (а): 14 раз.
Поблагодарили: 99 раз.
Действительно красиво. Хромосома - это такое "окологенетическое" название набора данных. Типа если мы ищем x и y, то число, составленное из них, будет "хромосомой". Например, X=12, y=34 дадут хромосому 1234. И вот теперь мы посчитаем "приспособленность для жизни" этой хромосомы - т.н. фитнесс-функцию. Если, скажем, мы ищем решение уравнения f(x,y)=0, то чем меньше функция от этой хромосомы, тем лучше хромосома "приспособлена для жизни". Теперь мы набираем случайным образом кучу таких хромосом, считаем от них фитнесс-функции, а самые слабые "вымирают". На их место генерируются новые. Кроме того, есть "мутации" (смена битов случайным образом") и "скрещивание" (формирование из двух "сильных" хромосом третьей). В итоге значения, которые дают хорошие приближения, будут оставаться в популяции, а за счет мутации и скрещивания у них есть шанс сформировать правильный ответ.
Насколько /me успел заметить, ГА хорошо работают для поиска начального приближения для последующего уточнения методом градиентного спуска. Который, в свою очередь, плохо ищет глобальные экстремумы, а все норовит попасть в локальный. Вот тут-то ГА и помогает указать "искать надо где-то тут".


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Сб май 19, 2007 13:11 
Цитата:
ничо не понял про хромасомы, :) но звучит красиво
А я в таких случаях у Гугла спрашиваю, чтобы понять :)


Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Сб май 19, 2007 13:25 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 13:19
Сообщения: 3565
Откуда: St.Petersburg
Благодарил (а): 4 раз.
Поблагодарили: 72 раз.
спрашиваешь про хромосомы, и гугль рассказывает про масонов :))

_________________
С уважением, WingLion
Forth-CPU . RuF09WE
Мой Форт
Отсутствие бана это не заслуга юзера, а недоработка модератора (с)


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Сб май 19, 2007 20:14 
Не в сети
Аватара пользователя

Зарегистрирован: Ср мар 21, 2007 00:16
Сообщения: 154
Благодарил (а): 2 раз.
Поблагодарили: 2 раз.
У гугля ГА нет. Вот и попадает на локальны... :)


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Сб май 26, 2007 11:52 
Не в сети
Аватара пользователя

Зарегистрирован: Пт май 05, 2006 06:19
Сообщения: 192
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Код:
\ gl0 SPF4.18 \ шесть коней
lib/ext/locals.f

STARTLOG
CR S" паехали " TYPE

: bin 2 BASE ! ;
: dcml DECIMAL ;
: b.  ( -- ) bin DUP CR . dcml ;

\ состояния перехода тоесть для каждой клетки описаны возможные битые поля они же пригодне для перехода
0 VALUE mm 48 ALLOCATE THROW TO mm
2 BASE !
100001010000  mm 0x2C  + ! \ п12
010000101000  mm 0x28  + ! \ п11
001100010000  mm 0x24  + ! \ п10
001100001010  mm 0x20  + ! \ п9
000010000101  mm 0x1C  + ! \ п8
100001100010  mm 0x18  + ! \ п7
010001100001  mm 0x14  + ! \ п6
101000010000  mm 0x10  + ! \ п5
010100001100  mm 0xC   + ! \ п4
000010001100  mm 0x8   + ! \ п3
000101000010  mm 0x4   + ! \ п2
000010100001  mm 0x0   + ! \ п1
DECIMAL

0       VALUE phase \ этап     
0       VALUE hstr  \ история
0       VALUE chstr \ указатель последнего выбраного положения на доске

0x1000000 VALUE krt   \ кратность увеличения блока памяти под историю ходов
krt ALLOCATE THROW TO hstr krt hstr !

\ занесем стартовые параметры phase:0    m:00001110 00000000 00000000 00000111
8 hstr 4 + ! phase hstr 8 + ! 2 BASE !
\ |-байт-||-байт-||-байт-||-байт-|
\     |--черные--|    |--белые---|
\ 00001110000000000000000000000111
  00001110000000000000000000000111
DECIMAL hstr 12 + !
hstr 12 + TO chstr
: hstr+ ( m phase hstr -- )
   { m ph hs }
   m hs 4 + DUP 4 + SWAP @ + ph OVER ! 4 + ! hs 4 + DUP @ 8 + SWAP ! ;

\ получить поледнюю запись истории
: lhstr ( hstr -- m ph )
   DUP 8 + SWAP 4 + @ + 8 - DUP @ SWAP 4 + @ SWAP ;   
\ вывести паследнюю запись истории
: plhstr ( hstr -- )
   DUP 4 + @ 8 / CR ." sum step:" . lhstr ." phase:" . ."   mask:" 2 BASE ! . DECIMAL ; 
\ сбросить последнюю запись истории
: dlhstr ( hstr -- )
   DUP 4 + @ 8 / CR ." шаг назад. сброшен шаг:" .
   4 + DUP @ 8 - SWAP !  \ уменьшили счетчик
;   

: WIN2 ( m -- i ) \ TRUE если достигнуто условие победы
    0x70E00      \ конечное положение 111000111000000000
   = ;

\ преобразование числа n в число с битом в позиции n (n должен быть больше нуля и менее 32)
: n-b ( n -- b ) 0 MAX 32 MIN 1 SWAP 1 - LSHIFT ;
\ разобрать маску получив номера всех битов равных единице и количество ответов
: b-n ( b -- n1 ... nx x )
   { b \ x n }
   BEGIN b WHILE x 1+ -> x b 1 AND IF x n 1+ -> n THEN b 1 RSHIFT -> b REPEAT n ;
   
\ получить по номеру n маску переходов
: n>m ( n -- m ) 1- CELLS mm + @ ;

\ для данной фазы получить положение коней ходящих   
: ns ( chstr phase - h1 h2 h3)
   1 AND IF @ 0xFFF AND ELSE @ 16 RSHIFT THEN b-n ;
   
\ маски состояния противников \ если phase четное вернуть статусы белых, и наоборот
: enemy ( chstr phase -- m )
   { \ m }
   1 AND IF @ 16 RSHIFT ELSE @ 0xFFF AND THEN b-n 0 ?DO n>m m OR -> m LOOP m ;

\ маски положений своих
: frend ( chstr phase -- m )
   { \ m }
   ns 0 ?DO n-b m OR -> m LOOP m ;

\ найти все возможные ходы канем на поле n
: nstep ( n chstr phase -- nx...n1 x )
   { n ch ph }
   ch ph enemy ch ph frend OR INVERT 0xFFF AND n n>m AND b-n ;
   
\ найти и занести в историю все ходы фазы
: stepphase
   chstr phase ns 0     
   DO
   DUP >R chstr phase nstep R> SWAP 0
    ?DO \ n1 n1 n
    SWAP OVER chstr @ SWAP n-b phase 1 AND 0= IF 16 LSHIFT THEN INVERT 0xFFFFFFFF AND -1 AND AND
    SWAP n-b phase 1 AND 0= IF 16 LSHIFT THEN OR
    phase hstr hstr+
    hstr plhstr
    LOOP \ преобразовать в ход и занести в историю 
   DROP LOOP
;

: back? ( m ph phase -- i ) \ TRUE если текущий вариант тупиковый (не было сделано ни одного хода) или повторяет уже существующий
   { \ m }
   <> SWAP -> m
   IF
   CR ." нет возможности хода"
   TRUE
   ELSE
   0 hstr 4 + @ 8 / 1- 0
   DO hstr 12 + I 8 * + @ m = + LOOP
   IF
   CR ." найдено дублирование"
   TRUE
   ELSE FALSE THEN
   THEN ;   
   
: back!
   BEGIN
   hstr DUP 4 + @ + DUP @ SWAP 8 - @ =
   IF hstr dlhstr TRUE ELSE hstr dlhstr FALSE THEN
   UNTIL ;
   
: RUN ( k -- )
   0 DO
   stepphase
   hstr lhstr DROP WIN2
   IF
   CR CR ." ====================== достигнуто решение ====================== " CR  hstr plhstr KEY DROP back!
   ELSE
   hstr lhstr phase back?
     IF
     back!
     THEN
   THEN
   hstr DUP 4 + @ + @ 1 + TO phase
   hstr DUP 4 + @ SWAP 4 + + TO chstr
\   phase IF hstr plhstr THEN
   LOOP
; 1 TO phase 200000 RUN \EOF
   
   
   
   
\EOF
\ механизм поиска возможных ходов (1wh - первый белый конь, 1bh - первый черный конь)
   100001010000 \ п12 положение и битые поля 1bh
   010000101000 \ п11 положение и битые поля 2bh
   001100010000 \ п10 положение и битые поля 3bh
   000000000100 \ п3  положение 1wh
   000000000010 \ п2  положение 2wh
   000000000001 \ п1  положение 3wh
\ ------------ \ оцениваем возможность хода 3wh с поля номер 1 как OR всех препятствий
   111101111111 \ итоговая сиуация на поле
\ ------------ \ INVERT
   000010000000 \
   000010001100 \ матрица возможностей 1wh
\ ------------ \ оцениваем возможность хода AND
   000010000000 \ ответ о возможности
\ ------------ \ расшифровка полученой маски
\ ...987654321 \ соответствие бит и номеров полей 
\ итог: 8 единственое поле для хода белым конем c поля 1

\ представление игрового поля
\  ┌─────┬─────┬─────┐ 
\  │ 12b │ 11b │ 10b │ черные
\  ├─────┼─────┼─────┤
\  │ 9b  │ 8b  │ 7b  │
\  ├─────┼─────┼─────┤   
\  │ 6b  │ 5b  │ 4b  │
\  ├─────┼─────┼─────┤
\  │ 3b  │ 2b  │ 1b  │ белые
\  └─────┴─────┴─────┘
\ история перемешения на доске
\ каждый вариант положения на доске описывается 8-ми байтным значением
\ первые 4 байта хранят номер фазы дале два байта хронят маску положений чорных коней,
\ последние два байта хронят маску положений белых коней
\ соответствено стартовая ситуация описывается положением 00001110 00000000 00000000 00000111
\                                                конечная 00000000 00000111 00001110 00000000

вазвернуто

_________________
SPF


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт май 29, 2007 22:02 
Тоже поиграл с этой задачей, и тоже сразу пошел через битовые маски :)
www forth org ru /devel/~pinka/samples/2007/algo/horses/half-dozen.f.xml (с авто-раскраской браузером :)

chess
Цитата:
Найти все решения
А сколько их? ;)

profiT
Цитата:
Можно попробовать реализовать и перебор в ширину. Он будет много эффективней.
Быстрей нашлись бы первые короткие решения, а все искать (с верхними ограничениями, ессно) — все равно как перебирать. Для перебора в ширину памяти больше надо. По моей грубой экспериментальной оценке, на глубине в 30 пар ходов понадобится уже порядка несколько сот мегабайт. Функция роста — экспоненциальная, с показателем ~1.5.


Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт май 29, 2007 22:14 
Не в сети
Аватара пользователя

Зарегистрирован: Пт май 05, 2006 06:19
Сообщения: 192
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
в переборе в даном варианте дошел до 500 тыс хода
теоритические здесь где то предел вообще возможному количеству состояний поля, однако его я не достиг долго очень, присутствует тот самый маляр который ходит от начала дороги чтоб рисовать разметку, в виде поиска дубликатов состояния. чем глубже история тем медленее

_________________
SPF


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Ср май 30, 2007 07:55 
Не в сети
Аватара пользователя

Зарегистрирован: Чт июл 20, 2006 11:31
Сообщения: 2109
Откуда: Екб
Благодарил (а): 0 раз.
Поблагодарили: 36 раз.
rvm писал(а):
А сколько их?

Восемь.

_________________
С уважением, chess


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Ср май 30, 2007 11:59 
"показателем ~1.5" — читать "основанием" :) ( 1.5^n = exp(ln(1.5)n)

chess, a является ли решением следующее?
Код:
b b b   . b b   . . b   . . .   . . b   w . b   w . b   w . b   w . b   w w b   w w .   . w .   w w .   w w w
. . .   . w .   . w w   b w w   b . w   b . .   . . w   . b w   . b .   . . .   b . w   b b w   . b .   . . .
. . .   . b .   . b b   w b b   w . b   w . .   . . b   w . b   w . .   . . .   . . .   . w .   . w .   . . .
w w w   . w w   . . w   . . .   . . w   b . w   b . w   . . .   b w .   b w b   b . b   . . b   . b b   b b b


Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Ср май 30, 2007 12:03 
Эх, покарябал форумный движок код. А в предосмотре нормально было.
Код:
0       2       4       6       8       10      12
b b b   . b b   . . b   . . .   . . b   w . b   w . b
. . .   . w .   . w w   b w w   b . w   b . .   . . w
. . .   . b .   . b b   w b b   w . b   w . .   . . b
w w w   . w w   . . w   . . .   . . w   b . w   b . w


14      16      18      20      22      24      26
w . b   w . b   w w b   w w .   . w .   w w .   w w w
. b w   . b .   . . .   b . w   b b w   . b .   . . .
w . b   w . .   . . .   . . .   . w .   . w .   . . .
. . .   b w .   b w b   b . b   . . b   . b b   b b b


Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Ср май 30, 2007 12:29 
Не в сети

Зарегистрирован: Чт май 04, 2006 18:18
Сообщения: 456
Благодарил (а): 0 раз.
Поблагодарили: 1 раз.
Что произошло на 13-м ходу? Кони ходят ведь поочерёдно :) Чёрный пошёл в битое поле. Или белый (если белые ходили первыми).

ЗЫ У меня находится восемь решений - все длины 11.

_________________
http://forth.org.ru/~ygrek


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 58 ]  На страницу Пред.  1, 2, 3, 4  След.

Часовой пояс: UTC + 3 часа [ Летнее время ]


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1


Вы не можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
phpBB сборка от FladeX // Русская поддержка phpBB