Need Permutation Algorithm

[rdonnay]

I am trying to create code that returns an array of all permutations of a letter combination in a string.

For example, if I have the string 'ABC', it would return the following array:

{ 'ABC','ACB','BCA','BAC','CAB','CBA' }

I found some PHP code that does this, but I don't understand the FOREACH loop, even though I have a book on PHP. I'm trying to convert the below code to Xbase++. Does anyone have any ideas?

aArray := Permute('ABC')

This needs to be a fast algorithm because I will be using it for 7 character strings which produce a factorial (Array Size) of 5040.

Code: Select all

function permute($str) {
    /* If we only have a single character, return it */
    if (strlen($str) < 2) {
        return array($str);
    }

    /* Initialize the return value */
    $permutations = array();

    /* Copy the string except for the first character */
    $tail = substr($str, 1);

    /* Loop through the permutations of the substring created above */
    foreach (permute($tail) as $permutation) {
        /* Get the length of the current permutation */
        $length = strlen($permutation);

        /* Loop through the permutation and insert the first character of the original
        string between the two parts and store it in the result array */
        for ($i = 0; $i <= $length; $i++) {
            $permutations[] = substr($permutation, 0, $i) . $str[0] . substr($permutation, $i);
        }
    }

    /* Return the result */
    return $permutations;
}

[GeneB]

Roger,
See if something like this would work. I haven't tested it, it might have a typo. I'm sure this could be shortened with some macros in the loops. The array would have elements with characters duplicated "AABC", etc, but those could be removed.

-=# GeneB

Code: Select all

FUNCTION Permutat(cOrigStr)

local i,j, cChar ;
    ,cStr2, cStr3, cStr4, cStr5, cStr6, cStr7 ;
    ,aStr1:={}, aStr2:={}, aStr3:={}, aStr4:={}, aStr5:={}, aStr6:={}, aStr7:={}

IF EMPTY(cOrigStr)
   RETURN ""
ENDIF

cOrigStr := ALLTRIM(cOrigStr)


// create a permutation array 1 character wide
FOR i:=1 TO LEN(cOrigStr)
   cChar := SUBSTR(cOrigStr,i,1)
   AADD(aStr1,cChar)
NEXT


// create a permutation array 2 characters wide
FOR i:=1 TO LEN(cOrigStr)
   cChar := SUBSTR(cOrigStr,i,1)

   FOR j:=1 TO LEN(aStr1)
      cStr2 :=                     cChar + SUBSTR(aStr1[j],1)
      AADD(aStr2,cStr2)
   NEXT

   FOR j:=1 TO LEN(aStr1)
      cStr2 := SUBSTR(aStr1[j],1,1) + cChar
      AADD(aStr2,cStr2)
   NEXT
NEXT


// create a permutation array 3 characters wide
FOR i:=1 TO LEN(cOrigStr)
   cChar := SUBSTR(cOrigStr,2,1)

   FOR j:=1 TO LEN(aStr2)
      cStr3 :=                     cChar + SUBSTR(aStr2[j],1)
      AADD(aStr3,cStr3)
   NEXT

   FOR j:=1 TO LEN(aStr2)
      cStr3 := SUBSTR(aStr2[j],1,1) + cChar + SUBSTR(aStr2[j],2)
      AADD(aStr3,cStr3)
   NEXT

   FOR j:=1 TO LEN(aStr2)
      cStr3 := SUBSTR(aStr2[j],1,2) = cChar
      AADD(aStr3,cStr3)
   NEXT
NEXT


// create a permutation array 4 characters wide
FOR i:=1 TO LEN(cOrigStr)
   cChar := SUBSTR(cOrigStr,3,1)

   FOR j:=1 TO LEN(aStr3)
      cStr4 :=                     cChar + SUBSTR(aStr3[j],1)
      AADD(aStr4,cStr4)
   NEXT

   FOR j:=1 TO LEN(aStr3)
      cStr4 := SUBSTR(aStr3[j],1,1) + cChar + SUBSTR(aStr3[j],2)
      AADD(aStr4,cStr4)
   NEXT

   FOR j:=1 TO LEN(aStr3)
      cStr4 := SUBSTR(aStr3[j],1,2) + cChar + SUBSTR(aStr3[j],3)
      AADD(aStr4,cStr4)
   NEXT

   FOR j:=1 TO LEN(aStr3)
      cStr4 := SUBSTR(aStr3[j],1,3) + cChar
      AADD(aStr4,cStr4)
   NEXT
NEXT


