Как сделать уникальные (неповторяющиеся) последовательности данных?

#алгоритм #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