Way to make this faster?

[czardas]

Your code looks better now. Fixed a syntax error => Also you don't return a value from your function:

EDIT ah you fixed it (code removed).

I have no idea what this is meant to do.

Edited March 3, 2012 by czardas

[jb09]

hehe

well, it is still not working right yet.

3 element test: 8.61673488017119 ms.

Results:

cba

cab

c

cba

cab

haha, almost there. need to figure out where I've gone wrong.

[czardas]

I have had a little rest and time to think. My original statement that you could achieve unique permutations with up to 15 characters was based on all three characters being equal in number (3 x 5). Actually the max number will vary with different arrangements. My code will permute 17 characters in the arrangement shown below, but I don't know how long the computation will take.

a a a a a a b b b b b b c c c c c

I made a mistake thinking that removing some of the calls to ReDim would make a significant difference (although usually it does), so my code did not require much alteration. I think jb09's PC may be faster than mine. It took just over 40 minutes to permute the unique permutations for the following 12 character input.

a a a a b b b b c c c c

I don't think I can make it go any faster. Removing some of the calls to ReDim might save a few minutes on an operation that could take days or weeks to complete. This is the best I can do.

expandcollapse popup

#include <Array.au3>

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

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

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

    Local $aDuplicate = StringSplit($sDuplicateStr, "", 2), _
    $aRet = StringSplit($sUniqueStr, "", 2), $iDivisor = 1

    For $i = 0 To UBound($aRet) -1
        $iDupeCount = 1
        For $j = 0 To UBound($aDuplicate) -1
            If $aRet[$i] = $aDuplicate[$j] Then $iDupeCount += 1
        Next
        $iDivisor *= _Factorial($iDupeCount)
    Next
    Local $iMax = _Factorial($iBound) / $iDivisor

    $aRet = _ArrayPermute($aRet) ; Only need to call _ArrayPermute the first time (on the unique array).
    _ArrayDelete($aRet, 0)

    Local $iLen = StringLen($aRet[0]), $iStart = 0
    _Recurse($aRet, $aDuplicate, $iStart, $iLen, $iMax)

    Return $aRet
EndFunc

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

    If $iIndex <> UBound($aDuplicate) -1 Then
        ReDim $aSeed[$iBound*$iLen]
    Else
        ReDim $aSeed[$iMax]
    EndIf

    For $i = 0 To $iBound -1
        For $j = 0 To $iLen
            While StringMid($aTempArray[$i], $j +1, 1) = $aDuplicate[$iIndex]
                $j += 1
            WEnd
            $sPattern = StringLeft($aTempArray[$i], $j) & $aDuplicate[$iIndex] & StringRight($aTempArray[$i], $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]
    $iIndex += 1
    $iLen += 1
    _Recurse($aSeed, $aDuplicate, $iIndex, $iLen, $iMax) ; Add another new character
EndFunc

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

Edited March 3, 2012 by czardas

[jb09]

Well, from your code on post #59, took my PC 50 minutes 56 seconds. Running your new code now.

I've perfected my reversepermute idea, which shaved off a few seconds on 10 element, almost a minute on 11 element compared to your code on post #41 (I believe is the post, anyway previous to #59). Yet the #59 code halved the time. So I either need to throw my idea out or major improvements. lol

Anyway, here is the code.

expandcollapse popup

#include <Array.au3>
HotKeySet("|", "Stop")
$file = FileOpen("TestR.txt", 2)
For $a = 3 To 12
    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()
    $aArray = ReversePermute($aArray)
    $dif = TimerDiff($begin)
    FileWriteLine($file, $a & " element test: " & $dif & " ms.")
    FileWriteLine($file, "Results:")
    For $k = 0 To UBound($aArray) - 1
        FileWriteLine($file, $aArray[$k])
    Next
Next
Func ReversePermute($aArray)
    $size = UBound($aArray)
    $string = _ArrayToString($aArray, "")
    Dim $Array[3] = ["a","b","c"]
    If $size >= 2 Then
        For $i = 2 To $size
            For $j = 0 To UBound($Array) - 1 ; Since loop may add an element(s)
                $aArrayTemp = $Array[$j]
                $aTemp = StringSplit($Array[$j], "",2)
                $sTemp = StringSplit($string, "",2)
                For $k = 0 To UBound($aTemp) - 1
                    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 ; 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 $k = 2 Then
                        EndIf
                        If check($Array, $sTemp[$k] & $aArrayTemp) Then ; Checks for doubles
                            If $z = 1 Then
                                $Array[$j] = $sTemp[$k] & $aArrayTemp
                                $z = 0
                            Else
                                _ArrayAdd($Array, $sTemp[$k] & $aArrayTemp)
                            EndIf
                        EndIf
                    EndIf
                Next
            Next
        Next
    EndIf
    Return $Array
