Speeding up array processing

[UEZ]

After I got it here my corrected version:

expandcollapse popup

#include <Array.au3>

Global $bit = 7
Global $iBits = 2^$bit
Global $bitmask = 1, $i
For $i = 1 To $bit
    $bitmask += 2^$i
Next
Local Const $mask = BitXOR($bitmask, 0xFFFFFF)

Global $aNumbers[$iBits]

Global $fTimer = TimerInit()
For $i = $iBits - 1 to 0 Step - 1
    _BitRotate($i, $bit, $mask, $aNumbers)
Next

Global $aResult = _ArrayUnique($aNumbers, 0, 0, 0, $ARRAYUNIQUE_NOCOUNT)
For $i = 0 To UBound($aResult) - 1
    $aResult[$i] = StringFormat("%0" & $bit & "i", Integer2Binary($aResult[$i]))
Next
ConsoleWrite("Finished in " & TimerDiff($fTimer) & " ms." & @CRLF)

_ArrayDisplay($aResult)

Func _BitRotate($n, $bit, $mask, ByRef $aArray)
    Local $i, $a, $b
    $aArray[$n] = $n
    For $i = $bit - 1 to 1 Step -1
        $a = BitShift($n, $i)
        $b = BitShift(BitAND(BitRotate($n, -$i, "w"), $mask), 16 - $bit)
        $aArray[BitOR($a, $b)] = $n
    Next
EndFunc

Func Integer2Binary($in)
    Local $bin
    If $in = 0 Then
        Return 0
    EndIf
    While $in > 0
        $bin &= Mod($in, 2)
        $in = Floor($in / 2)
    WEnd
    Return StringReverse($bin)
EndFunc

 

[AndyG]

6 hours ago, czardas said:

I don't know if AndyG's code rotates bit by bit or not. Regardless of language, the bit by bit method is brute force.

Yes, the code rotates bit by bit, bruteforce method. This thread shows once again, that not the fastest processor "wins" the game, but the fastest algorithm.

Optimizing the algorithm is much better and more effective than any other solution to "speed up" code! Do you have any ideas to bypass the bruteforce?

The question (not only in this example) is, is the solution fast enough (but inefficient)? 

I prefer to create big lookup-tables or big data-arrays at the start of the program. The user does not notice some more seconds during startup, but within the program execution/workflow every "waitstate" is a pain.

 

@UEZ , ...BitRotate()......native functions ftw....

 

Edited August 10, 2016 by AndyG

[czardas]

29 minutes ago, AndyG said:

Do you have any ideas to bypass the bruteforce?

Well since I'm not familiar with Assembly, there may be less improvement to be had than I think. Looking at the actual task, it is a waste of time to test every rotation. You also want to quit testing straight away with symmetrical arrangements such as 001001001001001001 etc... How easy it is to optimize using Assembly is not clear to me. You might find ways to skip certain commands which require more processing than would be required using brute force. In my AutoIt function above, I'm ignoring leading zeros, but relying on RegExp to skip past several rotations. It may, or may not, be suitable to do something like this with Assembly. If practical, this and other methods, may speed it up even more. For more heavy duty tasks that would certainly be worth the effort. Anyway I'm in awe of your Assembly skills.

Edited August 10, 2016 by czardas

[Melba23]

Hi,

Just for fun, my final effort. I realised that the second half of the array is a mirror image of the first (although I cannot prove it mathematically it is obvious when you look at it), so all you have to do is invert the 0s and 1s in the previously found unique patterns - which essentially halves the time required to do the time-consuming brute-force rotating:

expandcollapse popup

#include <Array.au3>

$nBegin = TimerInit()

Local $iBit = 14

Local $aBinArray[(2 ^ $iBit) + 1][$iBit + 1]

; Add all 0s element to 0 column
$aBinArray[0][0] = 1
$aBinArray[1][0] = ""
For $i = 1 To $iBit
    $aBinArray[1][0] &= "0"
Next

ConsoleWrite("Filling array" & @CRLF)

