Way to make this faster?

[Spiff59]

Spiff59,

your results have "duplicates"

your array will not be correct.

There would be little point in adding a $bNoDupes parameter if the routine still returned duplicates, or the resulting array were in any way incorrect. I might mess with it tonight and try to make it preallocate the output array size for any input set, regardless of the number of unique characters in the input array, or how many times any character may be duplicated in the input array (not just equal size sets of 3 different characters).

Edit: I snuck away from my weekend chores for a bit. This seems to precalculate the output array size for any sort of input combination, whether it's

a,a,a,a,b,b,b,b,c,c,c,c

or

a,b,b,b,c,d,d,e,e,e,e,f

There is something screwy in the __Array_ExeterInternalX() function as it is (in some cases) requiring an array 1 larger than is necessary to avoid crashing, which is forcing me to do what I did in the 2 lines tagged with "???". It's surely due to my earlier mods, and something I'll can try to fix. It's been running with a 12-character input for 10 minutes as I type this, will wait to see what comes out and when it finishes.

expandcollapse popup

#include <Array.au3>

Local $aArray[12] = ["a", "a", "a", "a", "b", "b", "b", "b", "c", "c", "c", "c"]

$timer = TimerInit()
Local $aNewArray = _ArrayPermuteX($aArray, "", True) ; No Dupes
$timer = Round(TimerDiff($timer) / 1000, 2)
MsgBox(0,"", $timer)

; Insert_Digits
For $x = 0 to UBound($aNewArray) - 1
    For $y = 0 to UBound($aArray) - 1
        For $z = 1 to UBound($aArray)
           $aNewArray[$x] = StringRegExpReplace($aNewArray[$x], $aArray[$y] & "(?=D|z)", $aArray[$y] & $z, 1)
        Next
    Next
Next
_ArrayDisplay($aNewArray, "Array Permuted")

;===================================================================================================================================
Func _ArrayPermuteX(ByRef $avArray, $sDelim = "", $bNoDupes = False)
    If Not IsArray($avArray) Then Return SetError(1, 0, 0)
    If UBound($avArray, 0) <> 1 Then Return SetError(2, 0, 0)
    Local $iSize = UBound($avArray), $iFactorial = 1, $aIdx[$iSize], $aResult[1], $iCount = 1
    Local $iDupe, $sChr, $aTemp = $avArray
    For $i = 0 To $iSize - 1
        $aIdx[$i] = $i
        $iFactorial *= ($i + 1) ; calculate array size for all unique characters
    Next
    For $x = 0 to UBound($aTemp) - 1 ; reduce array size for each dupe
        $iDupe = 1
        $sChr = $aTemp[$x]
        For $y = $x to UBound($aTemp) - 1
            If $sChr And $aTemp[$y] = $sChr Then
                $iFactorial /= $iDupe
                $aTemp[$y] = ""
                $iDupe += 1
            EndIf
        Next
    Next
;   MsgBox(0,"","Output Array Size = " & $iFactorial)
    ReDim $aResult[$iFactorial + 2] ; ???
    $aResult[0] = $iFactorial
    $iResult = __Array_ExeterInternalX($avArray, 0, $iSize, $sDelim, $aIdx, $aResult, $iCount, $bNoDupes)
    ReDim $aResult[$iFactorial + 1] ; ???
    Return $aResult
EndFunc   ;==>_ArrayPermute

Func __Array_ExeterInternalX(ByRef $avArray, $iStart, $iSize, $sDelim, ByRef $aIdx, ByRef $aResult, ByRef  $iCount, $bNoDupes)
    If $iStart == $iSize - 1 Then
        For $i = 0 To $iSize - 1
           $aResult[$iCount] &= $avArray[$aIdx[$i]] & $sDelim
        Next
        If $sDelim <> "" Then $aResult[$iCount] = StringTrimRight($aResult[$iCount], 1)
        If $bNoDupes Then
            If IsDeclared("__" & $aResult[$iCount]) Then
                $aResult[$iCount] = ""
            Else
                Assign("__" & $aResult[$iCount], "", 2)
                $iCount += 1
         Endif
         Else
            $iCount += 1
         EndIf
    Else
        Local $iTemp
        For $i = $iStart To $iSize - 1
            $iTemp = $aIdx[$i]
            $aIdx[$i] = $aIdx[$iStart]
            $aIdx[$iStart] = $iTemp
            __Array_ExeterInternalX($avArray, $iStart + 1, $iSize, $sDelim, $aIdx, $aResult, $iCount, $bNoDupes)
            $aIdx[$iStart] = $aIdx[$i]
            $aIdx[$i] = $iTemp
        Next
    EndIf