EndFunc   ;==>ReversePermute

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

Func Stop()
    Exit
EndFunc   ;==>Stop

Edit: Code in post #63 took 54 minutes and 45 secs. I don't know if you are leaving you PC alone, but I'm doing other things while it runs (ie browsing).

Edited March 3, 2012 by jb09

[czardas]

The only real difference with the last version I posted is that it will handle larger input because I use the correct size (thanks to Mat) for the final ReDim. I don't think it'll be faster. Looking at your latest code now.

Edit

Your latest code seems to be working fine. It's a bit slower than mine but still well done! I haven't looked at the code in detail yet - I just got home from a long day. Looking forward to seeing your next test results.

Code in post #63 took 54 minutes and 45 secs. I don't know if you are leaving you PC alone, but I'm doing other things while it runs (ie browsing).

I haven't compaired my last two versions yet, but they should average out at about the same speed after running several tests. Any number of interfering processes could affect the results. This thread has been very interesting so far. There's so much still left to learn.

Edited March 3, 2012 by czardas

[jb09]

Well, the limit has budged some. Used Mat's formula to find out at what point we will exceed 16 million. Results:

Final array size for 3 element array is 6 elements.

Final array size for 4 element array is 12 elements.

Final array size for 5 element array is 30 elements.

Final array size for 6 element array is 90 elements.

Final array size for 7 element array is 210 elements.

Final array size for 8 element array is 560 elements.

Final array size for 9 element array is 1680 elements.

Final array size for 10 element array is 4200 elements.

Final array size for 11 element array is 11550 elements.

Final array size for 12 element array is 34650 elements.

Final array size for 13 element array is 90090 elements.

Final array size for 14 element array is 252252 elements.

Final array size for 15 element array is 756756 elements.

Final array size for 16 element array is 2018016 elements.

Final array size for 17 element array is 5717712 elements.

Final array size for 18 element array will exceed 16 million element limitation.

Now the only other thing I know to do is limit a series of the same letter to 4 or 5. Yet not sure how a formula would work out on that.

[czardas]

Now the only other thing I know to do is limit a series of the same letter to 4 or 5. Yet not sure how a formula would work out on that.

Not sure what you mean? (EDIT ah maybe I do" The greater the variety of letters, the larger the number of permutations).

I only used the formula to limit the final run because I thought it would have added too much extra code to be worth while. I would have only been able to remove 14 calls to ReDim, so it was not worth making the code any more complicated. Multiple calls to ReDim does slow down people's scripts, and I tthink it's responsible for slowing down _ArrayPermute (I meant to say _ArrayUnique - not sure about it though). Perhaps some of these UDF functions can be improved. Several array functions tend to be greedy with time.

Edited March 4, 2012 by czardas

[Mat]

After a lot of googling, it seems there is no conclusive answer to the problem of unique permutations, I can only provide the formula for no. permutations, rather than the solution. That is rather strange, as it is a common enough problem, that should have a price on its head.

[jb09]

Yes, _ArrayUnique is what you meant to say.

I'm currently trying to figure out what in my script is using the most time and if it could be improved. Easiest way to limit the series of one letter in a row (ie "baaaaaabca").

After a lot of googling, it seems there is no conclusive answer to the problem of unique permutations, I can only provide the formula for no. permutations, rather than the solution. That is rather strange, as it is a common enough problem, that should have a price on its head.

czardas, what price should we put? lol

Thanks for chiming in Mat.

[czardas]

czardas, what price should we put? lol

Perhaps we should claim a percentage of Microsoft Profits.

Edit

jb09 Looking again at your code, I notice some inconsistancies in your naming of variables. You should take a look at this page written by Mat. I realize you wouldn't be aware of these specs if you had not read this article (or the parts that concern your code). It makes understanding AutoIt code easier for the reader.

Edited March 4, 2012 by czardas

[Valik]

You guys seem to be having fun but I think you've both lost the plot. What is your original task? How does this relate to your original task? When you look at the original task what things can you eliminate that will make significant reductions in the amount of data you have to work with. I know nothing about what you are attempting to do but experience with things like build order in other games I know there may be some optimizations. For example, some build orders you can eliminate entirely because of technical reasons (You can't build C unless you have B and A already). Others you can eliminate for logical reasons.

In other words, use some human logic to filter out some noise and narrow the data down to a rough ideal candidate and then work from there.

[czardas]

You know what? You're absolutely right - we got totally sidetracked. It's good to be brought back down to Earth from time to time.

Edited March 4, 2012 by czardas

[jb09]

In this game, all three ("a","b","c" or simuliar to ingame "metal mine","crystal mine","dueterium synthesizer") can be built from the start, no requirements of other buildings first built. Just cost of course. Sure, if czardas read up on some links, each of the three building require energy to operate. Energy being produced by a separate building, I would be able to add this to each build order based on then energy is needed. Therefore, no elimination of "a" must be before "c" and what not.