; Skip all even numbers - they must be duplicates when rotated
For $i = 1 to (2 ^ $iBit) - 1 Step 2
    $sBinary = (Dec2Bin($i))                                            ; Create binary string
    ;ConsoleWrite($sBinary & @TAB)
    $sBinary = StringRegExpReplace($sBinary, "(?U)^(.*)0*$", "$1")      ; Strip any trailing zeros
    ;ConsoleWrite($sBinary & @TAB)
    $sBinary = StringFormat("%0" & $iBit & "s", $sBinary)               ; Pad with leading zeros as required
    ;ConsoleWrite($sBinary & @CRLF)
    StringReplace($sBinary, "1", "")                                    ; Get number of 1s within it
    $iCount = @extended
    $aBinArray[0][$iCount] +=1
    $aBinArray[$aBinArray[0][$iCount]][$iCount]= $sBinary               ; Store in required column
Next
;_ArrayDisplay($aBinArray, "Full", Default, 8)

; Determine column after which we can mirror
$iMirror = Ceiling(($iBit + 1) / 2)

; Create array to hold unique elements
Local $aUnique[UBound($aBinArray) + 1] = [0]

; Create array to hold unique array indices for each column - first 2 cols are only single values
Local $aColIndex[$iBit][2] = [[1, 1], [2, 2]]

; Add elements from first and second columns which are unique by definition
For $i = 0 To 1

    ConsoleWrite("Column: " & $i & @CRLF & "Adding" & @CRLF)

    $aUnique[0] += 1
    $aUnique[$aUnique[0]] = $aBinArray[1][$i]
Next

; Now loop through other columns checking for duplicates when rotated
For $i = 2 To $iMirror - 1 ; $iBit - 2 ; Column

    ConsoleWrite("Column: " & $i & @CRLF)

    ; Extract column from main array
    $aCol = _ArrayExtract($aBinArray, 1, $aBinArray[0][$i], $i, $i)

    ConsoleWrite("Rotating"  & @CRLF)

    ; Now work through array rotating each element
    For $j = 0 To UBound($aCol) - 2
        ; Check string
        $sRotated = $aCol[$j]
        ; If this element has not already been deleted
        If $sRotated Then
            ; Loop through all possible rotations
            For $k = 1 To $iBit
                ; Compare to elements in array - only need to look below the current element
                For $m = $j + 1 To UBound($aCol) - 1
                    If $aCol[$m] = $sRotated Then
                        ; If there is a match then delete the element
                        $aCol[$m] = ""
                    EndIf
                Next
                $sRotated = _Rotate($sRotated)
            Next
        EndIf
    Next

    ConsoleWrite("Adding" & @CRLF)

    ; Set start index
    $aColIndex[$i][0] = $aUnique[0] + 1

    ; Add remaining elements to the unique array
    For $j = 0 To UBound($aCol) - 1
        If $aCol[$j] Then
            $aUnique[0] += 1
            $aUnique[$aUnique[0]] = $aCol[$j]
        EndIf
    Next

    ; Set end index
    $aColIndex[$i][1] = $aUnique[0]

Next

;_ArrayDisplay($aColIndex, "Col indices", Default, 8)

; Now mirror the remaining columns
For $i = $iMirror To $iBit - 2 ; Column

    ConsoleWrite("Column: " & $i & @CRLF)

    ; Determine column to mirror
    $iMirrorCol = $iBit - $i
    ; Mirror found elements

    ConsoleWrite("Mirroring" & @CRLF)

    For $j = $aColIndex[$iMirrorCol][0] To $aColIndex[$iMirrorCol][1]
        $aUnique[0] += 1
        $aUnique[$aUnique[0]] = _Mirror($aUnique[$j])
    Next
Next

; Add elements from the penultimate and final columns which are also are unique by definition
For $i = $iBit - 1 To $iBit

    ConsoleWrite("Column: " & $i & @CRLF & "Adding" & @CRLF)

    $aUnique[0] += 1
    $aUnique[$aUnique[0]] = $aBinArray[1][$i]
Next

ReDim $aUnique[$aUnique[0] + 1]

ConsoleWrite(TimerDiff($nBegin) & @CRLF)

_ArrayDisplay($aUnique, "Unique patterns", Default, 8)

