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

История вопроса: Однажды мне пришлось сделать последовательности из 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-ти?

Ответ

\ Генератор перестановок символов в строке от 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 \ как в приведенном выше примере