C Operation counts for Algorithm L C (lexicographic permutation generation) C as described in D. Knuth's TAOCP Vol.4, Chapter 7.2.1.2 C It is counted how many operations are required to create all n! C permutations of n distinct elements. C The asymptotic behavior of the operation counts agrees with the C corresponding results in the "Answers to exercises" for exercise 5: C "Compute the mean and variance of the numbers of comparisons made by C Algorithm L in (a) step L2, (b) step L3, when the elements C {a_1,...,a_n} are distinct." C C Author: Hugo Pfoertner http://www.pfoertner.org/ C C Version history: C C 24.01.2003 Comments improved C 21.01.2003 Modified for the "pure" Algorithm L C 09.01.2003 Trivial counts removed C 08.01.2003 Initial version C C Diagnostic counts C...+....1....+....2....+....3....+....4....+....5....+....6....+....7.. C INTEGER*8 IFAC INTEGER*8 & L2TES, L2GE, L3TES, L3GE, L4TES, L4REV COMMON /DIAGNS/ & L2TES, L2GE, L3TES, L3GE, L4TES, L4REV C INTEGER A(20) C C Header line WRITE (*,1001) C C Loop over the number of elements to be permuted C DO 10 N = 2, 11 C C Preset diagnostic counts L2TES = 0 L2GE = 0 L3TES = 0 L3GE = 0 L4TES = 0 L4REV = 0 C Preset array to be permuted DO 20 I = 1, N A(I) = I 20 CONTINUE C C IFAC = 0 C 30 CONTINUE C C (IFAC exceeds range 2*31-1 for N=13) C IFAC = IFAC + 1 C Activate to see permuted array C WRITE (*,1002) IFAC, (A(I),I=1,N) C1002 FORMAT ( I4, 10I2) C CALL LPURE ( N, A, NEXT) C Terminate when reverse order is reached C LPURE returns NEXT=0 after N! calls GOTO 30 C Test for termination IF ( NEXT .NE. 0 ) GOTO 30 C C All done C Output of diagnostic counts C WRITE (*,1000) N, IFAC, WRITE (*,1000) N, & L2TES, L2GE, L3TES, L3GE, L4TES, L4REV 1000 FORMAT ( I3, 6I12 ) 1001 FORMAT ( ' N',7X,'L2TES', 8X,'L2GE', & 7X,'L3TES' 8X,'L3GE', 7X,'L4TES', 7X,'L4REV') 10 CONTINUE END C...+....1....+....2....+....3....+....4....+....5....+....6....+....7.. SUBROUTINE LPURE ( N, A, NEXT ) C C Generate next permutation of N elements A(i) in C lexicographic order C C The method used is C "Algorithm L (Lexicographic permutation generation)" C described in Chapter 7.2.1.2 C of Donald E. Knuth's The Art of Computer Programming, Volume 4, C Combinatorial Algorithms, C Volume 4A, Enumeration and Backtracking. C C The printed version of TAOCP Vol.4 is expected to be available in the C year 2007. D. Knuth has put some chapters online, including C Pre-fascicle 2b (generating all permutations), available at C http://www-cs-faculty.stanford.edu/~knuth/fasc2b.ps.gz C Most of the comments are copied verbally from Knuth's C description C C Author: Hugo Pfoertner http://www.pfoertner.org/ C C Change history: C 21.01.2003 "Pure" Algorithm L C 10.01.2003 Results from diagnostic counts included as comments C 08.01.2003 Diagnostic counts C 06.01.2003 Optional code to treat N<4 C 05.01.2003 Initial version C C Call parameters: INTEGER N, A(N), NEXT C N: number of elements to permute. N>=4 must hold (not checked) C A: Integer array holding the elements. C to be preset externally (e.g. by 1,2,3,...,n-1,n) C A is overwritten by the lexicographically next permutation C NEXT: =1 if A has been successfully updated C =0 if A was already in reverse lexicographic order C i.e. if a(n)>=a(n-1)>=....>=a(2)>=a(1) C In this case no change is made to A C C Local variables INTEGER J, K, L, H C C Diagnostic counts C...+....1....+....2....+....3....+....4....+....5....+....6....+....7.. INTEGER*8 & L2TES, L2GE, L3TES, L3GE, L4TES, L4REV COMMON /DIAGNS/ & L2TES, L2GE, L3TES, L3GE, L4TES, L4REV C C Preset return status NEXT = 1 C C Find the largest j such that a(j) can be increased C J = N - 1 10 CONTINUE CDIAG L2TES = L2TES + 1 CDIAG IF ( A(J) .GE. A(J+1) ) THEN C L2 Find j CDIAG L2GE = L2GE + 1 CDIAG J = J - 1 IF ( J .EQ. 0 ) THEN NEXT = 0 RETURN ENDIF GOTO 10 ENDIF C C At this point j is the largest subscript such that we have already C visited all permutations beginning with a(1)...a(j). Therefore C the lexicographically next permutation will increase the value C of a(j). C C L3 Increase a(j) by the smallest feasible amount L = N C C If a(j) >= a(l) decrease l repeatedly until a(j)a(l) C C Increase A(J) 20 CONTINUE CDIAG L3TES = L3TES + 1 CDIAG IF ( A(J) .GE. A(L) ) THEN CDIAG L3GE = L3GE + 1 CDIAG L = L - 1 GOTO 20 ENDIF C...+....1....+....2....+....3....+....4....+....5....+....6....+....7.. C C Since a(j+1) >= ... >= a(n), element a(l) is the smallest element C greater than a(j) that can legitimately follow a(1)...a(j-1) in a C permutation. Before the interchange we have a(j+1)>=...>=a(l-1)>=a(l) C >a(j)>=a(l+1)>=...>=a(n) C C Interchange C H = A(J) A(J) = A(L) A(L) = H C C After the interchange, we have C a(j+1)>=...>=a(l-1)>=a(j)>a(l)>=a(l+1)>=...>=a(n) C C Find the lexicographically least way to extend the new a(1)...a(j) C to a complete pattern: C The first permutation beginning with the current prefix a(1)...a(j) C is a(1)...a(j)a(n)...a(j+1), and step L4 produces it by doing C floor (n-j)/2 interchanges C C L4 Reverse a(j+1)...a(n) K = J + 1 L = N 30 CONTINUE CDIAG L4TES = L4TES + 1 CDIAG IF ( K .LT. L ) THEN CDIAG L4REV = L4REV + 1 CDIAG H = A(K) A(K) = A(L) A(L) = H L = L - 1 K = K + 1 GOTO 30 ENDIF RETURN C End of SUBROUTINE LPURE END C...+....1....+....2....+....3....+....4....+....5....+....6....+....7.. Results: N L2TES L2GE L3TES L3GE L4TES L4REV 2 2 1 1 0 1 0 3 9 4 6 1 7 2 4 40 17 30 7 34 11 5 205 86 160 41 182 63 6 1236 517 975 256 1107 388 7 8659 3620 6846 1807 7773 2734 8 69280 28961 54796 14477 62212 21893 9 623529 260650 493200 130321 559948 197069 10 6235300 2606501 4932045 1303246 5599525 1970726 11 68588311 28671512 54252550 14335751 61594835 21678036 12 823059744 344058145 651030666 172029067 739138086 260136487 13 10699776685 4472755886 8463398736 2236377937 9608795202 3381774403 L2TES: A038156: n!*Sum(1/k!, k=1..n-1). a(n)=floor[(e-1)*n!]-1 L2GE: A056542: a(n) = n*a(n-1) + 1, a(1) = 0. a(n) = floor[(e-2)*n! ] L3TES: A038155: (n!/2)*Sum(1/k!, k=0..n-2). a(n) = 1/2*floor(n!*exp(1)-n-1), n>0. L3GE: A080047: a(2)=0, a(n) = n*a(n-1)+(n-1)*(n-2)/2 for n>=3 c = a(n)/n! = 0.35914091422952261768 for n--> infinity a(n) = floor [c*n! - (n-1)/2] for n>=2 0 1 7 41 256 1807 14477 130321 1303246 14335751 172029067 2236377937 31309291196 469639368031 7514229888601 127741908106337 2299354345914202 43687732572369991 873754651447399991 18348847680395400001 L4TES: A080048: a(2)=1 a(n)=n*a(n-1) + (n-1)*floor[(n+1)/2] for n>=3 c = a(n)/n! = 1.54308063481524377826 = (e+1/e)/2 for n--> infinity a(n) = floor [c*n!-(n+1)/2] for n>=2 1 7 34 182 1107 7773 62212 559948 5599525 61594835 739138086 9608795202 134523132919 2017846993897 32285551902472 548854382342168 9879378882159177 187708198761024543 3754163975220491050 78837443479630312270 L4REV: A080049: a(2)=0, a(n)=n*a(n-1) + (n-1)*floor[(n-1)/2] c = a(n)/n! = 0.5430806.. for n--> infinity = (e+1/e)/2-1 a(n) = floor [c*n! - (n-1)/2] for n>=2 0 2 11 63 388 2734 21893 197069 1970726 21678036 260136487 3381774403 47344841720 710172625898 11362762014473 193166954246169 3477005176431178 66063098352192544 1321261967043851051 27746501307920872271 R. J. Ord-Smith: Generation of permutation sequences: Part 1 The Computer Journal Volume 13, Number 2 May 1970. pp.152-155 http://www3.oup.co.uk/jnls/list/computer_journal/hdb/Volume_13/Issue_02/default.html