Func _Mirror($sString)

    $aSplit = StringSplit($sString, "")
    $sMirrorString = ""
    For $i = 1 To $aSplit[0]
        $sMirrorString &= ( ($aSplit[$i] = 1) ? (0) : (1) )
    Next

    Return $sMirrorString

EndFunc

Func _Rotate($sString)
    Return StringRight($sString, 1) & StringLeft($sString, $iBit - 1)
EndFunc

Func Dec2Bin($iD)
    Return (BitShift($iD, 1) ? Dec2Bin(BitShift($iD, 1)) : "") & BitAnd($iD, 1)
EndFunc

Making that change reduces the time for a 14-bit run from ~55 to ~32 seconds on my machine - not a bad gain, which reinforces AndyG's comment above about the best results come from optimising the algorithm.

M23

 

[czardas]

33 minutes ago, Melba23 said:

I cannot prove it mathematically

Yeah, you only need to generate half of the variants (good thinking), but I believe you may end up with a few duplicates. Have you tested for that?

0011 <==> 1100

Edit
Ignore: I see where you have accounted for this.

$iMirror = Ceiling(($iBit + 1) / 2)

 

Edited August 10, 2016 by czardas

[UEZ]

1 hour ago, AndyG said:

@UEZ , ...BitRotate()......native functions ftw....

Yes, the sm version but my code is not working properly. But seems to be fast. I cannot see the bug yet.

[Melba23]

czardas,

I had thought of that - the mirroring only takes place for columns where there are unequal numbers of 0s and 1s. If there is a column with equal numbers of 0s and 1s then it gets rotated - that is determined by this line:

; Determine column after which we can mirror
$iMirror = Ceiling(($iBit + 1) / 2)

M23

Edit: I see you have already noticed this.

Edited August 10, 2016 by Melba23

[AndyG]

19 hours ago, czardas said:

How easy it is to optimize using Assembly is not clear to me

I asked for optimizations of the algorithm, not for special optimizations depending of any language. 

Melba23 did the trick with "mirroring"

When all optimizations are done on the algorithm, it is questionable to use a "faster" language. If AutoIt does the job in 300ms, it is not necessary to write a C(++)-dll or ASM code which takes 10ms....

Edited August 11, 2016 by AndyG

[czardas]

On 8/11/2016 at 0:32 PM, AndyG said:

I asked for optimizations of the algorithm, not for special optimizations depending of any language.

LOL 

Don't underestimate the potential time saved by skipping all symmetrical equivalents: a pattern may repeat after as few as only one or two spins. I think the greater the number of bytes, the more significant these symmetrical patterns become (not sure though).

Melba's idea was very appropriate. My use of modular binary is very specific and does not include all permutations, so mirroring is not suitable for what I am doing. Concerning the OP's question here, I would be inclined to generate a unique ID for each set of inversions (as previously mentioned) and only add ones that are missing. So the question then would be what is the fastest way to identify a variant. I am using the method I posted earlier and testing for the smallest numeric value. If I remember correctly, I found that using Bitwise functions was slower than conversion to binary strings. I wasn't sure how to identify the symmetry with Hex back then (actually thinking about it once more...) and the time saved seemed to be significant. It's a while ago now, and perhaps I could improve using bitshift etc... Although I'm okay with the RegExp approach => no serious latency issues.

Edit : Tests showed that my concept above was partly flawed. It was taking just over 1 second before I finally found a better solution (see below).

Edited August 13, 2016 by czardas

[dejhost]

Dim $bit = 20
Local $aBinArray[(2 ^ $bit) + 1][$bit + 1]

This code calls an error:

Quote

AutoIt3.exe ended.rc:-1073741819

It works fine with $bit = 18, so I assume this means that autoit doesn't like the large number of array elements?

[Melba23]

dejhost,

Correct - the maximum number of elements is 16,777,216 and the code is asking for 22,020,117.

In fact many of the higher elements of the array are not used - let me have a think about how we could reduce the overall size.

M23

Edit:

The normal trick is to resize the array as we go along - changing the first lines of my last posted script above to this makes almost no change to the execution time and makes the array very much smaller:

expandcollapse popup

#include <Array.au3>

$nBegin = TimerInit()

Local $iBit = 14

Local $aBinArray[100][$iBit + 1]