EndFunc   ;==>__Array_ExeterInternal

Edited March 4, 2012 by Spiff59

[Mat]

Pre-emptive link: Alternatively, I would really recommend changing to a language with a more extensive maths library, python is probably a good choice. I also think arrays are way too limiting. We are talking a HUGE amount of data for 60 characters.

So I came up with this. Rather than make a huge list of all possible permutations, make a function f(n) that returns the nth permutation (sort of like a seed). Lets face it, a database-like result is not feasible.

What does it do? Well, I'll explain the theory if you like, it's fairly straightforward (i.e. not proven to actually work):

For this I'll use the string "aaabbbccc" as my starting point, which the code writes more simply as [3, 3, 3] (literally, 3 As, 3 Bs and 3Cs). In this simple case, 1/3 of all permutations will start with 'a', so we take the seed and check whether it is in the lower, middle or upper third of the total number of permutations. In this case, 1680 is the total number of permutations (using the theory I wrote above), and a third is 560. So any permutation N where N < 560 will start with an 'a', between 560 and 1120 is 'b' and greater than that is 'c'. (should possibly point out now that no range checking is applied. If you pass a seed of more than 1680 that's garbage, so you'll get more garbage in response).

We can generalize that, for more complex strings where the numbers are not the same, by saying that each region has a width of <Max Permutations> / <String length> * <Count of character>, that's possibly easier to understand if you take a look at the code. Now for the fun bit, once we've found that region, subtract the lower bound, subtract one from the count of the character added, then get the new Nth permutation of the rest.

Now I imagine if speed is an issue, then there are number of things you can do to make it faster. You'll remember from my last maths lesson that the number of permutations changes predicatably when you add a letter, and I showed that it was simply scaling the old one by a factor of ( (x+y+z+1) / (x+1) ). That would save a lot of time re-calculating the number of permutations each time. Similarly I went for a simple method of summing the counts of characters to get the total length. We know that it reduces by one each time, so that can be translated into a single subtraction. But I tried to write this so it was something vaguely readable, as this is more a demonstration of the theory as it will never be able to cope with 60 elements, simply because AutoIt can't do the maths.

I also added code versions of the theory I explained before, allowing you to workout the number of permutation in a 21 character string of 7 As, Bs and Cs at the most.

Example output of code: _GetPermutation(600, "aaabbbccc") => "baacbbcac"

Code.

[czardas]

Very nicely done Mat. I think this is one of those rare occasions where finding solutions is more interesting than solving the problem. I need to absorb what's happening, but it is very fast.

Edit

#include <Array.au3>
Local $sInput = "aaaabbbbcccc"

Local $array[34650]
$iTimer = TimerInit()
For $n = 0 To 34649
    $array[$n] = GetPermutation($n, $sInput)
Next
ConsoleWrite(TimerDiff($iTimer) & @LF)
_ArrayDisplay($array, "Finished")

This takes just over a minute on my machine. Awesome!

Edited March 4, 2012 by czardas

[Spiff59]

Why get all mathy and formulaic?

The following generates a total permutations count in a few lines of code with a single function call; a StringSplit() if passing a string, or use a Ubound() if passing an array (as I did in my prior post).

expandcollapse popup

Local $sInput = "abbbbccdddddeefff"
MsgBox(0,StringLen($sInput),$sInput & " = " & _NumPermutations($sInput) & " permutations." & @LF & @LF & $sInput & " = " & INeedAPerm($sInput) & " permutations." & @LF)
Local $sInput = "aaaaaaabbbbbbbcccccc"
MsgBox(0,StringLen($sInput),$sInput & " = " & _NumPermutations($sInput) & " permutations." & @LF & @LF & $sInput & " = " & INeedAPerm($sInput) & " permutations." & @LF)
Local $sInput = "abcdefghijklmnopqrst"
MsgBox(0,StringLen($sInput),$sInput & " = " & _NumPermutations($sInput) & " permutations." & @LF & @LF & $sInput & " = " & INeedAPerm($sInput) & " permutations." & @LF)
Exit

