Permutation Problem

[Paulie]

My Current Code:

_permutate("a","b","c")

Func _Permutate($item1, $item2, $item3="",$item4="",$item5="",$item6="",$item7="",$item8="",$item9="",$item10="",);There are way more than 10 parameters here
    Local $b=0,$c=0
    ;Gets items in parameters into an array.
    For $a = 1 to 250
        If Not Eval("item"&$a) = "" Then
            $b+=1
        EndIf
    Next
    Local $items[$b+1]
    $items[0] = $b
    For $a = 1 to 250
        If Not Eval("item"&$a) = "" Then
            $c+=1
            $items[$c] = String(Eval("item"&$a))
        EndIf
    Next
    ;==================================
    ;Permutate
        ;.....
EndFunc

My Problem:

I need to figure out what to put at the end of this function that can take the items in array "$items[]" and arrange them in every possible order.

Basically, I need the code above to return:(preferably in an array)

CODE

a

b

c

ab

ac

ba

bc

ca

cb

abc

acb

bac

bca

cab

cba

This would normally just require some For...Next loops, however, it needs to also work with other things

for instance it would need to be able to do the same for "a"b"c"d"

I've been at this for a while, and my brains going

any ideas?

[improbability_paradox]

Here is the beginnings of a solution that I just put together. It took me awhile to get it to work how I intended, and I believe that it could be optimized considerably (the code in the function is VERY sloppy at the moment...)

expandcollapse popup

$array=_Permutate("A|B|C",0,0,1)
Run("notepad.exe")
WinWaitActive("Untitled")
For $i = 0 to $array[0]
    Send($array[$i])
    Send(@CRLF)
Next

Func _Permutate($PDInput, $POCount=0, $PMethod=0, $RPD=0)
    ;$PDInput: Structure containing data to be used for permutations
    ;$PDInput is a structure whose elements are separated by |
    ;$POCount: The number of objects in the final permutation
    ;$PMethod: 0=With Repetition, 1=Without Repetition, 2=Arrangements
    $PDInput=StringSplit($PDInput,"|")
    If $PDInput[0]=1 Then Return 0
    $POCount=Int($POCount)
    If $POCount<1 Then $POCount=$PDInput[0]
    $PMethod=Int($PMethod)
    If $PMethod>2 or $PMethod<0 Then $PMethod=0
    If $POCount>$PDInput[0] and $PMethod>0 Then $POCount=$PDInput[0]
    Local $PData
    Switch $PMethod
        Case 0
            ;n^r
            $PData=($PDInput[0]^$POCount)
            If $RPD=0 Then Return $PData
            Local $PDataA[$PData+1]
            $PDataA[0]=1
            Local $R[$POCount+1]
            $R[0]=1
            Local $NPos[$POCount+1]
            For $NPCount = 1 to $POCount
                $NPos[$NPCount]=1
            Next
            $NPos[0]=0
            While 1
                If $NPos[$R[0]] > $PDInput[0] Then
                    If $R[0]=1 Then ExitLoop
                    $NPos[$R[0]] = 1
                    $R[0] -= 1
                    ContinueLoop
                EndIf
                $R[$R[0]] = $PDInput[$NPos[$R[0]]]
                If $R[0]=$POCount Then
                    If $PDataA[0] > $PData Then ReDim $PDataA[$PDataA[0]+1]
                    For $PDCount = 1 to $POCount
                        $PDataA[$PDataA[0]] &= $R[$PDCount]
                    Next
                    $PDataA[0] += 1
                EndIf
                If $NPos[$R[0]] < $PDInput[0] Then 
                    $NPos[$R[0]] += 1
                    If $R[0] < $POCount Then $R[0] += 1
                ElseIf $NPos[0] = 1 And $R[0] < $POCount Then
                    $NPos[0] = 0
                    $NPos[$R[0]] += 1
                    $R[0] += 1
                Else
                    $NPos[$R[0]] = 1
                    $R[0] -= 1
                    $NPos[0] = 1
                EndIf
                
            WEnd
            $PDataA[0] -= 1
            if $PDataA[0]>$PData Then SetError(1)
            Return $PDataA
            
        Case 1
            
            
        Case 2
            
            
            
    EndSwitch
EndFunc

the cases where $PMethod is set to 1 or 2 have obviously not been written yet. The equations that I know to calculate the number of those types of permutations rely on calculating factorials, so a function will need to be written to handle that mathematical expression. Anyway, this may work for you as a start.

[DaleHohm]

This is typically and easily resolved with recursion

Try Google for "permutate recursion" and you'll find lots of example algorithms

Dale

[Uten]

JdeB's solution should give you some hints.

Seems like it can be optimized a bit though, but I have not given it a try.

