Way to make this faster?

[czardas]

I indicated earlier that I had some ideas about avoiding the duplicates. I doubt it will be able to handle your specifications, but this is much faster than creating all the permutations. The method still relies on _ArrayUnique(). The difference in speed is so great that I haven't had time to run proper tests.

This is a pretty interesting challenge and I imagine my code can be improved.. Since I'm unsure how to work out the number of results you will get with your specs, I still don't know how much, or even if, this code will be helpful to you. Even if you write to disk, I'm not optimistic about processing time.

expandcollapse popup

#include <Array.au3>

Dim $aArray[9] = ["a","a","a","b","b","b","c","c","c"]

$aRet = _PermuteUnique($aArray)
_ArrayDisplay($aRet, "Finished")

Func _PermuteUnique($aArray)
    Local $iBound = UBound($aArray), $sUniqStr = "", $sDupeStr = ""
    For $i = 0 To $iBound -1
        If StringInStr($sUniqStr, $aArray[$i]) Then
            $sDupeStr &= $aArray[$i]
        Else
            $sUniqStr &= $aArray[$i]
        EndIf
    Next

    $aDupe = StringSplit($sDupeStr, "", 2)
    $aUnique = StringSplit($sUniqStr, "", 2)
    $aUnique = _ArrayPermute($aUnique)
    _ArrayDelete($aUnique, 0)

    Local $iLen = StringLen($aUnique[0]), $iStart = 0
    _Recurse($aUnique, $aDupe, $iStart, $iLen)

    Return $aUnique
EndFunc

Func _Recurse(ByRef $aSeed, $aDupe, ByRef $iIndex, ByRef $iLen)
    If $iIndex = UBound($aDupe) Then Return
    Local $aTempArray = $aSeed, $iBound = UBound($aSeed), $iCount = 0

    ReDim $aSeed[$iBound*$iLen]
    For $i = 0 To $iBound -1
        For $j = 0 To $iLen
            $sTemp = $aTempArray[$i]
            $aSeed[$iCount] = StringLeft($sTemp, $j) & $aDupe[$iIndex] & StringRight($sTemp, $iLen - $j)
            $iCount += 1
            While StringMid($aTempArray[$i], $j +1, 1) = $aDupe[$iIndex]
                $j += 1
            WEnd
        Next
    Next
    ReDim  $aSeed[$iCount]
    $aSeed = _ArrayUnique($aSeed) ; Optimization improvements can be made here.
    _ArrayDelete($aSeed, 0)
    $iIndex += 1
    $iLen += 1
    _Recurse($aSeed, $aDupe, $iIndex, $iLen)
EndFunc

#cs
; This code is much slower (and more limited).
Dim $aPermute = _ArrayPermute($aArray)
_ArrayDelete($aPermute, 0)
$aPermute = _ArrayUnique($aPermute)
_ArrayDisplay($aPermute)
#ce

Edit

After a couple of tests, I have figured out that you will hit array limitations with unique permutations of approx 15 elements, => a, a, a, a, a, b, b, b, b, b, c, c, c, c, c

The earlier method would not be able to manage nearly so many. It may be possible to add one more value. This is no where near the 60 elements you wish to permute. I have also figured out that there is no storage device large enough to hold the number of permutations you seek.

Edited March 1, 2012 by czardas

[jb09]

WOW!!! That completed an 9 element array in 5 secs, executing all that code. Where as permute and unique seperate will not complete overnight, holding up on unique as permute will complete in about 24 secs.

So your limited to approx 15 elements, would we be able to combine your code with my idea to exceed 15? I know this isn't complete, just tested on a 9 element and went hay wire. But here is the code.

expandcollapse popup

#include <Array.au3>
$file = FileOpen("test.txt", 1)
$file2 = FileOpen("test2.txt", 1)
;Dim $dif[3]
;Dim $aArray[2] = ["a", "b"]
Dim $aArray[3] = ["a","b","c"]
;Dim $bArray[4] = ["a", "a", "b", "b"]
; Create "sub" arrays to get combinations
$aSubArray = _ArrayPermute($aArray, "") ; Produces too many unwanted duplicate patterns.
;_ArrayDisplay($aTestArray, "Array Permuted")
_ArrayDelete($aSubArray, 0)
$aSubArray = _ArrayUnique($aSubArray) ; Remove repeat patterns.
_ArrayDelete($aSubArray, 0)
;_ArrayDisplay($aTestArray, "Array Unique")
; Use "sub arrays to get combinations
$aTestArray = _ArrayPermute($aSubArray, "") ; Produces too many unwanted duplicate patterns.
;_ArrayDisplay($aTestArray, "Array Permuted")
_ArrayDelete($aTestArray, 0)
$aTestArray = _ArrayUnique($aTestArray) ; Remove repeat patterns.
_ArrayDelete($aTestArray, 0)
; An idea to play with, trying to add combinations missed for different number of $aArray sizes
$size = UBound($aSubArray)
For $a = 0 To $size - 1
Dim $aLoopArray[$size]
For $b = 0 To $size - 1
  $aLoopArray[$b] = $aSubArray[$a]