; The easy way =====================================================================================================================
Func INeedAPerm($s)
    Local $aTemp = StringSplit($s,""), $iPerms = 1, $iDupe
    For $i = 2 To $aTemp[0] ; calculate array size for all unique characters
        $iPerms *= $i
    Next
    For $x = 1 to $aTemp[0] ; reduce array size for each dupe
        If Not $aTemp[$x] Then ContinueLoop
        $iDupe = 2      
        For $y = $x + 1 to $aTemp[0]
            If $aTemp[$y] = $aTemp[$x] Then
                $iPerms /= $iDupe
                $aTemp[$y] = ""
                $iDupe += 1
            EndIf
        Next
    Next
    Return $iPerms
EndFunc

; The hard way ======================================================================================================================
Func _NumPermutations($s)
    Local $n = StringLen($s)
    Local $aChars = _StringCountChars($s)
    Local $denominator = 1
    Local $iMax = 0, $iDontCount = 0
    For $i = 0 To UBound($aChars) - 1
        If ($aChars[$i][1] > $iMax) Then
            $iMax = $aChars[$i][1]
            $iDontCount = $i
        EndIf
    Next
    For $i = 0 To UBound($aChars) - 1
        If ($i = $iDontCount) Then ContinueLoop
        $denominator *= _Factorial($aChars[$i][1])
    Next
    Return _Factorial($n, $iMax + 1) / $denominator
EndFunc   ;==>_NumPermutations

Func _Factorial($i, $start = 2)
    Local $ret = 1
    For $n = $start To $i
        $ret *= $n
        If ($ret < 0) Then ConsoleWrite("Warning: AutoIt integer type will only be accurate up to 20!" & @LF)
    Next
    Return $ret
EndFunc   ;==>_Factorial

Func _StringCountChars($s)
    Local $sChars = _StringUnique($s)
    Local $aRet[StringLen($sChars)][2] ; [*][0] = CHAR, [*][1] = COUNT
    For $i = 0 To UBound($aRet) - 1
        $aRet[$i][0] = StringMid($sChars, $i + 1, 1)
        $aRet[$i][1] = _StringCount($s, $aRet[$i][0])
    Next
    Return $aRet
EndFunc   ;==>_StringCountChars

Func _StringCount($s, $c)
    StringReplace($s, $c, "")
    Return @extended
EndFunc   ;==>_StringCount

Func _StringUnique($s)
    Local $c, $ret = ""
    For $i = 0 To StringLen($s)
        $c = StringLeft($s, 1)
        $ret &= $c
        $s = StringReplace($s, $c, "")
    Next
    Return $ret
EndFunc   ;==>_StringUnique

Edit: Cleanup, eliminated some unnecessary loop iterations.

Edited May 15, 2012 by Spiff59

[Mat]

This takes just over a minute on my machine. Awesome!

The idea is not to put them all in an array, but rather replacing an array lookup with this function later in the code. I'm not expecting it to be that fast.... You could make it a lot faster if you did want to use this method to make an array.

[czardas]

Why get all mathy and formulaic?

Calculating the variants will always be faster than crunching through strings, as Mat has shown. On the 12 chars => 'aaaabbbbcccc', Mat's method runs 40 times faster than mine. Messing around with recursion was educational for me, but I'll be using Mat's code.

The idea is not to put them all in an array, but rather replacing an array lookup with this function later in the code. I'm not expecting it to be that fast.... You could make it a lot faster if you did want to use this method to make an array.

Always a pleasure to learn from you. It makes me wish I never quit school when I was younger (there were circumstances). Not to devalue your brilliant solution by saying that. So all you youngsters better pay attention in class.

[jb09]

nar nar nar......

Well, I finally have a script working up to par. Par meaning uniquepermuting an array and not allowing a element to have $x same letters in a row (ie "aaa" would not be allowed within even a larger string). My variable for setting the limit is $inARow. Also before someone says this doesn't do as I say, because two numbers don't equal each other, let me explain what those two numbers mean.