// create a permutation array 5 characters wide
FOR i:=1 TO LEN(cOrigStr)
   cChar := SUBSTR(cOrigStr,4,1)

   FOR j:=1 TO LEN(aStr4)
      cStr5 :=                     cChar + SUBSTR(aStr4[j],1)
      AADD(aStr5,cStr5)
   NEXT

   FOR j:=1 TO LEN(aStr4)
      cStr5 := SUBSTR(aStr4[j],1,1) + cChar + SUBSTR(aStr4[j],2)
      AADD(aStr5,cStr5)
   NEXT

   FOR j:=1 TO LEN(aStr4)
      cStr5 := SUBSTR(aStr4[j],1,2) + cChar + SUBSTR(aStr4[j],3)
      AADD(aStr5,cStr5)
   NEXT

   FOR j:=1 TO LEN(aStr4)
      cStr5 := SUBSTR(aStr4[j],1,3) + cChar + SUBSTR(aStr4[j],4)
      AADD(aStr5,cStr5)
   NEXT

   FOR j:=1 TO LEN(aStr4)
      cStr5 := SUBSTR(aStr4[j],1,4) + cChar
      AADD(aStr5,cStr5)
   NEXT
NEXT


// create a permutation array 6 characters wide
FOR i:=1 TO LEN(cOrigStr)
   cChar := SUBSTR(cOrigStr,5,1)

   FOR j:=1 TO LEN(aStr5)
      cStr6 :=                     cChar + SUBSTR(aStr5[j],1)
      AADD(aStr6,cStr6)
   NEXT

   FOR j:=1 TO LEN(aStr5)
      cStr6 := SUBSTR(aStr5[j],1,1) + cChar + SUBSTR(aStr5[j],2)
      AADD(aStr6,cStr6)
   NEXT

   FOR j:=1 TO LEN(aStr5)
      cStr6 := SUBSTR(aStr5[j],1,2) + cChar + SUBSTR(aStr5[j],3)
      AADD(aStr6,cStr6)
   NEXT

   FOR j:=1 TO LEN(aStr5)
      cStr6 := SUBSTR(aStr5[j],1,3) + cChar + SUBSTR(aStr5[j],4)
      AADD(aStr6,cStr6)
   NEXT

   FOR j:=1 TO LEN(aStr5)
      cStr6 := SUBSTR(aStr5[j],1,4) + cChar + SUBSTR(aStr5[j],5)
      AADD(aStr6,cStr6)
   NEXT

   FOR j:=1 TO LEN(aStr5)
      cStr6 := SUBSTR(aStr5[j],1,5) + cChar
      AADD(aStr6,cStr6)
   NEXT
NEXT


// create a permutation array 7 characters wide
FOR i:=1 TO LEN(cOrigStr)
   cChar := SUBSTR(cOrigStr,6,1)

   FOR j:=1 TO LEN(aStr6)
      cStr7 :=                     cChar + SUBSTR(aStr6[j],1)
      AADD(aStr7,cStr7)
   NEXT

   FOR j:=1 TO LEN(aStr6)
      cStr7 := SUBSTR(aStr6[j],1,1) + cChar + SUBSTR(aStr6[j],2)
      AADD(aStr7,cStr7)
   NEXT

   FOR j:=1 TO LEN(aStr6)
      cStr7 := SUBSTR(aStr6[j],1,2) + cChar + SUBSTR(aStr6[j],3)
      AADD(aStr7,cStr7)
   NEXT

   FOR j:=1 TO LEN(aStr6)
      cStr7 := SUBSTR(aStr6[j],1,3) + cChar + SUBSTR(aStr6[j],4)
      AADD(aStr7,cStr7)
   NEXT

   FOR j:=1 TO LEN(aStr6)
      cStr7 := SUBSTR(aStr6[j],1,4) + cChar + SUBSTR(aStr6[j],5)
      AADD(aStr7,cStr7)
   NEXT

   FOR j:=1 TO LEN(aStr6)
      cStr7 := SUBSTR(aStr6[j],1,5) + cChar + SUBSTR(aStr6[j],6)
      AADD(aStr7,cStr7)
   NEXT

   FOR j:=1 TO LEN(aStr6)
      cStr7 := SUBSTR(aStr6[j],1,6) + cChar
      AADD(aStr7,cStr7)
   NEXT
NEXT


// merge all arrays
FOR i:=1 TO LEN(aStr1)
   AADD(aStr7,aStr1[i])
NEXT

FOR i:=1 TO LEN(aStr2)
   AADD(aStr7,aStr2[i])
NEXT

FOR i:=1 TO LEN(aStr3)
   AADD(aStr7,aStr3[i])
NEXT

