Permutations Generator

[bplus]

Handy Permutation Generator:

Code: QB64: [Select]

1. _TITLE "Permutations wo recursion" ' B+ translate from SmallBasic to QB64 2019-03-31
2. SCREEN _NEWIMAGE(600, 600, 32)
3. 'Permutations
4. 'translation from: PowerBASIC
5. 'tsh copy from Liberty link 2017-02-04
6. '   until (i=0) or (a(i)<a(i+1))
7. 'before executing i=i-1 in loop body.
8.  
9.  
10. 'let's load result$() with results
11. REDIM result$(0)
12. loadPerms 5, result$()
13. 'display result$
14. FOR i = 0 TO UBOUND(result$)
15.     PRINT i + 1, result$(i)
16.     IF i MOD 30 = 29 THEN
17.         PRINT "press any to continue..."
18.         SLEEP
19.         CLS
20.     END IF
21. NEXT
22.  
23. 'load dynamic string array r() with permutations of n digits
24. SUB loadPerms (n, r() AS STRING)
25.     DIM a(0 TO n + 1) '+1 needed due to bug in LB that checks loop condition
26.     FOR i = 0 TO n: a(i) = i: NEXT 'load a() with minimum values
27.     DO
28.         b$ = ""
29.         FOR i = 1 TO n
30.             b$ = b$ + STR$(a(i))
31.         NEXT
32.         REDIM _PRESERVE r(e)
33.         r(e) = b$
34.         e = e + 1
35.  
36.         i = n
37.         DO
38.             i = i - 1
39.         LOOP UNTIL (i = 0) OR (a(i) < a(i + 1))
40.         j = i + 1
41.         k = n
42.         WHILE j < k
43.             SWAP a(j), a(k)
44.             j = j + 1
45.             k = k - 1
46.         WEND
47.         IF i > 0 THEN
48.             j = i + 1
49.             WHILE a(j) < a(i)
50.                 j = j + 1
51.             WEND
52.             SWAP a(i), a(j)
53.         END IF
54.     LOOP UNTIL i = 0
55. END SUB
56.  
57.  

[Pete]

We've had a few of these over the years at: https://www.tapatalk.com/groups/qbasic/

One thread from 2010 with a few routines: https://www.tapatalk.com/groups/qbasic/math-expert-needed-for-permutation-problem-t37777.html

I put together something similar to solve Sudoku puzzles, but right now, I'm not sure where (what computer) it's on.

I did a little testing and helped debug this one, from a friend of mine, named Moneo: https://www.tapatalk.com/groups/qbasic/math-expert-needed-for-permutation-problem-t37777-s10.html

[bplus]

Here is a handier variation that translates a number permutation into a Values string setup in a ValuesData section:

Code: QB64: [Select]

1. _TITLE "Permutations with value translator" 'B+ add value translator 2019-03-31
2. 'from "Permutations wo recursion"  translate from SmallBasic to QB64 2019-03-31
3. 'from "Permutations" translation from: PowerBASIC, tsh copy from Liberty link 2017-02-04
4.  
5. SCREEN _NEWIMAGE(800, 600, 32)
6. _SCREENMOVE 300, 40
7.  
8. REDIM results$(0)
9. loadPermsValues results$()
10. 'display result$
11. FOR i = 0 TO UBOUND(results$)
12.     PRINT i + 1, results$(i)
13.     IF i MOD 30 = 29 THEN
14.         PRINT "press any to continue..."
15.         SLEEP
16.         CLS
17.     END IF
18. NEXT
19.  
20. ValuesData:
21. DATA "Steve","Pete","Fellippe","Bill","Ashish","Qwerky","Petr","TempodiBasic","Colbalt","END"
22.  
23. 'this reads data from ValuesData line and translates Permutations to those values
24. SUB loadPermsValues (r() AS STRING)
25.     'load values array one way or another? read data
26.     REDIM values(0) AS STRING
27.     RESTORE ValuesData
28.     DO
29.         READ r$
30.         IF r$ = "END" THEN
31.             done = 1
32.         ELSE
33.             n = n + 1
34.             REDIM _PRESERVE values(n) AS STRING
35.             values(n) = r$
36.         END IF
37.     LOOP UNTIL done
38.     n = UBOUND(values)
39.     DIM a(0 TO n + 1) '+1 needed due to bug in LB that checks loop condition: until (i=0) or (a(i)<a(i+1))
40.     FOR i = 0 TO n: a(i) = i: NEXT 'load a() with minimum values
41.     DO
42.         b$ = ""
43.         FOR i = 1 TO n
44.             b$ = b$ + values(a(i)) + " "
45.         NEXT
46.         REDIM _PRESERVE r(e)
47.         r(e) = b$
48.         e = e + 1
49.  
50.         i = n
51.         DO
52.             i = i - 1
53.         LOOP UNTIL (i = 0) OR (a(i) < a(i + 1))
54.         j = i + 1
55.         k = n
56.         WHILE j < k
57.             SWAP a(j), a(k)
58.             j = j + 1
59.             k = k - 1
60.         WEND
61.         IF i > 0 THEN
62.             j = i + 1
63.             WHILE a(j) < a(i)
64.                 j = j + 1
65.             WEND
66.             SWAP a(i), a(j)
67.         END IF
68.     LOOP UNTIL i = 0
69.     EXIT SUB
70. END SUB
71.  

362,880 = 9! of permutations of 9 members of this forum. :)