1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
* Этот макрос находит все перестановки целых чисел 1, 2, ... t, где t < 8.
* Автор: Raynald Levesque, февраль 2002.


DEFINE !t(nb=!TOKENS(1))

/* Создаём файл, содержащий все комбинации (с возвращением) */.
INPUT PROGRAM.
!DO !cnt=1 !TO !nb
LOOP !CONCAT('cnt',!cnt,'=1 TO ',!nb).
LEAVE !CONCAT('cnt',!cnt).
!DOEND
END CASE.
!DO !cnt=1 !TO !nb.
END LOOP.
!DOEND
END FILE.
END INPUT PROGRAM.

* Считаем, какие числа попадаются в строке более, чем 1 раз.
NUMERIC c1 TO !CONCAT('c',!nb).
!DO !cnt=1 !TO !nb
COUNT !CONCAT('c',!cnt,' =cnt1 TO c',!cnt,'(',!cnt,')').
!DOEND

/* Оставляем только действительные перестановки (без возвращения) */.
SELECT IF MAX(c1 TO !CONCAT('c',!nb))=1.
EXECUTE.
STRING newname(A8).
COMPUTE newname=CONCAT('p',LTRIM(STRING($CASENUM,F8.0))).

FLIP cnt1 TO !CONCAT('cnt',!nb) /NEWNAMES=newname.

SAVE OUTFILE='c:\\temp\\all permutations.sav' /DROP=case_lbl.
!ENDDEFINE.

!t nb=6.