[czardas]

Indeed, I don't fully understand the build order concept, and it looks like it'll take some time to read through the links. The game appears to be very mathematically based (which I like). I'm guessing that only one build order is needed at any one time. The first question that comes to mind is: what constitutes a good build order, and why is it better than other (weaker) build orders?

[jb09]

Well, as far as what constitutes a good build order varies upon what type of player you will be. You want to build a fleet? Solely work off your mines? Or a mix?. Yes the game is very mathematical, as it started out pure text based, now more java is involved but that is beside the point. So you want to fleet, you want the build order that will allow you to build a small cargo the quickest, which involves researching that I'm not caring to bring into the build order atm. Maybe later. Or lets go for the mines, you want the build order that brings in the most resources compared to time. Also might consider getting a defense unit built to prevent the fleeter from attacking you with his small cargo.

A weak build order would consist of building one mine up to a lvl, then the next and so on. There is an appropriate ratio of each resource being produced. Mainly you want quantity of each being produced to be in this order: metal>crystal>dueterium.

I don't want to get to in depth, as it might become harder to understand. Mentioning many things that you wouldn't understand.

[czardas]

So does that mean that a,b and c represent mined resources - metal crystal and dueterium? What is the significance of the number 20?

Edit

The more I look at the website, the more I keep thinking of analogue simulations. Rather than solving something with rigour, making some kind of script that allows new elements to be added which affect all other parts of the system. The complex problem of simulating the UK economy was done using anaologue techniques (measuring water levels on a system of water tanks - when tax was raised, water flowed into the budget tank, which in turn filtered down into other parts of the economy). The system demonstrated a high level of accuracy in predicting the results of budget changes.

With a complicated problem, containing many variables, this type of approach may have value. I'm not sure if this is useful in this instance. I also haven't tried anything like that, so it's just an idea right now.

Edited March 4, 2012 by czardas

[jb09]

"a","b","c" represent the mine. Remember I had a number with the letter? The number represents the level of that mine, "a5" is a level 5 metal mine. Hence why I needed the numbers to be in order, yet letters didn't have to be.

20 means level 20 mine. The mines don't stop at that level, there isn't really a limit on a mine level. I just chose to stop at that lvl for the purpose of the script. Ingame It would take more like a year with multiple planets having the same mines to reach higher than 25 due to costs.

[czardas]

It's becoming a bit clearer to me now. However I need to sleep right now. Scaling down the problem seems appropriate. I'll read some more later.

[Spiff59]

I modified the existing production _ArrayPermute() and it's helper function into backwards compatible versions with an optional "$bNoDupes" parameter.

It seems to work fine, not sure where this will come in as far as speed.

My PC took 33 seconds to crunch a 9-element array.

expandcollapse popup

#include <Array.au3>
Local $aArray[9] = ["a", "a", "a", "b", "b", "b", "c", "c", "c"]

$timer = TimerInit()
Local $aNewArray = _ArrayPermuteX($aArray, "", True) ;Using Default Parameters
$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
    For $i = 0 To $iSize - 1
        $aIdx[$i] = $i
    Next
    For $i = $iSize To 1 Step -1
        $iFactorial *= $i
    Next
    ReDim $aResult[$iFactorial + 1]
    $aResult[0] = $iFactorial
    $iResult = __Array_ExeterInternalX($avArray, 0, $iSize, $sDelim, $aIdx, $aResult, $iCount, $bNoDupes)
    ReDim $aResult[$iCount]
    $aResult[0] = $iCount - 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
        Return $iCount
    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

Edit: I ran a 10-element array in 5min 40sec. But, like the production version, I encounter the "Array maximum size exceeded" error when the array has 11 or more elements. Since you guys apparently have a formula to determine in advance the size of the resulting array, that could be incorporated to pre-size the array, allowing for a greater number of elements, and eliminating the need for the (one-time) ReDim I inserted after the initial call to __Array_ExeterInternalX()

Edit2: If the "non-recursive recursion" (queue) method used in more recent recursive versions of _FileListToArray() were applied to __Array_ExeterInternalX(), then the Assign() statement would not require the "global scope" parameter, and those temporary variables could be flushed at function end.

Edited March 4, 2012 by Spiff59

[jb09]

Spiff59,

I haven't tested your coding yet. but as you said you receive the exceed array error when beginning with an 11 element array, your results have "duplicates". for example "abacbcabc" would be in the array multiple times. I'm certain your 9 element array is turning into an array much larger than 1680 elements. so if you used the formula to set the final size we are using, your array will not be correct.

as far as your second edit, I for one don't understand what your saying. yet I haven't looked at those functions either. but will.