; Add all 0s element to 0 column
$aBinArray[0][0] = 1
$aBinArray[1][0] = ""
For $i = 1 To $iBit
    $aBinArray[1][0] &= "0"
Next

ConsoleWrite("Filling array" & @CRLF)

; Skip all even numbers - they must be duplicates when rotated
For $i = 1 to (2 ^ $iBit) - 1 Step 2
    $sBinary = (Dec2Bin($i))                                            ; Create binary string
    ;ConsoleWrite($sBinary & @TAB)
    $sBinary = StringRegExpReplace($sBinary, "(?U)^(.*)0*$", "$1")      ; Strip any trailing zeros
    ;ConsoleWrite($sBinary & @TAB)
    $sBinary = StringFormat("%0" & $iBit & "s", $sBinary)               ; Pad with leading zeros as required
    ;ConsoleWrite($sBinary & @CRLF)
    StringReplace($sBinary, "1", "")                                    ; Get number of 1s within it
    $iCount = @extended
    $aBinArray[0][$iCount] +=1

    ; Resize array if required
    If $aBinArray[0][$iCount] > UBound($aBinArray) - 1 Then
        ReDim $aBinArray[UBound($aBinArray) + 100][$iBit + 1]
    EndIf

    $aBinArray[$aBinArray[0][$iCount]][$iCount]= $sBinary               ; Store in required column
Next
;_ArrayDisplay($aBinArray, "Full", Default, 8)

The value of 100 as an initial size/resize factor is just a choice on my part - the 14-bit array needs to be about 1716 rows deep, so you could try 500 and reduce the number of time-consuming ReDims used for larger bit sizes.

M23

Edited August 11, 2016 by Melba23

[dejhost]

6 hours ago, Melba23 said:

dejhost,

Correct - the maximum number of elements is 16,777,216 and the code is asking for 22,020,117.

In fact many of the higher elements of the array are not used - let me have a think about how we could reduce the overall size.

M23

Edit:

The normal trick is to resize the array as we go along - changing the first lines of my last posted script above to this makes almost no change to the execution time and makes the array very much smaller:

expandcollapse popup

#include <Array.au3>

$nBegin = TimerInit()

Local $iBit = 14

Local $aBinArray[100][$iBit + 1]

; Add all 0s element to 0 column
$aBinArray[0][0] = 1
$aBinArray[1][0] = ""
For $i = 1 To $iBit
    $aBinArray[1][0] &= "0"
Next

ConsoleWrite("Filling array" & @CRLF)

; Skip all even numbers - they must be duplicates when rotated
For $i = 1 to (2 ^ $iBit) - 1 Step 2
    $sBinary = (Dec2Bin($i))                                            ; Create binary string
    ;ConsoleWrite($sBinary & @TAB)
    $sBinary = StringRegExpReplace($sBinary, "(?U)^(.*)0*$", "$1")      ; Strip any trailing zeros
    ;ConsoleWrite($sBinary & @TAB)
    $sBinary = StringFormat("%0" & $iBit & "s", $sBinary)               ; Pad with leading zeros as required
    ;ConsoleWrite($sBinary & @CRLF)
    StringReplace($sBinary, "1", "")                                    ; Get number of 1s within it
    $iCount = @extended
    $aBinArray[0][$iCount] +=1

    ; Resize array if required
    If $aBinArray[0][$iCount] > UBound($aBinArray) - 1 Then
        ReDim $aBinArray[UBound($aBinArray) + 100][$iBit + 1]
    EndIf

    $aBinArray[$aBinArray[0][$iCount]][$iCount]= $sBinary               ; Store in required column
Next
;_ArrayDisplay($aBinArray, "Full", Default, 8)

The value of 100 as an initial size/resize factor is just a choice on my part - the 14-bit array needs to be about 1716 rows deep, so you could try 500 and reduce the number of time-consuming ReDims used for larger bit sizes.

M23

Thanks again, Melba! 

[Melba23]

dejhost,

My pleasure, as always.  But when you reply, please use the "Reply to this topic" button at the top of the thread or the "Reply to this topic" editor at the bottom rather than the "Quote" button - I know what I wrote and it just pads the thread unnecessarily.

M23

 

[czardas]

