Permuations

[Below is an interesting permutation program sent to me by Herb Schaaf. He did not include any article or explanation, so I’ll just present the program as is – ED]

100 REMark Permutation
110 REMark H L Schaaf
120 REMark February 28, 1994
130 REMark cleaned up from 'permutations' of January 27, 1994
140 REMark to show permutations of n items taken r at a time
150 REMark where the order of the items is important
160 MODE 4
170 :
180 INPUT\ "Selection to be made from how many total items ?",n%
190 n$ = n%
200 INPUT '# of items at any one time to be selected from ' &n$&' choices',r%
210 IF r% > n% THEN GO TO 180
220 facn = fac(n%)
230 facd = fac(n%-r%)
240 num_perms = facn/facd
250 PRINT 'There should be ';num_perms;' permutations'
260 :
270 REMark form an array and fill the first row
280 DIM a%(r%,n%)
290 FOR i = 1 TO n% : a%(1,i)  i : END FOR i
300 :
310 REMark make an array to hold permutations
320 DIM perm%(num_perms, r%)
330 PRINT\,'touch [space bar] to continue'
340 PAUSE
350 perm_num = 0
360 FOR layer = 2 TO r%
370  make_lowerow a%,layer,1+n%-layer
380 END FOR layer
390 level% = r% : p% = 1 : DIM mark%(r%)
400 FOR i = 1 TO r% :mark%(i) = a%(i,1) : END FOR i
410 REPeat loop
420  mark%(level%) = a%(level%,1)
430  REPeat shifts
440   get_perm(p%)
450   p% = p% + 1
460   rot_left a%,level%,(n% + 1 - level%)
470   IF a%(level%,1)= mark%(level%) THEN
480     level% = level% - 1 : IF level% = 0 THEN EXIT loop
490     rot_left a%,level%,(n% + 1 - level%)
500     IF a%(level%,1) = mark%(level%) THEN GO TO 480
510       FOR layer = level% +1 TO r%
520         make_lowerow a%,layer,(1 + n% - layer)
530         mark%(layer) = a%(layer,1)
540       END FOR layer
550       level% = r%
560   END IF
570  END REPeat shifts
580 END REPeat loop
590 :
600 PRINT\ 'there should be ';p%-1;
610 PRINT ' permutations in array perm%(';
620 PRINT   num_perms%;',';r%;')'
630 PRINT 'touch [space bar] to see them'
640 PAUSE
650 FOR i = 1 TO p%-1
660 PRINT\' # ';i;' is ',
670 FOR j = 1 TO r%
680 PRINT perm%(i,j),
690 END FOR j
700 END FOR i
710 :
720 REMark function for factorial of number
730 DEFine FuNction fac(n%)
740 LOCal i
750 factorial = 1
760 FOR i =  n% TO 2 STEP -1
770 factorial = factorial * i
780 END FOR i
790 RETurn factorial
800 END DEFine
810 :
820 REMark a way to rotate-left
830 DEFine PROCedure rot_left(array%,row%,items%)
840 LOCal i,temp%
850 temp% = array%(row%,1)
860 FOR i = 1 TO items%-1
870 array%(row%,i) = array%(row%,i+1)
880 END FOR i
890 array%(row%,items%) = temp%
900 END DEFine rot_left
910 :
920 REMark if we want to watch, debug, etc.
930 DEFine PROCedure show_array(array%)
940 PRINT\
950 rows% = DIMN(array%,1)
960 cols% = DIMN(array%,2)
970 FOR i = 1 TO rows%
980 FOR j = 1 TO cols%
990 PRINT array%(i,j),
1000 END FOR j
1010 PRINT
1020 END FOR i
1030 END DEFine show_array
1040 :
1050 REMark a way to make a 'subrow' of remaining choices
1060 REMark array(row-1,col+1) is placed in array(row,col)
1070 DEFine PROCedure make_lowerow(array%, row%, limit%)
1080 LOCali
1090 FOR i = 1 TO limit%
1100 array%(row%,i) = array%(row%-1,i+1)
1110 END FOR i
1120 END DEFine make_lowerow
1130 :
1140 REMark  first column of a%() is a permutation
1150 DEFine PROCedure get_perm(p%)
1160 perm_num = perm_num + 1
1170 FOR i = 1 TO r% :perm%(p%,i) = a%(i,1) : END FOR i
1180 PRINT\'# ';perm_num;'  -> ',
1190 FOR i = 1 TO r% :PRINT a%(i,1);' '; : END FOR i
1200 END DEFine get_perm