Next
Dim $aLoopTestArray = _ArrayPermute($aLoopArray)
_ArrayDelete($aLoopTestArray, 0)
$aLoopTestArray = _ArrayUnique($aLoopTestArray)
_ArrayDelete($aLoopTestArray, 0)
;_ArrayDisplay($aLoopTestArray)
_ArrayConcatenate($aTestArray, $aLoopTestArray)
Next
$size = UBound($aArray)
Dim $aLoopArray[$size]
For $c = 0 To $size - 1
Dim $aSubLoopArray[$size]
For $d = 0 To $size - 1
  $aSubLoopArray[$d] = $aArray[$c]
Next
$aLoopArray[$c] = _ArrayToString($aSubLoopArray, "")
Next
Dim $aLoopTestArray = _ArrayPermute($aLoopArray)
_ArrayDelete($aLoopTestArray, 0)
$aLoopTestArray = _ArrayUnique($aLoopTestArray)
_ArrayDelete($aLoopTestArray, 0)
_ArrayConcatenate($aTestArray, $aLoopTestArray)
_ArraySort($aTestArray)
For $t = 0 To UBound($aTestArray) - 1
FileWriteLine($file, $aTestArray[$t])
Next

; Commented out because permute then unique on a 9 element takes forever. Mainly waiting for unique to complete.
; Create original array to compare results
;~ $bTestArray = _ArrayPermute($bArray, "") ; Produces too many unwanted duplicate patterns.
;~ _ArrayDelete($bTestArray, 0)
;~ $bTestArray = _ArrayUnique($bTestArray) ; Remove repeat patterns
;~ For $u = 1 To $bTestArray[0]
;~  FileWriteLine($file2, $bTestArray[$u])
;~ Next

My current mistake is:

; Create "sub" arrays to get combinations
$aSubArray = _ArrayPermute($aArray, "") ; Produces too many unwanted duplicate patterns.
;_ArrayDisplay($aTestArray, "Array Permuted")
_ArrayDelete($aSubArray, 0)
$aSubArray = _ArrayUnique($aSubArray) ; Remove repeat patterns.
_ArrayDelete($aSubArray, 0)
;_ArrayDisplay($aTestArray, "Array Unique")
; Use "sub arrays to get some combinations
$aTestArray = _ArrayPermute($aSubArray, "") ; Produces too many unwanted duplicate patterns.
;_ArrayDisplay($aTestArray, "Array Permuted")
_ArrayDelete($aTestArray, 0)
$aTestArray = _ArrayUnique($aTestArray) ; Remove repeat patterns.
_ArrayDelete($aTestArray, 0)

My brain feels fried from trying to work this out. I know I pretty much need to make another For loop inside a For loop, or I think. I'm just thinking slow about this atm. lol

Also I had used your code to get the actual result I should get to check my results on 9 element.

Edit: I should have explained what I was trying to do of my code. I was trying to create a script which will take a large element array and split it up into smaller elements and keep it small yet yeild same results as if leaving it large. An attempt to work around the element limitations.

Edited March 2, 2012 by jb09

[kylomas]

jb09, czardas,

Refer back to post #20. The code uses nested loop where the control variable for each nested loop takes its start value from the previous loop. THis was done when I thought that the problem was merely to list all combinations in ascending order. This was obviously wrong, but, the way I manage the control variable might spark some new ideas.

Looking forward to seeing the solution,

kylomas

[jb09]

Currently, I don't see a use for that idea. Yet I'm probably not thinking outside the box that far atm anyway.

Spitball suggestion: Turn the alpha into a number then add the number prefix to it to produce a unique numeric equivalent. Create a 2X array of ordinal premutations and transpose back to alpha's for output.

What did you mean by this? As I don't quite understand it.

Also my code in post #42 won't be working. If it does needs major do-over. As I'd still be missing lots of combinations even if the code I think is messed up becomes fixed. But surely there is way to break down the large array to stay within array limitations.

[kylomas]

jb09,

Everytime I think that I understand what you are talking about, my fucking brain take a hike!

I thought that it might be beneficial to convert the symbols "a1, "c5", etc to an integer and then process an array of these integers. Ordinal permutations means permutations adhereing to your rule of number within alpha by alpha. Take whatever I say with a pound of salt. This problem is a little like regex'es, when I think I see it, poof, it's gone!

Good Luck,