I had to test my hypothesis, although I had to go back to the drawing board a couple of times. I eventually modified @AndyG's excellent method, from post #34. The main differences are: testing for recursion due to modal symmetry and forcing bit rotation to skip past even numbers, which are not needed. It takes about 250 milliseconds to process 14 binary digits with 2GB RAM. The original code from AndyG takes approximately 900 milliseconds. It's not an entirely clear comparison, but the results do support some of the things I said earlier. Hopefully it will become more clear (eventually).

expandcollapse popup

#include <Array.au3>

Local $iBits = 14

Local $aArray, $iTimer
$iTimer = TimerInit()
$aArray = BitLoopPermute($iBits)

ConsoleWrite(TimerDiff($iTimer) / 1000 & " seconds" & @LF)
ConsoleWrite(UBound($aArray) & " variants" & @LF)

_ArrayDisplay($aArray)

Func BitLoopPermute($iBinLen) ; limit = 24 bits
    $iBinLen = Int($iBinLen)
    If $iBinLen < 1 Then Return SetError(1) ; lowest loop size = 1
    If $iBinLen > 24 Then Return SetError(2) ; to remain within array size limits

    Local $sZeros = StringRight('000000000000000000000000', $iBinLen), _
    $oDictionary = ObjCreate("Scripting.Dictionary")
    $oDictionary.Item($sZeros)

    Local $iBound = 2^$iBinLen, $aArray[$iBound]
    For $i = 1 To $iBound -1 Step 2
        $aArray[$i] = $i
    Next

    Local $iInversion
    For $i = 1 To $iBound -1 Step 2
        If $aArray[$i] Then
            $iInversion = $aArray[$i]
            Do
                $iInversion = FirstInversion($iInversion, $iBinLen)
                If $iInversion > $aArray[$i] Then $aArray[$iInversion] = ''
            Until $iInversion = $i ; recursion either due to symmetry or a complete cycle
            $oDictionary.Item(StringRight($sZeros & DecToBase($aArray[$i], 2), $iBinLen)) ; generate new key
        EndIf
    Next

    Return $oDictionary.Keys() ; return array
EndFunc ;==> BitLoopPermute

Func FirstInversion($iInteger, $iLoopSize) ; skips all even numbers
    If $iLoopSize < 2 Then Return $iInteger

    Local $iPosition ; the position of the first set bit
    For $i = 1 To $iLoopSize
        If BitAND(2^($iLoopSize - $i), $iInteger) Then
            $iPosition = $i
            ExitLoop
        EndIf
    Next

    $iInteger -= 2^($iLoopSize - $iPosition) ; remove MSB
    $iInteger *= 2^($iPosition) ; shift the bits right
    $iInteger += 1 ; MSB becomes the LSB

    Return $iInteger
EndFunc ;==> FirstInversion

Func DecToBase($iInt, $iBase) ; for bases 2 to 9
    Local $iRem, $sRet = ''
    While $iInt > $iBase -1
        $iRem = Mod($iInt, $iBase)
        $sRet = $iRem & $sRet
        $iInt = Int(($iInt - $iRem) /$iBase)
    WEnd
    Return $iInt & $sRet
EndFunc ;==> DecToBase

 

Edited August 13, 2016 by czardas

[AndyG]

@czardas, nice idea

But I had an idea, too

We have a "number" and shift it to left until the MSB is at the "bits" position. After that, we rotate that number BITCOUNT times. Bitcount is the number of used bits. 111001 are 6 bits, 111000000111 are 12 bits...

Then there are two cases for every of the next bitcount rotations.

 

First case after rotate: The bit at the left border is 1.

Without any calculation, this number is always a "rotated" (not unique) one, so we can delete it from the array(index).

Rotate means, shift the number left, delete the left bit and write it to the right side. You did that with "strings" in your script.

With "numbers" the calculation of the shift is:  number = number *2 

To delete the left bit : number = number - (2^bits)

To "add" the right bit: number = number +1

resulting formula: number = number * 2 - 2^bits +1  or: number = number * 2 - (2^bits-1)    

If this number is greater than the actual index, this number is always a "rotated" (not unique) one, so we can delete it from the array(index).

 

Second case after rotate: The bit at the left border is 0

