Jump to content

jb09

Active Members
  • Posts

    35
  • Joined

  • Last visited

jb09's Achievements

Seeker

Seeker (1/7)

0

Reputation

  1. 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.
  2. 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. 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. Those two I don't know how to answer, as I don't understand the weight part of this tree model. 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. #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
  3. 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. #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.
  4. 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.
  5. "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.
  6. 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.
  7. 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.
  8. 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"). czardas, what price should we put? lolThanks for chiming in Mat.
  9. 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.
  10. 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. #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).
  11. 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.
  12. 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.
  13. Script used to test. #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
  14. 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.
  15. #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.
×
×
  • Create New...