$check2 will not equal ($iMax-$counter) (unless maybe for a small $inARow on small array) because "aaa" could be at the end of a string (ie "bcbaaa" or "bbcaaa") which the script hasn't actually made yet. But since "aaa" can be at the end of a string, many permutes will be missing. Hopefully I explained this well enough.

expandcollapse popup

#include <Array.au3>
HotKeySet("|", "Stop")
$file = FileOpen("TestRR.txt", 2)
$check = 0
$checkfound = 0
$check2 = 0
Global $inARow = 3
For $a = 9 To 9
    $aArray = _array($a)
    $iMax = _iMax($aArray)
    ConsoleWrite("$iMax: " & $iMax & @LF)
    FileWriteLine($file, "$iMax: " & $iMax)
    If $iMax < 16000000 Then
        $begin = TimerInit()
        $bArray = ReversePermute($aArray, $iMax, $a)
        $dif = TimerDiff($begin)
        ConsoleWrite($a & " element test: " & $dif & " ms." & @LF)
        ConsoleWrite("Results:" & @LF)
;~         FileWriteLine($file, $a & " element test: " & $dif & " ms.")
;~         FileWriteLine($file, "Results:")
        $counter = 0
        For $k = 0 To UBound($bArray) - 1
            If $bArray[$k] <> "" And StringLen($bArray[$k]) = $a Then
                ;FileWriteLine($file, $bArray[$k])
                $counter += 1
            EndIf
        Next
        ConsoleWrite("After finding " & $inARow & " same letters in a row, " & $counter & " elements are in the array." & @LF)
        ConsoleWrite($iMax - $counter & " elements had " & $inARow & " same letters in a row." & @LF)
        ConsoleWrite("Check Function ran " & $check & " times." & @LF)
        ConsoleWrite("Check Function found duplicate " & $checkfound & " times." & @LF)
        ConsoleWrite("Check2 Function found " & $check2 & " strings in error." & @LF)
;~         FileWriteLine($file, "After finding "&$inARow&" same letters in a row, "&$counter&" elements are in the array.")
;~         FileWriteLine($file, $iMax - $counter&" elements had "&$inARow&" same letters in a row.")
;~         FileWriteLine($file, "Check Function ran " & $check & " times.")
;~         FileWriteLine($file, "Check Function found duplicate " & $checkfound & " times.")
;~         FileWriteLine($file, "Check2 Function found "&$check2&" strings in error.")
    Else
        FileWriteLine($file, $a & " elements exceed limitations.")
    EndIf
Next
Func ReversePermute($aArray, $iMax, $a)
    $size = UBound($aArray)
    $string = _ArrayToString($aArray, "")
    Dim $Array[$iMax] = ["a", "b", "c"]
    If $size >= 2 Then
        For $i = 2 To $size
            $filled = 0
            For $z = 0 To UBound($Array) - 1 ; Check to see how many elements are filled, as a limit for next loop
                If $Array[$z] <> "" Then $filled += 1
            Next
            For $j = 0 To $filled - 1 + $check2 ; Need to add $check2 for the sake of finding $inARow same letters in a row
                If StringLen($Array[$j]) = $i - 1 Then ; To skip over erased elements
                    Local $aArrayTemp = $Array[$j]
                    Local $aTemp = StringSplit($Array[$j], "", 2)
                    Local $sTemp = StringSplit($string, "", 2)
                    For $k = 0 To UBound($aTemp) - 1 ; Loop to remove letters already in element script plans to add a letter to
                        For $l = 0 To UBound($sTemp) - 1
                            If $aTemp[$k] = $sTemp[$l] Then ; Just setting index to "" if chars match and ending loop to move to next char
                                $sTemp[$l] = ""
                                $l = UBound($sTemp)
                            EndIf
                        Next
                    Next
                    $z = 1 ; Marker to signify first string adding to
                    For $k = 0 To UBound($sTemp) - 1
                        If Not ($sTemp[$k] = "") Then ; Check to make sure adding a letter
                            If $k = 2 Then
                            EndIf
                            If check2($sTemp[$k] & $aArrayTemp) Then ; checks for same letters in a row, limit based from $inARow
                                If check($Array, $sTemp[$k] & $aArrayTemp) Then ; Checks for doubles
                                    If $z = 1 Then ; If first string to add letter to, add letter
                                        $Array[$j] = $sTemp[$k] & $aArrayTemp
                                        $z = 0
                                    Else ; if not first string to add letter to, search for empty element and insert
                                        $l = 0
                                        While $l < $iMax
                                            If $Array[$l] = "" Then
                                                $Array[$l] = $sTemp[$k] & $aArrayTemp
                                                $l = $iMax
                                            EndIf
                                            $l += 1
                                        WEnd
                                    EndIf
                                EndIf
                            ElseIf $i = $size Then ; If $inARow same letters in a row, erases string
                                $Array[$j] = ""
                            EndIf
                        EndIf
                    Next
                EndIf
                ;_ArrayDisplay($Array,"AFTER INSERT LOOP")
            Next
        Next
    EndIf
    Return $Array
