Permutations

[Moneo]

Over at Qbasic.com, somebody posted the need for code for what he called "randomizing strings". What he actually needs is an algorithm for generating the list of permutations for a given string of unique characters.

Every place that I've looked for info regarding permutations, including Knuth's books, just gives the formula for counting the number of permutations, i.e., N!, plus a lot of talk about them. But none of these references gives you a method or algorithm for generating all the permutations.

For example, given the string containing A B C, the N! tells you that there are 6 permutations, which if you work it out by hand, gives you the following 6 permutations:
ABC ACB BAC BCA CAB CBA

iI'd like to see an algorithm that can generate the permutations for say a string with 2 to 9 characters. Obviously, there must be no duplicate permutations.

Do any of you guys have such an algorithm?

Thanks.

*****

[yetifoot]

I've posted one here before, i'll try and dig it up.

[yetifoot]

I can't find the post, but i found some code on disk.

I've modified it so it should be easier to convert for QB.
I only ran a quick check, so i can't promise it's bug free. I also include my original FB code for those interested.

Code:

Option Explicit
  
Declare Sub Generate_Combinations(AllowedChars As String,_
                                  MinChars     As Integer,_
                                  MaxChars     As Integer)  
  
Sub Generate_Combinations(AllowedChars As String, _
                          MinChars     As Integer, _
                          MaxChars     As Integer)
  Dim NumOutChars As Integer
  Dim CurrComb As Long
  Dim strCurrComb As String
  Dim strCurrCombPos As Integer
  Dim lenAllowedChars As Integer
  Dim tmpPower As Integer

    lenAllowedChars = Len(AllowedChars)
    
    For NumOutChars = MinChars To MaxChars
      
      For CurrComb = 0 To (lenAllowedChars ^ NumOutChars) - 1
        
        strCurrComb = Space(NumOutChars)
        
        For strCurrCombPos = NumOutChars - 1 To 0 Step -1
          tmpPower = lenAllowedChars ^ strCurrCombPos
          Mid(strCurrComb, NumOutChars - strCurrCombPos, 1) = Mid(AllowedChars, ((CurrComb MOD (lenAllowedChars) * tmpPower) \ tmpPower + 1), 1)
          If strCurrCombPos = 0 Then Exit for
        Next strCurrCombPos
        
        Print strCurrComb
        
      Next CurrComb
      
    Next NumOutChars
    
End Sub