If you are solving this with recursion remember that recursion, although a strong technique, can kill your computing speed if it forces the OS to swap data to disk. At least consider it before selecting the best implementation..

[jvanegmond]

This one is by /dev/null

expandcollapse popup

$permutarray = permute("1234")
$msg = ""
For $n = 1 To $permutarray[0]
    $msg = $msg & $permutarray[$n] & @CRLF
Next
MsgBox(0,"", $msg)

Func rotate($sString, $nRotateLevel)
    Local $aStringArray = StringSplit($sString,"")
    Local $nStartRotate = $aStringArray[0] - $nRotateLevel + 1
    Local $n, $tempchar, $tempstr = "", $retval = ""
    For $n = 1 To $nStartRotate - 1
        $tempstr= $tempstr & $aStringArray[$n]
    Next
    $tempchar = $aStringArray[$nStartRotate]
    For $n = $nStartRotate+1 To $aStringArray[0]
        $retval = $retval & $aStringArray[$n]
    Next
    $retval = $tempstr & $retval & $tempchar
    Return $retval
EndFunc   ;==>rotate

Func permute_internal($sString, $nRotateLevel, ByRef $permutations)
    Local $n, $str
    Dim $arr[$nRotateLevel]
    If $nRotateLevel = 2 Then
        $permutations = $permutations & ":" & rotate($sString,$nRotateLevel)
        Return
    EndIf
    $str = $sString
    For $n = 0 To $nRotateLevel -1
        $str = rotate($str,$nRotateLevel)
        $arr[$n] = $str
        ;--- special check, to stop a level beeing printed twice ---
        If not (($n = 0) AND (StringLen($sString) > $nRotateLevel)) Then
            $permutations = $permutations & ":" & $arr[$n]
        EndIf
        permute_internal($arr[$n],$nRotateLevel-1,$permutations)
    Next
EndFunc   ;==>permute_internal

Func permute($sString)
    Global $permutations = ""
    permute_internal($sString,StringLen($sString),$permutations)
    $permutations = StringTrimLeft($permutations,1)
    Return StringSplit($permutations,":")
EndFunc   ;==>permute

Edited April 6, 2007 by Manadar

[DaleHohm]

This is typically and easily resolved with recursion

Try Google for "permutate recursion" and you'll find lots of example algorithms

Dale

I want to refine what I said on this topic. It appears that it is a classic homework assignment to be asked to solve this both with and without recursion, so saying this is typically resolved with recursion is not accurate. Let me say instead that this can efficiently and elegantly be solved with recursion (meaning with a lot less code than without recursion).

Uten, I'm not sure why you would warn against recusion as you did. There is nothing inherently bad about recursion or anything that causes hard disk writes -- it is, however, notoriously easy to mess up the recursion level exit logic and end up spinning out of control into a recursive black hole, but there is no escaping bad code and recursive routines just do a better job of punishing you for it than other approaches typically can.

Dale

[improbability_paradox]

expandcollapse popup

MsgBox(0,"",_Permutate("A|A|A|B|B|C|C|C|C|D",0,2))
MsgBox(0,"",_Permutate("A|B|C|D|E",3) & @TAB & _Permutate("A|B|C|D|E",3,1) & @TAB & _Permutate("A|B|C|D|E",0,2))

$array=_Permutate("A|B|C|D|E",3,0,1,", ")
Run("notepad.exe")
WinWaitActive("Untitled")
For $i = 0 to $array[0]
    Send($array[$i])
    Send(@CRLF)
Next