EndFunc   ;==>ReversePermute

Func Check($aArray, $string)
    $check = $check + 1
    For $v = 0 To UBound($aArray) - 1
        If $string = $aArray[$v] Then
            $checkfound += 1
            Return False
        EndIf
    Next
    Return True
EndFunc   ;==>Check

Func check2($string)
    $sArray = StringSplit($string, "", 2)
    $count = 1
    For $q = 1 To UBound($sArray) - 1
        If $sArray[$q] = $sArray[$q - 1] Then
            $count += 1
            If $count = $inARow Then
                $check2 += 1
                Return False
            EndIf
        Else
            $count = 1
        EndIf
    Next
    Return True
EndFunc   ;==>check2

Func Stop()
    Exit
EndFunc   ;==>Stop

Func _Factorial($iNumber)
    If Not IsInt($iNumber) Or $iNumber < 1 Then Return SetError(1, 0, 0)
    If $iNumber > 1 Then
        For $i = 2 To $iNumber - 1
            $iNumber *= $i
        Next
    EndIf
    Return $iNumber
EndFunc   ;==>_Factorial

Func _array($a)
    Dim $aArray[$a]
    $x = 0
    $y = 1
    While $x < $a
        Switch $y
            Case 1
                $aArray[$x] = "a"
            Case 2
                $aArray[$x] = "b"
            Case 3
                $aArray[$x] = "c"
                $y = 0
        EndSwitch
        $y += 1
        $x += 1
    WEnd
    Return $aArray
EndFunc   ;==>_array

Func _iMax($aArray)
    Local $d = 0, $b = 0, $c = 0, $iDivisor = 1
    For $i = 0 To UBound($aArray) - 1
        Switch $aArray[$i]
            Case "a"
                $d += 1
            Case "b"
                $b += 1
            Case "c"
                $c += 1
        EndSwitch
    Next
    For $i = 1 To 3
        Switch $i
            Case 1
                $iDivisor *= _Factorial($d)
            Case 2
                $iDivisor *= _Factorial($b)
            Case 3
                $iDivisor *= _Factorial($c)
        EndSwitch
    Next
    Return (_Factorial(UBound($aArray)) / $iDivisor)
EndFunc   ;==>_iMax

This script ran for 16 secs on its final fix for a 9 element array, "aaabbbccc". Test before was 17 secs, before that 18 secs, and before that was 24. Each time I was changing something. Which it might be able to use some more fixes to run faster, but all previous fixes were for the getting the results its meant to give. Had to fix several things, like add erase string if check2() returned false, skipping erased elements in the $j loop, and all sorts of stuff. Anyway, thoughts or questions?

Next I'd wish to see about Mat's code on doing this.

[jchd]

I finally decided to have a look at that thread as those with that number of replies are fairly rare. I first thought it was about a game and that (along with the ugly [still uncorrected] thinko in the title) kept me away from looking.

But as Valik rightly noticed, this goes beyond casual script kidies' request and deserves some attention.

I just tonight quickly browsed thru the 87 posts but didn't try to dig further than that. I didn't run nor write any code and, sorry, I don't intend to.

Anyway, from what I've understood, your problem is parsing a tree and assigning increasing weights to repeated tree branches. Let me explain what I mean and how I see it (which may be completely off the real mark).