kylomas

[czardas]

WOW!!! That completed an 9 element array in 5 secs, executing all that code. Where as permute and unique seperate will not complete overnight, holding up on unique as permute will complete in about 24 secs.

The code I wrote is a fail safe version and can be optimized to run faster (necessary for larger input). I still haven't quite figured out when I need to call _ArrayUnique() and when I can skip this step - probably most of the time (needs some study).

So your limited to approx 15 elements, would we be able to combine your code with my idea to exceed 15? I know this isn't complete, just tested on a 9 element and went hay wire. But here is the code.

...

Edit: I should have explained what I was trying to do of my code. I was trying to create a script which will take a large element array and split it up into smaller elements and keep it small yet yeild same results as if leaving it large. An attempt to work around the element limitations.

It's a novel idea, but unfortunately creating permutations of permutations will only yield a small fraction of the real results.

---

The problem of storage remains unsolved. After running my code several times, I got the following results:

a a b b c c - produces 90 unique permutations

a a a b b c c - produces 210

a a a b b b c c - produces 560

a a a b b b c c c - produces 1680

a a a a b b b c c c - produces 4200

Looking at these figures, it seems reasonable to assume that the number of unique permutations will more than double each time we add a new character. So if 10 characters produce 4200 results then 60 characters will produce greater than 4200 * 2^50 results. This is over 4728 quadrillion strings of 60 characters.

4200 * 2^50 = 4,728,779,608,739,020,800

So unless you have a 3.5 zettabyte hard drive you're not going to be able to store the results. Also you will probably need a quantum computer to perform all the calculations within the average span of a human lifetime.

The only practical solution I can think of (to store so much data) would be to store smaller seed strings which can be expanded to produce billions of new strings. This may be possible, but I think you need to rethink your approach.

Edited March 2, 2012 by czardas

[Mat]

Maths police are here. You've been very naughty czardas

You actually ran tests to get those numbers? Oh dear, that was you first mistake. Thinking it double each time was the other. You ended up a grand total of 8 orders of magnitude out of the real maximum, 5.78e26.

For N items, where the numbers of a, b and c are x, y and z respectively, the number of permutations is:

N! / (x! * y! * z!)

You'll notice that this changes dependant on the respective value of x, y and z. You should also notice that x+y+z=n, so we can remove one of the variables:

N! / (x! * y! * (n - x - y)!)

or:

(x+y+z)! / (x! * y! * z!)

It's easy to see from here that the maximum is when (x! + y! + z!) is at a minimum, or when x, y and z are the same.

So how does this change when you add a character? Let's set x = x+1

(x+y+z+1)! / ((x+1)! * y! * z!)

By definition:

(x+y+z+1)! = (x+y+z)! * (x+y+z+1)

(x+1)! = x! * (x+1)

So we can change this new formula to:

( (x+y+z)! / (x! + y! + z!) ) * ( (x+y+z+1) / (x+1) )

So each time you add another a, the number of permutations increases by a factor of ( (x+y+z+1) / (x+1) )

Now don't do it again

[czardas]

Haha! Thanks for the formulas. Clever!

... that was you first mistake. Thinking it double each time was the other. You ended up a grand total of 8 orders of magnitude out of the real maximum, 5.78e26.

Rubbish, I said greater than. First it was 2.3333333333333 times then it was 2.666666666666666 times. My assumption of greater than double was entirely accurate.

Edit

You also haven't answered the original question: Why to make this faster?

Edited March 2, 2012 by czardas

[Mat]

Ok, I'll let you off with a warning. I won't be so lenient next time

I haven't read any of this thread, only your post. "Why make this faster?" is an interesting question though... Usually people either want something faster, or don't care. Very few ask why.

[czardas]

Well you are right to point out that my maths was not entirely accurate, but I knew that already. I was simply trying to illustrate that jb09 would not be able to store the data on his hard drive and didn't worry so much about precision, since it would have made no difference to the fact. I didn't know the formula you posted and I'm glad you took time to help. The question 'why to make this faster?' was a typo that jb09 made when he named the topic.

[Mat]