0 means, there is no bit to cut from left and add it to the right, only a shift: number =number *2 

 

 

So we reduce the number of rotations to the number of Bits used by the number aka bitcount. This reduces the over all calculation significantly.   

 

expandcollapse popup

#include <Array.au3>                ;


$bits = 14
$ar = 2 ^ ($bits) - 1
ConsoleWrite('@@ Debug(' & @ScriptLineNumber & ') : $ar = ' & Dec2Bin($ar) & @CRLF & '>Error code: ' & @error & @CRLF) ;### Debug Console;


Dim $a[$ar + 1]

For $i = 1 To $ar Step 2            ;all odd numbers
    $a[$i] = $i                     ;into array, even ones are 0
Next

$m = 2 ^ ($bits - 1)                ;msb
$mask = 2 ^ $bits - 1               ;mask

$timer = TimerInit()
For $i = 1 To $ar Step 2            ;all odd numbers
    If $a[$i] <> 0 Then             ;only if not deleted
        $bitcount = Floor(Log($i) / Log(2)) + 1 ;number of bits of the actual number
        $t = BitShift($i, $bitcount - $bits) ;shift to the left border
        $a[$t] = 0                  ;greater numbers are always deleted from array
        For $x = 1 To $bitcount     ;only bitcount loops needed to process the number
            If $t > $m Then         ;only if msb =1
                $a[$t] = 0
                $t = $t * 2 - $mask ;shift left, eliminate msb, add 1 (place msb at bit0)
                If $t > $i Then $a[$t] = 0
            Else
                $t = $t * 2         ;shift left (because msb=0)
            EndIf

        Next
    EndIf
Next
ConsoleWrite("time[ms]= " & TimerDiff($timer) & @CRLF) ;

$r = _ArrayUnique($a)

Dim $c[UBound($r) + 1][2]

For $i = 1 To UBound($r) - 1
    $c[$i][0] = $r[$i]
    $c[$i][1] = Dec2Bin($r[$i])
Next

$z = _ArrayDisplay($c)

Func Dec2Bin($D)
    Return (BitShift($D, 1) ? Dec2Bin(BitShift($D, 1)) : "") & BitAND($D, 1) ;
EndFunc                             ;==>Dec2Bin

 

Edited August 13, 2016 by AndyG

[czardas]

That's what I'm doing in FirstInversion() - I got rid of the strings. BTW I think you must have overlooked something: your last piece of code is not removing the duplicates. Oops I was looking at the final value, not the array index duh! It's working fine (unlike my brain right now).

Edited August 13, 2016 by czardas

[czardas]

45 minutes ago, AndyG said:

Without any calculation, this number is always a "rotated" (not unique) one, so we can delete it from the array(index).

You beast! 

The latency in my version is due to the final string formatting, not the method. And here to prove it is the same script without conversion.

expandcollapse popup

#include <Array.au3>

Local $iBits = 14

Local $aArray, $iTimer
$iTimer = TimerInit()
$aArray = BitLoopPermute($iBits)

ConsoleWrite(TimerDiff($iTimer) / 1000 & " seconds" & @LF)
ConsoleWrite(UBound($aArray) & " variants" & @LF)

_ArrayDisplay($aArray)

Func BitLoopPermute($iBinLen) ; limit = 24 bits
    $iBinLen = Int($iBinLen)
    If $iBinLen < 1 Then Return SetError(1) ; lowest loop size = 1
    If $iBinLen > 24 Then Return SetError(2) ; to remain within array size limits

    ;Local $sZeros = StringRight('000000000000000000000000', $iBinLen), _
    $oDictionary = ObjCreate("Scripting.Dictionary")
    $oDictionary.Item(0)

    Local $iBound = 2^$iBinLen, $aArray[$iBound]
    For $i = 1 To $iBound -1 Step 2
        $aArray[$i] = $i
    Next

    Local $iInversion
    For $i = 1 To $iBound -1 Step 2
        If $aArray[$i] Then
            $iInversion = $aArray[$i]
            Do
                $iInversion = FirstInversion($iInversion, $iBinLen)
                If $iInversion > $aArray[$i] Then $aArray[$iInversion] = ''
            Until $iInversion = $i ; recursion either due to symmetry or a complete cycle
            $oDictionary.Item($aArray[$i]) ; generate new key
        EndIf
    Next

    Return $oDictionary.Keys() ; return array