You have (say) three sources, namely A, B and C which can each make the next branch in the tree, except that there is no point of repeating the same source twice in a row.

So from the initial choice in {A, B, C} you can select next level to be in {B, C}, {A, C}, {A, B} respectively, depending on the intitial choice made:

A ➔ B or C

B ➔ A or C

C ➔ A or B

This seems to be the building rules for the tree and this succession rules can be modeled easily as a standalone step (for a given max depth).

EDIT: as the OP noticed I didn't read the thread well enough. His rules are more complex, way more complex in fact, due to limited repetition and limited supply of each source.

Now about the weights (numbers). I didn't read everything posted but lets say you're allowed that weights go from 1 and up and you can start at any weight. Weights from any given source have to be increasing, that is entries in A_i (when ignoring tree entries from B_j and C_k) need to be increasing in i. Here I mean increasing per se, not incrementing by 1 (the sequence 4, 17, 43, 44, 109 qualifies as increasing).

i, j and k can be modeled easily for a given tree depth, again as a standalone step. Note that i, j, k weight sequences are independant so you only need one algorithm, useable for all 3.

Of course the combinatorics explodes almost immediately, so it's out of question to list all possible sequences allowed, except for toy examples (probably of no value in the actual game).

A few questions: "what would/should be the tree depth?", "what is the maximum weight value?", "what is the allowable weight increase rule (for any given source)?" and "how do you rate one sequence over another one?"

I'm probably overlooking something. YES

Edited March 6, 2012 by jchd

[jb09]

well, for one your overlooking the fact to allowing (in your terms) the same source to repeat, yet I have a personal opinion to limit the repeat to 4.

what would/should be the tree depth?

