Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/libsim/pergen.sim
There is 1 other file named pergen.sim in the archive. Click here to see a list.
00100 OPTIONS(/E/-D/-Q/-I/-A);
00200 ! CLASS PERGEN generates all the possible permutations
00300 ! of the contents in INTEGER ARRAY a[1:N], one at a time.
00400 ! Use:
00500 ! REF (pergen) pg;
00600 ! pg:- NEW pergen(a,n);
00700 ! WHILE pg.cycles < 2 DO
00800 ! BEGIN Call(pg); ! use new permutation END;
00900 !
01000 ! Note that N Must be >= 2.
01100 ! Also observe that permutations are generated systematically and
01200 ! that the order will be REVERSED when one N! cycle is completed.
01300 ! Thus for N = 2 then result will be (if A[1]=1, A[2]=2 initially):
01400 ! (1 2) (2 1) (2 1) (1 2) (1 2) (2 1) etc.
01500 ! The permutations will be generated in such manner that
01600 ! the last elements of A will change most slowly.
01700 ! The attribute CYCLES will indicate to which cycle the NEXT
01800 ! permutation will belong (after next Call that is).
01900 !
02000 ! Ref:"Generation of permutation sequences", A.D. Woodall,
02100 ! The Computer Journal vol 20, No 4 1977 p 346.
02200 ! Modified by: Mats Ohlin, FOA, Stockholm, Sweden.
02300 !
02400 ! For random permutations see procedure SCRAMBLE.
02500 !;
02600 EXTERNAL INTEGER PROCEDURE imax;
02700 CLASS pergen(a,n); INTEGER ARRAY a; INTEGER n;
02800 BEGIN
02900 INTEGER p,mp,swpt,i,w,cycles;
03000 INTEGER ARRAY m,km[2:imax(3,n)],ret[2:imax(2,n)];
03100
03200 IF n < 2 THEN
03300 BEGIN Outtext("%PERGEN - 2nd parm N must be >= 2");
03400 Outimage;
03500 END ELSE
03600 BEGIN
03700
03800 OPTIONS(/A);
03900 a[1]:= a[1]; a[n]:= a[n];
04000 km[n]:= ret[n]:= km[2]:= ret[2];;
04100 OPTIONS(/-A);
04200
04300 FOR i:= 4 STEP 2 UNTIL n DO
04400 BEGIN p:= i-1;
04500 km[i]:= p;
04600 km[p]:= 2-i;
04700 END i loop;
04800
04900 GO TO run;
05000 start: Detach; run:
05100 cycles:= cycles + 1;
05200
05300 FOR i:= 2 STEP 1 UNTIL n DO ret[i]:= i+1;
05400 FOR i:= 4 STEP 2 UNTIL n DO
05500 BEGIN m[i]:= i-1; m[i-1]:= 2-i END i loop;
05600 IF Mod(n,2) NE 0 THEN m[n]:= 1-n;
05700
05800 loop: p:= ret[2];
05900
06000 IF p > 3 THEN ret[2]:= 3;
06100 Detach;
06200 w:= a[1]; a[1]:= a[2]; a[2]:= w;
06300 IF p > n THEN GO TO start;
06400
06500 mp:= m[p];
06600 IF mp < 0 THEN
06700 BEGIN swpt:= 1; mp:= mp+1 END ELSE
06800 BEGIN swpt:= mp; mp:= mp-1 END;
06900
07000 IF mp = 0 THEN
07100 BEGIN
07200 m[p]:= km[p];
07300 ret[p-1]:= ret[p]; ret[p]:= p+1
07400 END ELSE m[p]:= mp;
07500
07600 Detach;
07700 w:= a[p]; a[p]:= a[swpt]; a[swpt]:= w;
07800 GO TO loop;
07900 END n >= 2
08000 END of pergen;