EndFunc ;==> BitLoopPermute

Func FirstInversion($iInteger, $iLoopSize) ; skips all even numbers
    If $iLoopSize < 2 Then Return $iInteger

    Local $iPosition ; the position of the first set bit
    For $i = 1 To $iLoopSize
        If BitAND(2^($iLoopSize - $i), $iInteger) Then
            $iPosition = $i
            ExitLoop
        EndIf
    Next

    $iInteger -= 2^($iLoopSize - $iPosition) ; remove MSB
    $iInteger *= 2^($iPosition) ; shift the bits right
    $iInteger += 1 ; MSB becomes the LSB

    Return $iInteger
EndFunc ;==> FirstInversion

Func DecToBase($iInt, $iBase) ; for bases 2 to 9
    Local $iRem, $sRet = ''
    While $iInt > $iBase -1
        $iRem = Mod($iInt, $iBase)
        $sRet = $iRem & $sRet
        $iInt = Int(($iInt - $iRem) /$iBase)
    WEnd
    Return $iInt & $sRet
EndFunc ;==> DecToBase

Now it takes approx 0.18 seconds.  Still slower than your version though!

Edited August 13, 2016 by czardas

[AndyG]

hehe, now the challenge is opened...the requirement states up to 20 bit. 

Every bit more multiplies the calculation...

 

// i thought about to split the problem in several "tasks", not for "multitasking" on CPU, thats not worth the work, but using OpenCL on GPU should give a nice speedup. I have written an OpenCL-Implementation in AutoIt, which should do this job...

Edited August 13, 2016 by AndyG

[czardas]

I have corrected a mistake in my previous post. My first version was capable of up to 27 bits*, but I estimate it would have taken about 6 hours. I gave up on that particular version. Keep posting the good code: it's a pleasure to read.

* 27 bits ==> For the output array to be able to contain the estimated number of output variants (not having to write to file).

Edited August 13, 2016 by czardas

[Melba23]

AndyG,

Bravo for the "no need to check when there is a trailing 0 after rotation" brainwave in post #55 above - that more than halved the execution time when I amended my array-based script (although it is still lamentably slow when compared to ones you and czardas have been posting).

M23

expandcollapse popup

#include <Array.au3>

$nBegin = TimerInit()

Local $iBit = 14 ; Number of bits to process

Local $iRows = 500 ; Array size increases

; Create array to hold binary patterns
Local $aBinArray[$iRows][$iBit + 1]

; Add all 0s element to 0 column
$aBinArray[0][0] = 1
$aBinArray[1][0] = ""
For $i = 1 To $iBit
    $aBinArray[1][0] &= "0"
Next

ConsoleWrite("Filling array" & @CRLF)

; Skip all even numbers - they must be duplicates when rotated
For $i = 1 to (2 ^ $iBit) - 1 Step 2
    $sBinary = Dec2Bin($i)                                              ; Create binary string
    $sBinary = StringRegExpReplace($sBinary, "(?U)^(.*)0*$", "$1")      ; Strip any trailing zeros
    $sBinary = StringFormat("%0" & $iBit & "s", $sBinary)               ; Pad with leading zeros as required
    StringReplace($sBinary, "1", "")                                    ; Get number of 1s within it
    $iCount = @extended
    $aBinArray[0][$iCount] +=1                                          ; Determine column in which to add...
    If $aBinArray[0][$iCount] > UBound($aBinArray) - 1 Then             ; ...and resize array if required
        ReDim $aBinArray[UBound($aBinArray) + $iRows][$iBit + 1]
    EndIf
    $aBinArray[$aBinArray[0][$iCount]][$iCount]= $sBinary               ; Store in required column
Next
;_ArrayDisplay($aBinArray, "Full", Default, 8)

ConsoleWrite(TimerDiff($nBegin) & @CRLF)

; Determine column after which we can mirror
$iMirror = Ceiling(($iBit + 1) / 2)

; Create array to hold unique elements
Local $aUnique[UBound($aBinArray) * 2] = [0]