Ok, now I read some more of the thread, and it seems google may have the answers (I'll take a look later). The topic of unique permutations must have been covered many times before.

[czardas]

Well I think my code above is getting close, but I haven't got much time to play around with it right now. It seems to be working fine, but requires further optimization. I'd be interested to see a different approach.

[jb09]

hmmm... a different approach.... out to be fun to think of.

mat, thanks for the incite on size of array from permutations. Now we just need to write a func that rewrites that formula. lol

[czardas]

mat, thanks for the incite on size of array from permutations. Now we just need to write a func that rewrites that formula. lol

Good to see optimism.

The more I look at my code, the more ways I see to improve it. I'm also thinking of ways to reduce storage by eliminating geometric transformations (mirrored / spun variants). One string could be expanded to represent a family of strings. This may enable processing more data. It'll have to wait until later though.

Edited March 2, 2012 by czardas

[jb09]

expandcollapse popup

#include <Array.au3>
$file = FileOpen("test.txt", 1)
$file2 = FileOpen("test2.txt", 1)
;Dim $dif[3]
Dim $aArray[2] = ["a", "b"]
;Dim $aArray[3] = ["a","b","c"]
;Dim $bArray[4] = ["a", "a", "b", "b"]
;Dim $aArray[6] = ["a","a","b","b","c","c"]
$numberOfEachLetter = 2
$numberOfLetters = 2
; Need to write a function that creates array instead of declaring like above.
; So 2 would act like $aArray[6] from above being thrown into arraypermute and arrayunique.
$aArray = _ArrayPermute($aArray,"") ; Permute the 3 element array
_ArrayDelete($aArray,0) ; Remove size of array
_ArrayDisplay($aArray,"$aArray")
;Now lets add the correct number of letters into $aArray. Example: ["a","b"] will become ["a,"a","b","b"].
For $i = 0 To UBound($aArray) - 1
Dim $temp = StringSplit($aArray[$i],"", 2)
For $j = 0 to UBound($temp) - 1
  $letter = $temp[$j]
  For $k = 1 to $numberOfEachLetter - 1
   $temp[$j] &= $letter
  Next
Next
$aArray[$i] = _ArrayToString($temp,"")
Next
_ArrayDisplay($aArray,"after adding correct number of letters") ; Everything looks good so far.
; Now use arraycombinations to find combinations limited to the size of 2. There will be lots of duplicates, will be working on a function to remove duplicates.
dim $aComboArray[1] = ["idk"]
For $i = 0 to UBound($aArray) - 1
Dim $temp = StringSplit($aArray[$i],"",2)
Dim $tempCombo = _ArrayCombinations($temp,$numberOfEachLetter,"")
_ArrayDelete($tempCombo,0)
$tempCombo = _ArrayUnique($tempCombo)
_ArrayDelete($tempCombo,0)
;_ArrayDisplay($tempCombo,"tempCombo")
_ArrayConcatenate($aComboArray, $tempCombo)
$aComboArray = _ArrayUnique($aComboArray)
_ArrayDelete($aComboArray,0)
Next
_ArrayDelete($aComboArray,0) ; Removes "idk" from when I first created the array.
_ArrayDisplay($aComboArray) ; Everything looks good so far.
$aComboArray = _ArrayPermute($aComboArray,"")
_ArrayDelete($aComboArray,0)
$aComboArray = _ArrayUnique($aComboArray)
_ArrayDelete($aComboArray,0)
_ArrayDisplay($aComboArray)
; Need to limit string in each element to #ofeachletter times #ofletters.  "aa" = 2 = #ofeachletter and "ab" = 2 = #ofletters.
$limit = $numberOfEachLetter * $numberOfLetters
For $i = 0 To UBound($aComboArray) -1
$aComboArray[$i] = StringTrimRight($aComboArray[$i],StringLen($aComboArray[$i]) - $limit)
Next
$aComboArray = _ArrayUnique($aComboArray)
_ArrayDelete($aComboArray,0)
_ArrayDisplay($aComboArray,"limited to $limit")
; Need to check each element and make sure there is not more than #ofeachletter in a string.
For $i = 0 To UBound($aComboArray) - 1
    ; coding to check elements. Haven't figured out how I want to do this step
Next
Func _PermuteUnique($aArray)
    Local $iBound = UBound($aArray), $sUniqStr = "", $sDupeStr = ""
    For $i = 0 To $iBound -1
        If StringInStr($sUniqStr, $aArray[$i]) Then
            $sDupeStr &= $aArray[$i]
        Else
            $sUniqStr &= $aArray[$i]
        EndIf
    Next
    $aDupe = StringSplit($sDupeStr, "", 2)
    $aUnique = StringSplit($sUniqStr, "", 2)
    $aUnique = _ArrayPermute($aUnique)
    _ArrayDelete($aUnique, 0)
    Local $iLen = StringLen($aUnique[0]), $iStart = 0
    _Recurse($aUnique, $aDupe, $iStart, $iLen)
    Return $aUnique
EndFunc
Func _Recurse(ByRef $aSeed, $aDupe, ByRef $iIndex, ByRef $iLen)
    If $iIndex = UBound($aDupe) Then Return
    Local $aTempArray = $aSeed, $iBound = UBound($aSeed), $iCount = 0
    ReDim $aSeed[$iBound*$iLen]
    For $i = 0 To $iBound -1
        For $j = 0 To $iLen
            $sTemp = $aTempArray[$i]
            $aSeed[$iCount] = StringLeft($sTemp, $j) & $aDupe[$iIndex] & StringRight($sTemp, $iLen - $j)
            $iCount += 1
            While StringMid($aTempArray[$i], $j +1, 1) = $aDupe[$iIndex]
                $j += 1
            WEnd
        Next
    Next
    ReDim  $aSeed[$iCount]
    $aSeed = _ArrayUnique($aSeed) ; Optimization improvements can be made here.
    _ArrayDelete($aSeed, 0)
    $iIndex += 1
    $iLen += 1
    _Recurse($aSeed, $aDupe, $iIndex, $iLen)
EndFunc

Not finished yet, but I think you should see where I'm going with it. And not missing any combinations, hopefully.

Another approach I think would be start from the right and work towards the left of a string. Instead of using arraypermute for ["a","b"], create a function to first have original array, ["a","b"]. Then add a letter to the left of the string in each element, yet calculate what letter that string is still allowed to have. So step two would write "b" to 0 position element and "a" to 1 position element. Then be able to tell "I've used all the letters" and stop.

Simuliar with ["a","b","c"], first step shows ["a","b","c"], next step show ["ba","ca","ab","cb","ac","bc"] (somehow adding elements detecting the fact it can add more than one letter to one element). And of course last step in this situation, ["cba","bca","cab","acb","bac","abc"].

Also needs to detect a duplicate before "writing" it.

Just brianstorming.

Edited March 2, 2012 by jb09

[czardas]

I have figured out how to remove the dependancy on _ArrayUnique and ReDim will no longer be required thanks to Mat's help with the formula, but it will have to wait until after I have eaten. Hopefully I'll post it within the next hour, but it still needs writing properly. It should run much faster. At the moment it's just theory, but I'm convinced it is going to make a difference to processing time on larger input. We'll see.

Edited March 3, 2012 by czardas

[jb09]

I'm currently running several tests comparing your code on post #41, your code on post #41 with an altered arrayunique I wrote, original (_arraypermute and _arrayunique), and _arraypermute with altered unique I wrote. So four tests going on saving results to file and will post here.

Func _ArrayUniqueAltered($aArray, $iDimension = 1, $iBase = 0, $iCase = 0, $vDelim = "|")
Local $iUboundDim
;$aArray used to be ByRef, but litlmike altered it to allow for the choosing of 1 Array Dimension, without altering the original array
If $vDelim = "|" Then $vDelim = Chr(01) ; by SmOke_N, modified by litlmike
If Not IsArray($aArray) Then Return SetError(1, 0, 0) ;Check to see if it is valid array
;Checks that the given Dimension is Valid
If Not $iDimension > 0 Then
  Return SetError(3, 0, 0) ;Check to see if it is valid array dimension, Should be greater than 0
Else
  ;If Dimension Exists, then get the number of "Rows"
  $iUboundDim = UBound($aArray, 1) ;Get Number of "Rows"
  If @error Then Return SetError(3, 0, 0) ;2 = Array dimension is invalid.
  ;If $iDimension Exists, And the number of "Rows" is Valid:
  Local $sHold ;String that holds the Unique array info
  For $iCC = $iBase To UBound($aArray) - 1 ;Loop Through array
   ;If Not the case that the element is already in $sHold, then add it
   If Not StringInStr($vDelim & $sHold, $vDelim & $aArray[$iCC] & $vDelim, $iCase) Then _
     $sHold &= $aArray[$iCC] & $vDelim
  Next
  If $sHold Then
   Dim $aArrayTmp = StringSplit(StringTrimRight($sHold, StringLen($vDelim)), $vDelim, 1) ;Split the string into an array
   Return $aArrayTmp ;SmOke_N's version used to Return SetError(0, 0, 0)
  EndIf
  Return SetError(2, 0, 0) ;If the script gets this far, it has failed
EndIf
EndFunc   ;==>_ArrayUniqueAltered

There might be more that can be cut out of the function, but currently the whole redim thing is out. Yet I left the check statements.

Edited March 2, 2012 by jb09

[jb09]

Script used to test.

expandcollapse popup

#include <Array.au3>
HotKeySet("|", "Stop")
Func Stop()
$dif = TimerDiff($begin)
FileWriteLine($file, $a & " element test: Ran for " & $dif & " ms when user killed script.")
Exit
EndFunc   ;==>Stop
$file = FileOpen("TestResults4.txt", 2)
For $a = 3 To 19
Switch $a
  Case 3
   Dim $aArray[3] = ["a", "b", "c"]
  Case 4
   Dim $aArray[4] = ["a", "a", "b", "c"]
  Case 5
   Dim $aArray[5] = ["a", "a", "b", "b", "c"]
  Case 6
   Dim $aArray[6] = ["a", "a", "b", "b", "c", "c"]
  Case 7
   Dim $aArray[7] = ["a", "a", "a", "b", "b", "c", "c"]
  Case 8
   Dim $aArray[8] = ["a", "a", "a", "b", "b", "b", "c", "c"]
  Case 9
   Dim $aArray[9] = ["a", "a", "a", "b", "b", "b", "c", "c", "c"]
  Case 10
   Dim $aArray[10] = ["a", "a", "a", "a", "b", "b", "b", "c", "c", "c"]
  Case 11
   Dim $aArray[11] = ["a", "a", "a", "a", "b", "b", "b", "b", "c", "c", "c"]
  Case 12
   Dim $aArray[12] = ["a", "a", "a", "a", "b", "b", "b", "b", "c", "c", "c", "c"]
  Case 13
   Dim $aArray[13] = ["a", "a", "a", "a", "a", "b", "b", "b", "b", "c", "c", "c", "c"]
  Case 14
   Dim $aArray[14] = ["a", "a", "a", "a", "a", "b", "b", "b", "b", "b", "c", "c", "c", "c"]
  Case 15
   Dim $aArray[15] = ["a", "a", "a", "a", "a", "b", "b", "b", "b", "b", "c", "c", "c", "c", "c"]
  Case 16
   Dim $aArray[16] = ["a", "a", "a", "a", "a", "a", "b", "b", "b", "b", "b", "c", "c", "c", "c", "c"]
  Case 17
   Dim $aArray[17] = ["a", "a", "a", "a", "a", "a", "b", "b", "b", "b", "b", "b", "c", "c", "c", "c", "c"]
  Case 18
   Dim $aArray[18] = ["a", "a", "a", "a", "a", "a", "b", "b", "b", "b", "b", "b", "c", "c", "c", "c", "c", "c"]
  Case 19
   Dim $aArray[19] = ["a", "a", "a", "a", "a", "a", "a", "b", "b", "b", "b", "b", "b", "c", "c", "c", "c", "c", "c"]
EndSwitch
$begin = TimerInit()
;test 1
$aRet = _PermuteUnique($aArray)
;test 2
;change _ArrayUnique to _ArrayUniqueAlternate in the _Recurse function
;test 3
;~ $aRet = _ArrayPermute($aArray,"")
;~ _ArrayDelete($aArray,0)
;~ $aRet = _ArrayUnique($aArray)
;~ _ArrayDelete($aArray,0)
;test 4
;~  $aRet = _ArrayPermute($aArray, "")
;~  _ArrayDelete($aArray, 0)
;~  $aRet = _ArrayUniqueAltered($aArray)
;~  _ArrayDelete($aArray, 0)
$dif = TimerDiff($begin)
;MsgBox(0,"Time","Time for _PermuteUnique to compute: "&$dif&" ms.")
FileWriteLine($file, $a & " element test: " & $dif & " ms.")
;_ArrayDisplay($aRet, "Finished")
Next
Func _PermuteUnique($aArray)
Local $iBound = UBound($aArray), $sUniqStr = "", $sDupeStr = ""
For $i = 0 To $iBound - 1
  If StringInStr($sUniqStr, $aArray[$i]) Then
   $sDupeStr &= $aArray[$i]
  Else
   $sUniqStr &= $aArray[$i]
  EndIf
Next
$aDupe = StringSplit($sDupeStr, "", 2)
$aUnique = StringSplit($sUniqStr, "", 2)
$aUnique = _ArrayPermute($aUnique)
_ArrayDelete($aUnique, 0)
Local $iLen = StringLen($aUnique[0]), $iStart = 0
_Recurse($aUnique, $aDupe, $iStart, $iLen)
Return $aUnique
EndFunc   ;==>_PermuteUnique
Func _Recurse(ByRef $aSeed, $aDupe, ByRef $iIndex, ByRef $iLen)
If $iIndex = UBound($aDupe) Then Return
Local $aTempArray = $aSeed, $iBound = UBound($aSeed), $iCount = 0
ReDim $aSeed[$iBound * $iLen]
For $i = 0 To $iBound - 1
  For $j = 0 To $iLen
   $sTemp = $aTempArray[$i]
   $aSeed[$iCount] = StringLeft($sTemp, $j) & $aDupe[$iIndex] & StringRight($sTemp, $iLen - $j)
   $iCount += 1
   While StringMid($aTempArray[$i], $j + 1, 1) = $aDupe[$iIndex]
    $j += 1
   WEnd
  Next
Next
ReDim $aSeed[$iCount]
$aSeed = _ArrayUniqueAltered($aSeed) ; Optimization improvements can be made here.
_ArrayDelete($aSeed, 0)
$iIndex += 1
$iLen += 1
_Recurse($aSeed, $aDupe, $iIndex, $iLen)
EndFunc   ;==>_Recurse
Func _ArrayUniqueAltered($aArray, $iDimension = 1, $iBase = 0, $iCase = 0, $vDelim = "|")
Local $iUboundDim
;$aArray used to be ByRef, but litlmike altered it to allow for the choosing of 1 Array Dimension, without altering the original array
If $vDelim = "|" Then $vDelim = Chr(01) ; by SmOke_N, modified by litlmike
If Not IsArray($aArray) Then Return SetError(1, 0, 0) ;Check to see if it is valid array
;Checks that the given Dimension is Valid
If Not $iDimension > 0 Then
  Return SetError(3, 0, 0) ;Check to see if it is valid array dimension, Should be greater than 0
Else
  ;If Dimension Exists, then get the number of "Rows"
  $iUboundDim = UBound($aArray, 1) ;Get Number of "Rows"
  If @error Then Return SetError(3, 0, 0) ;2 = Array dimension is invalid.
  ;If $iDimension Exists, And the number of "Rows" is Valid:
  Local $sHold ;String that holds the Unique array info
  For $iCC = $iBase To UBound($aArray) - 1 ;Loop Through array
   ;If Not the case that the element is already in $sHold, then add it
   If Not StringInStr($vDelim & $sHold, $vDelim & $aArray[$iCC] & $vDelim, $iCase) Then _
     $sHold &= $aArray[$iCC] & $vDelim
  Next
  If $sHold Then
   Dim $aArrayTmp = StringSplit(StringTrimRight($sHold, StringLen($vDelim)), $vDelim, 1) ;Split the string into an array
   Return $aArrayTmp ;SmOke_N's version used to Return SetError(0, 0, 0)
  EndIf
  Return SetError(2, 0, 0) ;If the script gets this far, it has failed
EndIf
EndFunc   ;==>_ArrayUniqueAltered
#cs
; This code is much slower (and more limited).
Dim $aPermute = _ArrayPermute($aArray)
_ArrayDelete($aPermute, 0)
$aPermute = _ArrayUnique($aPermute)
_ArrayDisplay($aPermute)
#ce

Test results 1:

3 element test: 1.52304918106383 ms.

4 element test: 2.13164707554864 ms.

5 element test: 4.77711393276418 ms.

6 element test: 26.5786837163017 ms.

7 element test: 111.516737873085 ms.

8 element test: 814.202927070161 ms.

9 element test: 12205.1820814222 ms.

10 element test: 99809.0752904997 ms.

11 element test: Ran for 306621.559226032 ms when user killed script.

Test results 2:

3 element test: 7.90294353118991 ms.

4 element test: 7.7327701666305 ms.

5 element test: 15.7939228875637 ms.

6 element test: 20.9868162126166 ms.

7 element test: 65.3061003075219 ms.

8 element test: 475.403175482046 ms.

9 element test: 3968.00764315483 ms.

10 element test: 25263.6427919401 ms.

11 element test: 202556.476670233 ms.

12 element test: Ran for 727621.865330081 ms when user killed script.

Test results 3:

3 element test: 0.618706462450149 ms.

4 element test: 1.46774012525346 ms.

5 element test: 6.01344192623963 ms.

6 element test: 48.872326018152 ms.

7 element test: 286.205643139866 ms.

8 element test: 2262.94341147334 ms.

9 element test: 21868.2685803859 ms.

10 element test: 218767.773657117 ms.

11 element test: Array maximum size exceeded.

Test results 4:

3 element test: 0.757360698546192 ms.

4 element test: 2.54954021354443 ms.

5 element test: 6.08516711685086 ms.

6 element test: 37.1562600543214 ms.

7 element test: 266.872266159867 ms.

8 element test: 2279.98824907033 ms.

9 element test: 21707.7747308248 ms.

10 element test: 231333.086667315 ms.

11 element test: Array maximum size exceeded.

Also, using test 2 array limit exceeds between 2000000 and 20000000. lol

[czardas]

lol

I was running a 12 digit string test, but I think I'll terminate the process too. My script now seems to run three times faster but I haven't figured out the best way to incorporate Mat's formula. This should also make a big difference. Anyway _ArrayUnique has been removed. I have only made changes to the recursive function.

expandcollapse popup

#include <Array.au3>

;Dim $aArray[6] = ["a","a","b","b","c","c"] ; 90 results
;Dim $aArray[7] = ["a","a","a","b","b","c","c"] ; 210 results
;Dim $aArray[8] = ["a","a","a","b","b","b","c","c"] ; 560 results
;Dim $aArray[9] = ["a","a","a","b","b","b","c","c","c"] ; 1680 results
Dim $aArray[10] = ["a","a","a","a","b","b","b","c","c","c"] ; 4200 results
;Dim $aArray[11] = ["a","a","a","a","b","b","b","b","c","c","c"]
;Dim $aArray[12] = ["a","a","a","a","b","b","b","b","c","c","c","c"]

$iTimer = TimerInit()
$aRet = _PermuteUnique($aArray)
ConsoleWrite(TimerDiff($iTimer) & @LF)
_ArrayDisplay($aRet, "Finished")

Func _PermuteUnique($aArray)
    Local $iBound = UBound($aArray), $sUniqStr = "", $sDupeStr = ""
    For $i = 0 To $iBound -1
        If StringInStr($sUniqStr, $aArray[$i]) Then
            $sDupeStr &= $aArray[$i]
        Else
            $sUniqStr &= $aArray[$i]
        EndIf
    Next

    $aDupe = StringSplit($sDupeStr, "", 2)
    $aUnique = StringSplit($sUniqStr, "", 2)

    $aUnique = _ArrayPermute($aUnique) ; Only need to call _ArrayPermute the first time.
    _ArrayDelete($aUnique, 0)

    Local $iLen = StringLen($aUnique[0]), $iStart = 0
    _Recurse($aUnique, $aDupe, $iStart, $iLen)

    Return $aUnique
EndFunc

Func _Recurse(ByRef $aSeed, $aDupe, ByRef $iIndex, ByRef $iLen)
    If $iIndex = UBound($aDupe) Then Return
    Local $sPattern, $aTempArray = $aSeed, $iBound = UBound($aSeed), $iCount = 0

    ReDim $aSeed[$iBound*$iLen] ; This line still needs attention
    For $i = 0 To $iBound -1
        For $j = 0 To $iLen
            $sTemp = $aTempArray[$i]
            While StringMid($aTempArray[$i], $j +1, 1) = $aDupe[$iIndex]
                $j += 1
            WEnd
            $sPattern = StringLeft($sTemp, $j) & $aDupe[$iIndex] & StringRight($sTemp, $iLen - $j)
            If $i Then ; Check for patteen duplication
                For $k = 0 To $iCount -1
                    If $aSeed[$k] = $sPattern Then ExitLoop
                Next
            EndIf
            If $i = 0 Or $k = $iCount Then ; Will only add new unique strings
                $aSeed[$iCount] = $sPattern
                $iCount += 1
            EndIf
        Next
    Next
    ReDim  $aSeed[$iCount] ; This line still needs attention
    $iIndex += 1
    $iLen += 1
    _Recurse($aSeed, $aDupe, $iIndex, $iLen) ; Add another new character
EndFunc

Edit

I was just looking at the changes you made to _ArrayUnique. It looks interesting but I'll have to play around with it for a while to get a true picture. I think the forum code tags are messing up the appearance of your script. To make your code easier to read, first add the code tags to your post. Then paste your code inbetween the tags.

Edited March 3, 2012 by czardas

[jb09]

I've been using the little AutoIt icon in the reply box, which brings a popup that I paste my code in. I'll try your recommendation this time.

I'm about to run tests on this code, will edit the results. But here is what I'd call a reverse permutation I guess. lol

Func ReversePermute($aArray)
    $size = UBound($aArray)
    $string = _ArrayToString($aArray, "")
    If $size >= 2 Then
        For $i = 2 To $size
            $jSize = UBound($aArray) - 1 ; Since next loop may add an element(s)
            For $j = 0 To $jSize
                $aTemp = StringSplit($aArray[$j], "")
                _ArrayDelete($aTemp,0)
                $sTemp = StringSplit($string, "")
                _ArrayDelete($sTemp,0)
                For $k = 0 To UBound($aTemp) - 1
                    For $l = 0 To UBound($sTemp) - 1
                        If $aTemp[$k] = $sTemp[$l] Then
                            $sTemp[$l] = ""
                            $l = UBound($sTemp)
                        EndIf
                    Next
                Next
                $z = 1 ; Variable to represent first loop to add a char to element instead of adding a element.
                For $k = 0 To UBound($sTemp) - 1
                    If Not $sTemp[$k] = "" Then
                        If $z = 1 Then
                            $aArray[$j] = $sTemp[$k] & $aArray[$j]
                            MsgBox(0,"",$aArray[$j])
                            $z = 0
                        Else
                            _ArrayAdd($aArray, $sTemp[$k] & $aArray[$j])
                        EndIf
                    EndIf
                Next
            Next
        Next
    EndIf
    Return $aArray
EndFunc   ;==>ReversePermute

Found my goofs lol.

Edited March 3, 2012 by jb09