Google
 

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;