; Create array to hold unique array indices for each column - first 2 cols are only single values
Local $aColIndex[$iBit][2] = [[1, 1], [2, 2]]

; Add elements from first and second columns which are unique by definition
For $i = 0 To 1

    ConsoleWrite("Column: " & $i & @CRLF & "Adding" & @CRLF)

    $aUnique[0] += 1
    $aUnique[$aUnique[0]] = $aBinArray[1][$i]
Next

; Now loop through other columns checking for duplicates when rotated
For $i = 2 To $iMirror - 1 ; No need to go further as later columns are mirrored

    ConsoleWrite("Column: " & $i & @CRLF)

    ; Extract column from main array
    $aCol = _ArrayExtract($aBinArray, 1, $aBinArray[0][$i], $i, $i)

    ConsoleWrite("Rotating"  & @CRLF)

    ; Now work through column rotating each element
    For $j = 0 To UBound($aCol) - 2
        ; String to rotate
        $sRotated = $aCol[$j]
        ; If this element has not already been deleted
        If $sRotated Then
            ; Loop through all possible rotations
            For $k = 1 To $iBit
                ; Compare to elements in array - only need to look below the current element
                For $m = $j + 1 To UBound($aCol) - 1
                    If $aCol[$m] = $sRotated Then
                        ; If there is a match then delete the element
                        $aCol[$m] = ""
                    EndIf
                Next
                ; Rotate string
                While 1
                    $sRotated = StringRight($sRotated, 1) & StringLeft($sRotated, $iBit - 1)
                    ; Check for trailing 0 - automatically no matches
                    If StringRight($sRotated, 1) = 1 Then
                        ; Check this pattern
                        ExitLoop
                    Else
                        ; Try next rotation, so increase count
                        $k += 1
                    EndIf
                WEnd
            Next
        EndIf
    Next

    ConsoleWrite("Adding" & @CRLF)

    ; Set start index for later mirroring
    $aColIndex[$i][0] = $aUnique[0] + 1

    ; Add remaining elements to the unique array
    For $j = 0 To UBound($aCol) - 1
        If $aCol[$j] Then
            $aUnique[0] += 1
            $aUnique[$aUnique[0]] = $aCol[$j]
        EndIf
    Next

    ; Set end index
    $aColIndex[$i][1] = $aUnique[0]

    ConsoleWrite(TimerDiff($nBegin) & @CRLF)

Next

;_ArrayDisplay($aColIndex, "Col indices", Default, 8)

; Now mirror the remaining columns
For $i = $iMirror To $iBit - 2 ; Final 2 columns are already unique

    ConsoleWrite("Column: " & $i & @CRLF)

    ; Determine column to mirror
    $iMirrorCol = $iBit - $i
    ; Mirror found elements

    ConsoleWrite("Mirroring" & @CRLF)

    For $j = $aColIndex[$iMirrorCol][0] To $aColIndex[$iMirrorCol][1]
        $aUnique[0] += 1
        $aUnique[$aUnique[0]] = _Mirror($aUnique[$j])
    Next

    ConsoleWrite(TimerDiff($nBegin) & @CRLF)

Next

; Add elements from the penultimate and final columns which are also are unique by definition
For $i = $iBit - 1 To $iBit

    ConsoleWrite("Column: " & $i & @CRLF & "Adding" & @CRLF)

    $aUnique[0] += 1
    $aUnique[$aUnique[0]] = $aBinArray[1][$i]
Next

ReDim $aUnique[$aUnique[0] + 1]

ConsoleWrite(TimerDiff($nBegin) & @CRLF)

_ArrayDisplay($aUnique, "Unique patterns", Default, 8)

Func _Mirror($sString)

    $aSplit = StringSplit($sString, "")
    $sMirrorString = ""
    For $i = 1 To $aSplit[0]
        $sMirrorString &= ( ($aSplit[$i] = 1) ? (0) : (1) )
    Next

    Return $sMirrorString

EndFunc

Func Dec2Bin($iD)
    Return (BitShift($iD, 1) ? Dec2Bin(BitShift($iD, 1)) : "") & BitAnd($iD, 1)
EndFunc

 

Edited August 13, 2016 by Melba23
Added code