If I understand this correctly, the end goal of "tree depth" would be at least 55. (20 a's, 20 b's, and 15 c's) Although currently it has been set at 60.

what is the maximum weight value?

what is the allowable weight increase rule (for any given source)?

Those two I don't know how to answer, as I don't understand the weight part of this tree model.

Of course the combinatorics explodes almost immediately, so it's out of question to list all possible sequences allowed, except for toy examples (probably of no value in the actual game).

So if I understand the first part of this, the tree model will "return" a combination? Or part of the tree model? I do understand it won't return a full list of the tree model. Also I'd like to be enlightened about "toy examples".

As far as the title, I've already said I goofed. Guess I need to PM a mod to have it changed? As I see no option to do so.

Just finished scripting to find out the number of unique permutations using 3 different main functions.

expandcollapse popup

#include "BigNum.au3"
#include <Array.au3>

For $a = 3 To 60
    $aArray = _array($a)
    $aMax = _iMax($aArray)
    ConsoleWrite($a & " element array produces " & $aMax & " unique combinations. Computed by _Factorial." & @LF)
    $arraystring = _RewriteArray($aArray)
    $bMax = _NumPermutations($arraystring)
    ConsoleWrite($a & " element array produces " & $bMax & " unique combinations. Computed by _NumPermutations." & @LF)
    $cMax = _iMax3($aArray)
    ConsoleWrite($a & " element array produces " & $cMax & " unique combinations. Computed by _Factorial with _BigNum." & @LF)
Next

Func _Factorial2($iNumber)
    If Not IsInt($iNumber) Or $iNumber < 1 Then Return SetError(1, 0, 0)
    If $iNumber > 1 Then
        For $i = 2 To $iNumber - 1
            $iNumber *= $i
        Next
    EndIf
    Return $iNumber
EndFunc   ;==>_Factorial2

Func _array($a)
    Dim $aArray[$a]
    $x = 0
    $y = 1
    While $x < $a
        Switch $y
            Case 1
                $aArray[$x] = "a"
            Case 2
                $aArray[$x] = "b"
            Case 3
                $aArray[$x] = "c"
                $y = 0
        EndSwitch
        $y += 1
        $x += 1
    WEnd
    Return $aArray
EndFunc   ;==>_array

Func _iMax($aArray)
    Local $d = 0, $b = 0, $c = 0, $iDivisor = 1
    For $i = 0 To UBound($aArray) - 1
        Switch $aArray[$i]
            Case "a"
                $d += 1
            Case "b"
                $b += 1
            Case "c"
                $c += 1
        EndSwitch
    Next
    For $i = 1 To 3
        Switch $i
            Case 1
                $iDivisor *= _Factorial2($d)
            Case 2
                $iDivisor *= _Factorial2($b)
            Case 3
                $iDivisor *= _Factorial2($c)
        EndSwitch
    Next
    Return (_Factorial2(UBound($aArray)) / $iDivisor)
EndFunc   ;==>_iMax

Func _NumPermutations($s)
    Local $n = StringLen($s)
    Local $aChars = _StringCountChars($s)

    Local $denominator = 1

    ; In order to allow larger factorials, we cancel out the largest
    ; no. char occurences with the length of the string.
    Local $iMax = 0, $iDontCount = 0

    ; Loop through to find the maximum. This has to be done before the
    ; main loop to stop the result being counted in the factorial for the
    ; denominator.
    For $i = 0 To UBound($aChars) - 1
        If ($aChars[$i][1] > $iMax) Then
            $iMax = $aChars[$i][1]
            $iDontCount = $i
        EndIf
    Next

    ; Work out the denominator not counting the maximum char occurence value
    ; as that is taken of the numerator instead
    For $i = 0 To UBound($aChars) - 1
        If ($i = $iDontCount) Then ContinueLoop

        $denominator *= _Factorial($aChars[$i][1])
    Next

    Return _Factorial($n, $iMax + 1) / $denominator
EndFunc   ;==>_NumPermutations

; Returns i!, could be sped up with lookup tables or Poor man's factorial.
; Note this will overflow very quickly.
Func _Factorial($i, $start = 2)
    Local $ret = 1


    For $n = $start To $i
        $ret *= $n
        If ($ret < 0) Then ConsoleWrite("Warning: AutoIt integer type will only be accurate up to 20!" & @LF)
    Next

    Return $ret
EndFunc   ;==>_Factorial

; Returns an array of unique characters and the number of times they occur.
Func _StringCountChars($s)
    Local $sChars = _StringUnique($s)
    Local $aRet[StringLen($sChars)][2] ; [*][0] = CHAR, [*][1] = COUNT

    For $i = 0 To UBound($aRet) - 1
        $aRet[$i][0] = StringMid($sChars, $i + 1, 1)
        $aRet[$i][1] = _StringCount($s, $aRet[$i][0])
    Next

    Return $aRet
EndFunc   ;==>_StringCountChars

; Get the number of time character $c appears in string $s
Func _StringCount($s, $c)
    StringReplace($s, $c, "")
    Return @extended
EndFunc   ;==>_StringCount

; Get only the unique characters of $s
Func _StringUnique($s)
    Local $c, $ret = ""

    For $i = 0 To StringLen($s)
        $c = StringLeft($s, 1)
        $ret &= $c
        $s = StringReplace($s, $c, "")
    Next

    Return $ret
EndFunc   ;==>_StringUnique

Func _iMax3($aArray)
    Local $d = 0, $b = 0, $c = 0, $iDivisor = 1
    For $i = 0 To UBound($aArray) - 1
        Switch $aArray[$i]
            Case "a"
                $d += 1
            Case "b"
                $b += 1
            Case "c"
                $c += 1
        EndSwitch
    Next
    For $i = 1 To 3
        Switch $i
            Case 1
                $iDivisor = _BigNum_Mul($iDivisor, _Factorial3($d))
            Case 2
                $iDivisor = _BigNum_Mul($iDivisor, _Factorial3($b))
            Case 3
                $iDivisor = _BigNum_Mul($iDivisor, _Factorial3($c))
        EndSwitch
    Next
    Return (_BigNum_Div(_Factorial3(UBound($aArray)), $iDivisor))
EndFunc   ;==>_iMax3

Func _Factorial3($iNumber)
    If Not IsInt($iNumber) Or $iNumber < 1 Then Return SetError(1, 0, 0)
    If $iNumber > 1 Then
        For $i = 2 To $iNumber - 1
            $iNumber = _BigNum_Mul($iNumber, $i)
        Next
    EndIf
    Return $iNumber
EndFunc   ;==>_Factorial3

Func _RewriteArray($array)
    Local $aString = "", $bString = "", $cString = ""
    For $i = 0 To UBound($array) - 1
        Switch $array[$i]
            Case "a"
                $aString &= "a"
            Case "b"
                $bString &= "b"
            Case "c"
                $bString &= "c"
        EndSwitch
    Next
    Return $aString & $bString & $cString
EndFunc   ;==>_RewriteArray

BigNum seems to be able to compute such large numbers to get results higher than the other two functions. Yet the results are amazing. 3.5 secs if nothing is in $a for loop is commented out.

55 element array produces 2546267632195745700742500 unique combinations.

60 element array produces 577831214478475823831865900 unique combinations.

That is huge. 2,546,267,632,195,745,700,742,500 or 2.5 Septillion. And 577,831,214,478,475,823,831,865,900 or 577 Septillion.

So I wonder how large that txt file would have got if I let it go, back in my first post. lol

Info on the Septillion, http://en.wikipedia.org/wiki/Names_of_large_numbers

Edited March 6, 2012 by jb09

[czardas]

So I wonder how large that txt file would have got if I let it go, back in my first post. lol

Indeed! That had me giggling from the start. not to try anything like this previously by jchd, so I never bothered to look into the subject any deeper. Now I see the consequences.

[jchd]

Now that the rule has been introduced that no more than (say) 4 same "mines" can be there, the actual number of combinations drops down tremendously. The issue is that we get trapped one way or the other.

Either we account for a given number of occurences of "mines" A, B, C and we go Mat's route counting them (but ignore that mines can't repeat more than 4 times in a row)