Func _Permutate($PDInput, $POCount=0, $PMethod=0, $RPD=0, $POSChars="", $PDISep="|")
    ;$PDInput: Structure containing data to be used for permutations
    ;$PDInput is a structure whose elements are separated by | (or $PDISep)
    ;$POCount: The number of objects in the final permutation
    ;$PMethod: 0=With Repetition, 1=Without Repetition, 2=Arrangements
    $PDInput=StringSplit($PDInput,$PDISep)
    If $PDInput[0]=1 Then Return 0
    $POCount=Int($POCount)
    If $POCount<1 Then $POCount=$PDInput[0]
    $PMethod=Int($PMethod)
    If $PMethod>2 or $PMethod<0 Then $PMethod=0
    If $POCount>$PDInput[0] and $PMethod>0 Then $POCount=$PDInput[0]
    Local $PData
    Switch $PMethod
        Case 0
            ;n^r
            $PData=($PDInput[0]^$POCount)
            If $RPD=0 Then Return $PData
            Local $PDataA[$PData+1]
            $PDataA[0]=1
            Local $R[$POCount+1]
            $R[0]=1
            Local $NPos[$POCount+1]
            For $NPCount = 1 to $POCount
                $NPos[$NPCount]=1
            Next
            $NPos[0]=0
            While 1
                If $NPos[$R[0]] > $PDInput[0] Then
                    If $R[0]=1 Then ExitLoop
                    $NPos[$R[0]] = 1
                    $R[0] -= 1
                    ContinueLoop
                EndIf
                $R[$R[0]] = $PDInput[$NPos[$R[0]]]
                If $R[0]=$POCount Then
                    If $PDataA[0] > $PData Then ReDim $PDataA[$PDataA[0]+1]
                    For $PDCount = 1 to $POCount
                        $PDataA[$PDataA[0]] &= $R[$PDCount] & $POSChars
                    Next
                    $PDataA[$PDataA[0]] = StringTrimRight($PDataA[$PDataA[0]],StringLen($POSChars))
                    $PDataA[0] += 1
                EndIf
                If $NPos[$R[0]] < $PDInput[0] Then 
                    $NPos[$R[0]] += 1
                    If $R[0] < $POCount Then $R[0] += 1
                ElseIf $NPos[0] = 1 And $R[0] < $POCount Then
                    $NPos[0] = 0
                    $NPos[$R[0]] += 1
                    $R[0] += 1
                Else
                    $NPos[$R[0]] = 1
                    $R[0] -= 1
                    $NPos[0] = 1
                EndIf
                
            WEnd
            $PDataA[0] -= 1
            if $PDataA[0]>$PData Then SetError(1)
            Return $PDataA
            
        Case 1
            ;n!/(n-r)! or P(n,r)
            $PData=(_Factorial($PDInput[0],$PDInput[0]-$POCount));/_Factorial(($PDInput[0]-$POCount)))
            If $RPD=0 Then Return $PData
            Local $PDataA[$PData+1]
            
            
        Case 2
            ;n!/(a1!*...*ak!)
            Local $ArrangeObjects[$PDInput[0]+1][2]
            $ArrangeObjects[0][0]=1
            While $ArrangeObjects[0][0]<($PDInput[0]+1)
                For $ACount = 1 to $ArrangeObjects[0][1]
                    If $ArrangeObjects[$ACount][1]=$PDInput[$ArrangeObjects[0][0]] Then 
                        $ArrangeObjects[0][0] += 1
                        ContinueLoop 2
                    EndIf
                Next
                $ArrangeObjects[0][1] += 1
                $ArrangeObjects[$ArrangeObjects[0][1]][1]=$PDInput[$ArrangeObjects[0][0]]
                For $ACount = $ArrangeObjects[0][0] to $PDInput[0]
                    If $ArrangeObjects[$ArrangeObjects[0][1]][1]=$PDInput[$ACount] Then $ArrangeObjects[$ArrangeObjects[0][1]][0] += 1
                Next
                $ArrangeObjects[0][0] += 1
            WEnd
            ReDim $ArrangeObjects[($ArrangeObjects[0][1]+1)][2]
            $ArrangeObjects[0][0]=$PDInput[0];$POCount
            $PData=1
            For $ACount = 1 to $ArrangeObjects[0][1]
                $PData *= _Combination($ArrangeObjects[0][0],$ArrangeObjects[$ACount][0])
                $ArrangeObjects[0][0]-=$ArrangeObjects[$ACount][0]
            Next
            If $RPD=0 Then Return $PData
            
    EndSwitch
EndFunc

Func _Factorial($n, $nfs=1)
    ;n(n-1)(n-2)(n-3)...(n-(n-1))
    ;0! = 1
    ;a special provision ($nfs) has been incorporated to modify the 
    ;stoping point so that it can be some number other than (n-(n-1))
    $n=Int($n)
    If $n<0 Then Return 0
    If $n<2 Then Return 1
    $nfs=Int($nfs)
    If $nfs<1 Then $nfs=1
    Local $nr=1
    While $n>$nfs
        $nr *= $n
        $n -= 1
    WEnd
    Return $nr
EndFunc

Func _Combination($n,$r)
    ;C(n,r)=n!/((n-r)!*r!) or P(n,r)/r! where P(n,r)=n!/(n-r)!
    $n=Int($n)
    $r=Int($r)
    ;Don't know what to do yet with zeros or negatives...
    If $n<1 Or $r<1 Then Return 1
    Return (_Factorial($n,$n-$r)/_Factorial($r))
    ;alternately:
    Return (_Factorial($n)/(_Factorial(($n-$r))*_Factorial($r)))
EndFunc

The code has been enhanced a little bit. Methods 1 and 2 should now return the correct number of possible permutations, but I have not yet written the code to return the permutations themselves. The code has not been cleaned up, but I figure that can wait until all of the methods have been completely coded.

[litlmike]

http://www.autoitscript.com/forum/index.ph...t=0#entry541514