Generate_Combinations("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !£$%&*@'#.-_=+/\", 1, 4)

The FB original.

Code:

#include "crt.bi"
'#include "YFLib.bi"

Option Explicit
  
  Declare Sub Generate_Combinations(AllowedChars As ZString ptr,_
                                    MinChars     As uInteger,_
                                    MaxChars     As uInteger)  
  
  Generate_Combinations("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !£$%&*@'#.-_=+/\", 1, 4)

  system_("PAUSE")

Sub Generate_Combinations(AllowedChars As ZString ptr,_
                          MinChars     As uInteger,_
                          MaxChars     As uInteger)
                          
  Dim NumOutChars As uLongInt
  Dim CurrComb As uLongInt
  Dim strCurrComb As ZString ptr
  Dim strCurrCombPos As uLongInt
  Dim lenAllowedChars As uLongInt
  Dim tmpPower As uLongInt
  Dim NewLine As ZString * 2
  
    NewLine[0] = 13
    NewLine[1] = 10  
  
    lenAllowedChars = strlen(AllowedChars)
    strCurrComb = malloc(MaxChars - MinChars + 2)
    
    For NumOutChars = MinChars To MaxChars
      
      Print NumOutChars
      
      For CurrComb = 0 To (lenAllowedChars ^ NumOutChars) - 1
        
        strCurrComb[0] = 0
        
        For strCurrCombPos = NumOutChars - 1 To 0 Step -1
          tmpPower = pow(lenAllowedChars, strCurrCombPos)
          strCurrComb[(NumOutChars - 1) - strCurrCombPos] = AllowedChars[((CurrComb MOD (lenAllowedChars) * tmpPower) \ tmpPower + 1) - 1]  
          If strCurrCombPos = 0 Then Exit for
        Next strCurrCombPos
        
        strCurrComb[NumOutChars] = 0
        
        Print *strCurrComb
        
      Next CurrComb
      
    Next NumOutChars
    
    free(strCurrComb)
    
End Sub

[Moneo]

Thanks, Yetifoot, I'll give it a test.

EDIT:
Yetifoot,

I had a tough time getting it to compile with QuickBASIC 4.5., since it still had some FB stuff.

I finally got it to run, and tested with "ABC" with minchars=3 and maxchars=3. What it gave me was all the 27 COMBINATIONS of ABC and not the 6 permutations. The combinations include AAA AAB .... CCC.

Thanks. I do like it because it is completely algorithmic. I've got to figure out how it works, and then maybe I can modiify it to only generate only the permutations.

*****

[Agamemnus]

Lazy way out:

Code:

DEFINT A-Z

DECLARE SUB qsort.integer.lowstart (array1() AS INTEGER, amax AS INTEGER)

DIM stringlength AS INTEGER, permlength AS INTEGER

teststring$ = "blargity"
stringlength = LEN(teststring$)

'Let's convert this to numbers.
DIM intperm(0 TO stringlength-1) AS INTEGER

FOR i = 1 TO stringlength
intperm(i-1) = ASC(MID$(teststring$, i, 1))
NEXT i

'>Obviously, there must be no duplicate permutations.
'I would like to ignore the implicit 0-255 restrictions and use a quicksort on the list and then finally a follow through to get rid of duplicates.

qsort.integer.lowstart intperm(), stringlength-1

permlength = 1
FOR i = 1 TO stringlength-1
IF intperm(i) <> intperm(permlength-1) THEN
intperm(permlength) = intperm(i)
permlength = permlength + 1
END IF

NEXT i
DIM tempstring AS STRING: tempstring$ = space$(permlength)
DIM counter(0 TO permlength-2)

DO
counter(0) = counter(0) + 1
i=0

2
IF counter(i) > i+1 THEN
counter(i) = 0
i=i+1
IF i = permlength-1 THEN EXIT DO
counter(i) = counter(i) + 1
GOTO 2
END IF

FOR i = 0 TO permlength-2
SWAP intperm(i), intperm(counter(permlength-2-i)+i)
NEXT i

FOR t = 0 TO permlength-1
MID$(tempstring$, t+1,1) = CHR$(intperm(t))
NEXT t: PRINT tempstring$; " ";

FOR i = permlength-2 TO 0 STEP -1
SWAP intperm(i), intperm(counter(permlength-2-i)+i)
NEXT i
LOOP

SLEEP
SYSTEM


SUB qsort.integer.lowstart (array1() AS INTEGER, amax AS INTEGER)
DIM g2(0 TO amax) AS INTEGER, h2(0 TO amax) AS INTEGER, i AS INTEGER, j AS INTEGER, r AS INTEGER, E AS INTEGER, g AS INTEGER, h AS INTEGER, k AS INTEGER
E = 0: g2(0) = 0: h2(0) = amax
e1: g = g2(E): h = h2(E)
e2: i = g: j = h: r = (g + h) \ 2: k = array1(r)
e3: IF array1(i) < k THEN i = i + 1: GOTO e3
e4: IF array1(j) > k THEN j = j - 1: GOTO e4
IF i <= j THEN SWAP array1(i), array1(j): i = i + 1: j = j - 1: IF i <= j THEN GOTO e3
IF j - g + i < h THEN
IF i < h THEN g2(E) = i: h2(E) = h: E = E + 1
h = j
ELSE
IF g < j THEN g2(E) = g: h2(E) = j: E = E + 1
g = i
END IF
IF g < h THEN GOTO e2 ELSE E = E - 1: IF E >-1 THEN GOTO e1
ERASE g2, h2
END SUB

[yetifoot]

no problem moneo, sorry it wasn't what you wanted, but glad to hear you like it anyway!

Nice work agamemnus. Do you think that is the best way to do it? It seems a bit excessive using a qsort, but i've never tried to do it myself so I don't know any better way.

[Moneo]

Lazy way out:
......

Thanks for posting a solution, Aga.

I modified the test word to ABC. It printed the following 5 permutations to the screen: ACB BAC BCA BAC BCA

Asuming that the original permutation of ABC does not print, then you should have 6 permutations in total, the original plus 5.

However, BAC and BCA are both duplicated, and CAB and CBA are both missing. The duplicates are a common error for other attempts at this solution. The 2 missing permutations are a new problem.

If you know of quick fix, please post it.

*****

[Agamemnus]

Yeh, the reverse-swap isn't a reverse swap. Needs to go backwards... should be fixed now.

Yetifoot: No I do not think it is the best way... there is something simpler.... I'm sure of it.

[Moneo]

Yeh, the reverse-swap isn't a reverse swap. Needs to go backwards... should be fixed now......

Aga, sorry for the delay.
I tested your revised version with ABC, and it works fine generating:
ACB BAC BCA CBA CAB.

My only minor comments are:
1) It doesn't display the original ABC which is also one of the permutations.

2) The last 2 permutaions (CBA and CAB) are not in sequence.

iI tested again using ABCD, also ecountering several permutations out of sequence.

Actually, the need for generating the permutations in strict sequence, was not part of the original specifications. Therefore, your solution works fine.

Thanks again.

*****

[Moneo]

I continued to search my books at home and the Internet for algorithms for the generating of permutations. It's amazing all the bla, bla, bla that's written regarding permutations, but without any algorithms.

In desperation, I searched the Internet in Spanish. I encountered one document by a university professor, Leopoldo Silva, in Chile. He showed the following very simple algorithm for generating the permutations of 1,2,3:

Code:

defint a-z
for i=1 to 3
    for j=1 to 3
        for k=1 to 3
            if i<>j and i<>k and j<>k then
               print i;j;k
            end if
        next k
    next j
next i
system

Basically what it does is generate all the numbers between 111 and 333, and then using an IF, filter out alll the numbers not wanted. It works perfectly, generating all 6 permutations.

IMHO this is not truly an algorithm, per se, because of the filtering process.

Inspired by Professor Silva's approach, I designed what I consider a more efficient program, still using a filter, which will generate the permutations for 123 or 1234 or 12345.

Code:

defint a-z
cls
DO
  print "Enter 3,4 or 5 for size of permutations ";
  input size$
LOOP WHILE size$<>"3" and size$<>"4" and size$<>"5"

max=val(size$)
dim x as single
dim xfrom as integer
dim xto as single
xfrom=val(mid$("12345",1,max))
xto=val(right$("54321",max))

for x=xfrom to xto
    gosub filter
    if ok=1 then print x
next x
system

filter:
  ok=0
  dup=0
  s$=ltrim$(str$(x))
  for z=1 to len(s$)
      c=val(mid$(s$,z,1))
      if c<1 or c>max then RETURN
      if (dup and 2^c) > 0 then RETURN
      dup = dup or 2^c
  next z
  ok=1
RETURN

Your comments will be appreciated. Thanks.
*****