OR

we count the number of combinations by starting with the first group of 4 (there are 81) and count which next can follow (but we're very annoyed that this doesn't lend to limiting the total number of "mines", i.e. the 20, 20, 15).

With the former way (Mat's) we end up with something way too huge, but if we develop the combinatorics for the latter way, we end up with a formula that essentially amounts to enumerating every possibility, well more or less.

Adding levels isn't as hard as I guessed as they seem consecutive (by mine type) from 1.

Also forgot to mention to the OP: to edit a post title, go to the very first post (#1), hit Edit, use full editor and from there you can edit the title.

Edited March 6, 2012 by jchd

[Mat]

That's why I recommended a function to generate the Nth one, rather than list all possible versions. The numbers just get silly.

Each line would have to be 62 bytes (with the CR+LF line terminator), Looking at wolframalpha, that would need considerably more memory than is currently in use on the web. In fact it works out as 35000 YB (yottabytes), there isn't actually a unit higher than that on wikipedia. In fact, if you used atoms as bits, you'd need 6.8 average sized humans to store all the permutations.

Of course if you used one of czardas' ternary computers, each character represented by a trit, then you could store it in a bit less. But technolagy isn't up for it, and there are more important things we could do with that much data (like chess end game analysis with more pieces).

Edit: If you want to modify mine to disallow 4+ in a row, then change the regions... I'll take a look when I get home. If there are more than 4 in a row then that region is reduced to zero, and the number of consecutives will have to be passed to each function.

Edited March 6, 2012 by Mat

[jchd]

Actually, ternary computers have been built in the past, mostly in the former soviet union: http://www.computer-museum.ru/english/setun.htm

D. Knuth is a big fan, among others.

[czardas]

I've been meaning to do something with that tritwise stuff, but my idea involves another UDF which I still need to write. It probably will be a while before I get round to it. Lot's of catching up to do with other projects rigth now - such as earning a living. I can't give any more details other than to say that the project will be both recreational and fun.

[jb09]

I think I came up with a way to know the size if the result array before permutation. I've not has the chance to write this in autoit, just figured this out on paper. when permuting a 15 char array, 5 of each letter, I came up these numbers. top number represents the length of string put together so far, bottom number represents number of strings which would break the rule of no more than 4 same letters in a row.

5 6 7 8

3 6 18 54

so I wrote this into a loop.

$minus

for $i = 2 To $size ; $size being lenth of starting string or elements in starting array

$minus *= 3

next

now just subtract $minus from the uniquepermute $iMax.

edit: can't move to the bottom on this phone. But 17 element array is there limit, 18 goes outside limitations.

and according to my ti 84, 15 element array will come out to be, 737,070 element array.

Edited March 7, 2012 by jb09