#алгоритм #forth
История вопроса: Однажды мне пришлось сделать последовательности из 4 элементов.
Таких последовательностей 4! т.е. 24 . Чтобы не писать 24 раза почти одинаковые последовательности,
я заставил некоторые из них "вращаться"
Итого на 4 эл-та вращение приходилось 6 раз:
24 0 DO
TURN-N
4 I = IF 6 L-VAR@ 5 L-VAR@ 7 L-VAR@ 8 L-VAR@ PRIEM-OB THEN
8 I = IF 6 L-VAR@ 8 L-VAR@ 5 L-VAR@ 7 L-VAR@ PRIEM-OB THEN
12 I = IF 7 L-VAR@ 5 L-VAR@ 8 L-VAR@ 6 L-VAR@ PRIEM-OB THEN
16 I = IF 7 L-VAR@ 6 L-VAR@ 5 L-VAR@ 8 L-VAR@ PRIEM-OB THEN
20 I = IF 8 L-VAR@ 7 L-VAR@ 5 L-VAR@ 6 L-VAR@ PRIEM-OB THEN
LOOP
Слово TURN-N занимается "вращением" ( 1234 -- 4123 )
L-VAR@ - РАЗЪИМЕНОВАТЬ ЛОК.ПЕРЕМЕННУЮ ПО АДРЕСУ
Как всё это дело автоматизировать? Чтобы не из 4-х элементов, а из 5-ти или 6-ти?
Ответы
Ответ 1
\ Генератор перестановок символов в строке от Garbler'a : cswap ( a1 a2 -- ) 2DUP 2>R C@ SWAP C@ R> C! R> C! ; : cnotfind ( c s2 s1 -- t/f ) 1 -ROT ?DO OVER I C@ = IF 0 AND LEAVE THEN LOOP SWAP DROP ; : variants ( 0 s2 s1 str len --> count s2 s1' str len ) 2>R 2DUP - 1 < IF 2>R 1+ 2R> ." > " 2R> 2DUP TYPE CR EXIT THEN DUP >R BEGIN 2DUP > WHILE DUP C@ OVER R@ cnotfind IF DUP R@ cswap R> 1+ SWAP 2R> ROT >R RECURSE R> -ROT 2>R SWAP 1- >R DUP R@ cswap THEN 1+ REPEAT DROP R> 2R> ; : VARIANTS ( asc # --> n ) DUP 0 = IF 2DROP 0 EXIT THEN 2DUP 2>R OVER + SWAP 0 -ROT 2R> variants 2DROP 2DROP ; \ Пример получения всех перестановок символов в строке S" 123456" 2DUP VARIANTS .( ] variants: ) . TYPE CR CR \ для чисел количеством до 256 можно использовать массив указателей на \ массив чисел а массив указателей подавать как строку на вход слова VARIANTS \ как в приведенном выше примереОтвет 2
Общий подход Чтобы решить эту задачу элегантно в общем виде, следует разделить код, который генерирует перестановки, и код, который работает с каждой отдельной перестановкой. Конечно же, перестановки должны генерироваться автоматически. Элементы, подлежащие перестановке, обычно помещаются в список или массив. Генератор перестановок следует выделить в отдельный функциональный модуль, достойный включения в библиотеку :) Если задача разовая, и число элементов небольшое, то можно сгенерировать последовательность перестановок в текстовом виде каким-то из существующих инструментов, и автоматически преобразовать эту последовательность в код. Алгоритм генерации перестановок Классический рекурсивный алгоритм генерации всевозможных перестановок легко понять по индукции. Каждая перестановка — эта некоторая последовательность. Для множества из одного элемента — будет одна перестановка из этого элемента. Для множества из N элементов — мы по очереди берем каждый из этих элементов и объеденяем с перестановками оставшихся N-1 элементов. Пример. Для двух элементов {1,2} — берем 1 и объединяем с 2, берем 2 и объединяем с 1. Для трех элементов {1,2,3} — берем 1 и объединяем с перестановками для {2,3}, берем 2 и объединяем с перестановками для {1,3}, берем 3 и объединяем с перестновками для {1,2}. Иллюстрация кодом Для простоты примера, будем генерировать перестановки N верхних элементов стека, и после каждой перестановки выполнять заданное через xt слово; это слово должно оставить состояние стека без изменений. Код заточен под SP-Forth REQUIRE NDROP ~pinka/lib/ext/basics.f REQUIRE { lib/ext/locals.f : (FOR-PERMUTATION) ( i*x i xt -- i*x ) { i xt | j } i 1 = IF xt EXECUTE EXIT THEN i 1- TO j i 0 DO j xt RECURSE j ROLL \ 0-based numbering LOOP ; : FOR-PERMUTATION ( i*x i xt -- ) \ xt ( i*x -- i*x ) OVER 0 = IF 2DROP EXIT THEN OVER >R (FOR-PERMUTATION) R> NDROP ; Испытание : print-stack-state ( i*x -- i*x ) .S CR ; 3 2 1 3 ' print-stack-state FOR-PERMUTATION
