Permutation listing

[casco]

A few years ago, I wanted to do some matching that required a list of permutated items. Permutation is a process during which a set (by definition) of items is reorganized all possible ways. So if there is a set A={1 2 3}, then there are 6=1*2*3 permutations of A: {1 2 3} {1 3 2} {2 1 3} {2 3 1} {3 1 2} {3 2 1}.
Fortunately, my matching experiment required shuffling around only five and then six items, because, as I found out, my way of creating the list of possibilities became unrealistic when the set included eight or more items. That's because I couldn't figure out any other way to accomplish the task but create nested FOR/NEXT loops and filter out what I didn't need, as shown in the attached code.
Is there a way to write an efficient, but not robust, code that doesn't require rummaging through n^n possibilities?

'permutated list of five numbers
note$="Perm(5)= 5! = 1*2*3*4*5 = 120"

for a=1 to 5
for b=1 to 5
for c=1 to 5
for d=1 to 5
for e=1 to 5

  sum =a+b+c+d+e
  prod=a*b*c*d*e
    if sum=15 and prod=120 then
       cnt=cnt+1
       print cnt;tab(8);a;b;c;d;e
    end if

next:next:next:next:next

print: print note$
end


[B+]

'ordered permutations forJB v1.01 [B+=MGA] 2016-07-21
'recursive ordered permutations
'if 1st element < 2nd element < 3rd element... then list ascends

s$="1234567"
global ls, index
ls = len(s$) : index = 0
dim c$(ls)
call orderperm s$


sub orderperm r$
   scan
   if len(r$) = 0 then
       index = index + 1
       print index;": ";
       for i = 1 to ls
           print c$(i);
       next
       print
   else
       lr = len(r$)
       for i = 1 to lr
           c$(ls - lr + 1) = mid$(r$, i, 1)
           r1$ = mid$(r$, 1, i - 1) + mid$(r$, i + 1)
           call orderperm r1$
       next
   end if
end sub



[casco]

Thanks, B+.

That's a very efficient way to permutate, as I found out when I put a counter in the for i = 1 to lr loop where the program gets busy the most. As the number of the permutated items increases to n, the program goes through the loop k-times, where k = n! * e (e is the base of natural logarithms).

There has to be some adjustment made in the sub when the number of permutated items reaches 10 and more, because s$= "1234567891011..." won't work.

I'll take the code to the debugger for the step-by-step walkaround to see if I ever understand the trick that makes the quick reshuffling possible.

[tsh73]

There has to be some adjustment made in the sub when the number of permutated items reaches 10 and more, because s$= "1234567891011..." won't work.

Not quite
If you set
s$="89ABC"
it would work just as good as
s$="12345"
(just tested).

The question is are you ready to wait that long?
if I comment out printing,
(that is, it generates permutations but does nothing at all with them)
then N=8 takes 2 second on my box. (8! = 40320)
That means
2*9*10 = 180 sec = 3 min for N=10 (10! = 8!*9*10 = 3628800)
And 3min* 11 = 33 min for N=11. (11! = 39916800)
But you surely going to do something with it - it will take longer.
It grows really fast.

[B+]

Here I coded a number to a word and list a permutation of words:
'permutations for JB v1.01 [B+=MGA] 2017-02-17
'recursive ordered permutations
'if 1st element < 2nd element < 3rd element... then list acsends
' modify ordered permutaions to handle words in string

wordList$ = "cat dog fox rat"
wc = wcnt(wordList$)
if wc > 9 then print "Too many words, bye!" : end
dim p$(factorial(wc))
s$ = mid$("123456789", 1, wc)

global ls, index
ls = len(s$) : index = 0
dim c$(ls)
call orderperm s$  'load perms p$()
for i = 1 to factorial(wc)
   scan
   for j = 1 to ls
       scan
       print word$(wordList$, val(mid$(p$(i),j,1)));" ";
   next
   print
next


sub orderperm r$
   scan
   if len(r$) = 0 then
       index = index + 1
       for i = 1 to ls
           b$ = b$ + c$(i)
       next
       p$(index) = b$
   else
       lr = len(r$)
       for i = 1 to lr
           c$(ls - lr + 1) = mid$(r$, i, 1)
           r1$ = mid$(r$, 1, i - 1) + mid$(r$, i + 1)
           call orderperm r1$
       next
   end if
end sub

function wcnt(s$)
   do
       cnt = cnt + 1
   loop until word$(s$, cnt) = ""
   wcnt = cnt - 1
end function

function factorial(n)
   f = 1
   for i = 2 to n
       f = f * i
   next
   factorial = f
end function


If you do run a higher list than 8 items, I suggest filing it so you only have to do it once.

[casco]

Oh yes. It doesn't matter which character is inside the string, as long as it is a distinct single character. But, as you showed in the second version, things can be adjusted and the string can contain spaced items/numbers: wordList$="8 9 10..."

Well, brute force doesn't work well with the permutations, because if it takes 33 minutes to go through 11! permutations, then m=23! is the time in minutes that you need to spare for the journey back to the Big Bang and back.

I will attempt to understand how the code sort things out.

What key do I need to press to make SCAN work?

[B+]

Scan allows a quit from inside a loop, click X in window top right corner to quit calculation. Very handy while debugging code (exit infinite loop) or long calculation you might want to end before done.

[Rod]

Scan reads the event queue. So if you have clicked close or pressed CtrlBreak Just BASIC will branch to the handler for the event. If you don't have Scan Just BASIC will never look at the event queue and just keep looping.