FOR i:=1 TO LEN(aStr4)
   AADD(aStr7,aStr4[i])
NEXT

FOR i:=1 TO LEN(aStr5)
   AADD(aStr7,aStr5[i])
NEXT

FOR i:=1 TO LEN(aStr6)
   AADD(aStr7,aStr6[i])
NEXT


// remove elements with duplicated letters from aStr7


RETURN aStr7

[rdonnay]

Gene -

My goal for this project is to handle permutations of 7 letters. I only showed 3 letters for simplicity.
The algorithm must be recursive and fast. I already wrote a few algorithms to handle 3 or 4 letters but that was not practical. I am trying to understand the PHP code so I can convert it to Xbase++.

Thanks.

Roger

[skiman]

Hi Roger,

If less than one second to perform this task is fast enough, the following code maybe helps.

Code: Select all

Local s1 := {} , s0 := "ABCDEFG" , s2 := time()
for x = 1 to len(s0)
	s1 := permutate(s0,s1,x)
next
wtf len(s1), s1 ,s2 , time() pause
return nil

function Permutate(cS, aArray,nByte)
local aNewArray := {} , x

for x = 1 to len(cS)
	if !empty(aArray)
		for y = 1 to len(aArray)
			if !str(x,1) $ aArray[y][2]
				aadd(aNewArray,{aArray[y][1]+substr(cs,x,1),aArray[y][2]+str(x,1) })
			endif
		next
	  else
		aadd(aNewArray,{substr(cs,x,1),str(x,1)} )
	endif
next

return aNewArray

[rdonnay]

Chris -

Thanks. I'll give it a try.

Roger

[GeneB]

In the example I attached previously, the last array created would contain strings of 7 characters. If those strings were the only strings required, skip the last step of merging the arrays together.
The single, double, triple, etc. character arrays are created to build all possibilities of the 7 character string.
-=# GeneB

[rdonnay]

Gene -

I will give your code a try.
I tried Chris' code first and it works very good and fast.
I will try yours too.

Thanks.

Roger

[rdonnay]

Chris -

Your code works excellently.
It is much simpler and easier to follow than any of the permutation code I found on the internet written in C, C++, C#, Python, Perl or PHP.

That's why I love Xbase++.

I made a few small mods to the code to make it run a little faster. It now runs about 2x faster.
On my notebook computer it builds the 5040 element array in .08 seconds. After I sort the array and write it out to a file it still only takes .2 seconds.

This is going to be used in my Scrabble game software. I want players to be able to play against the computer.

Thanks for that.
Good work.

Roger

New code:

Code: Select all

#INCLUDE "dcdialog.CH"

PROC appsys ; return

FUNCTION Main

Local s1 := {} , cString := "ABCDEFG" , s2 := seconds()
LOCAL cText := '', nByte, i

for nByte := 1 to len(cString)
   s1 := permutate( cString, s1, nByte )
next

ASort(s1,,,{|a,b|a[1]<b[1]})

FOR i := 1 TO Len(s1)
  cText += s1[i,1] + Chr(13)+Chr(10)
NEXT

MemoWrit('PERMUTATIONS.TXT', cText)

DCMSGBOX 'Done'

return nil

* --------------

function Permutate( cString, aArray, nByte )

LOCAL aNewArray[0] , x, y, cNumber

FOR x := 1 to Len(cString)
  cNumber := Str(x,1)
  IF !Empty(aArray)
    FOR y := 1 TO Len(aArray)
      IF !cNumber $ aArray[y,2]
        Aadd( aNewArray, { aArray[y,1]+cString[x], aArray[y,2]+cNumber } )
      ENDIF
    NEXT
  ELSE
    Aadd( aNewArray,{ cString[x], cNumber } )
  ENDIF
NEXT

RETURN aNewArray

[Paul]

Roger -

this work 7x faster

Code: Select all

func perm_pb ()
local ar,i
local k1:='ABCDEFG'


ar:={k1[1]}

for i=2 to len(k1)
   ar:=perm(ar,k1[i])
next

retu NIL
********************
func perm (_a,_s)
local i,il:=len(_a),ar[0]

for i=1 to il
    perm1(@ar,_a[i],_s)
next
retu ar
****************
func perm1 (_a,_sm,_s)
local ip,i

ip:=len(_a)
asize(_a,ip+len(_sm)+1)

for i=len(_sm) to 0 step -1
   _a[++ip]:=left(_sm,i)+_s+subs(_sm,i+1)
next
retu _a
************************************

Paul

[rdonnay]

Paul -

You are right.
Your algorithm is about 7 times faster.

Thank you.

Roger