Meteor contest Part 2 - the naive solution

To continue our Meteor contest, we now have to enumerate all possible pavements...

First, a method was missing in previous post:

Integer>>bitsDo: aBlock
    | mask |
    self < 0 ifTrue: [^self error: 'Cannot enumerate bits of a negative integer'].
    mask := self.
    [mask = 0]
        whileFalse:
            [aBlock value: mask lowBit.
            mask := mask bitAnd: mask - 1]

The trick here is that mask bitAnd: mask - 1 sets the lowest 1-bit to 0, thus having as many loops as the bitCount. The rest is obvious.

  10110011000 mask

& 10110010111 mask - 1

  10110010000

For the case of LargeInteger, it is more efficient to avoid repeated allocation of LargeInteger:

LargePositiveInteger>>bitsDo: aBlock
     | mask offset |
    1 to: self digitLength do: [:iByte |
        offset := iByte - 1 << 3.
        mask := (self digitAt: iByte).
        [mask = 0]
            whileFalse:
                [aBlock value: mask lowBit + offset.
                mask := mask bitAnd: mask - 1]]

One possibility is to generate all permutations of colors like squeak does:

searchPuzzlesWithPermutation: perms rank: i
    | index boardLowBit |
    i > perms size ifTrue: [ ^perms ].
    i to: perms size do: [:j |
        perms swap: i with: j.
       self searchPuzzlesWithPermutation: perms rank: i + 1]].
        perms swap: i with: j].
    ^nil

Then, we need to pass the occupied boardMask and isolate the next free cell in it, which happens to be the lowest bit at 0. Using a bit trick
    nextFreeCell := (boardMask + 1) lowBit.

Or we could have used (boardMask bitXor: boardMask + 1) highBit
Indeed:

  10110010111 boardMask

^ 10110011000 boardMask + 1

  00000001111

We then have to enumerate possible orientations of i-th color piece which fit into this board,

    ((positionsPerPiece at: colorIndex) at: nextFreeCell) do: [:rotMask | 

If the place is free

    0 = (boardMask bitAnd: rotMask)

then record the rotated and shifted pieceMask into pArray (indexed by color rank)

     pArray at: index put: rotMask.

and continue with permutations of higher ranks

     self searchPuzzlesWithPermutation: perms rank: i + 1 mask: boardMask + rotMask pieces: pArray ifFound: solutionBlock.

When found, the string-i-fied solution is passed as argument to a block of code.
    i > perms size ifTrue: [ ^solutionBlock value: (self boardStringWithPieces: pArray) ].

Putting it all together:

searchPuzzlesWithPermutation: perms rank: i mask: boardMask pieces: pArray ifFound: solutionBlock
    | colorIndex boardLowBit |
    i > perms size ifTrue: [ ^solutionBlock value: (self boardStringWithPieces: pArray) ].
   nextFreeCell := (boardMask + 1) lowBit.
    i to: perms size do: [:j |
        colorIndex := perms at: j.
        perms swap: i with: j.
        ((positionsPerPiece at: colorIndex) at: nextFreeCell) do: [:rotMask |
            0 = (boardMask bitAnd: rotMask)
                ifTrue:
                    [pArray at: index put: rotMask.
                    self searchPuzzlesWithPermutation: perms rank: i + 1 mask: boardMask + rotMask pieces: pArray ifFound: solutionBlock]].
        perms swap: i with: j].
    ^nil

At upper level, we initiate the search loop with:

solvedPuzzleDo: solutionBlock
    self searchPuzzlesWithPermutation: (1 to: pieces size) asArray rank: 1 mask: 0 pieces: pieces copy ifFound: solutionBlock

We then have to print the solutions, in the compact form:

boardStringWithPieces: pArray
    | board |
    board := String new: ncell.
    pArray keysAndValuesDo: [:k :p | | c |
        c := '0123456789' at: k.
        p bitsDo: [:bitPos | board at: bitPos put: c]].
    ^board

or in the nicer board form:

printSolution: aString on: aStream
    | src |
    src := aString readStream.
    [src atEnd]
        whileFalse:
            [1 to: ncol do: [:j | aStream nextPut: src next; space].
            aStream cr.
            1 to: ncol do: [:j | aStream space; nextPut: src next].
            aStream cr]

and we are done:

ShootoutMeteorBoard class>>solveDefault
    ^String streamContents: [:outputStream |
        | board count minSolution maxSolution |
        count := 0.
        minSolution := String new: 50 withAll: $9.
        maxSolution := String new: 50 withAll: $0.
        (board := ShootoutMeteorBoard default) solvedPuzzleDo:
            [:aString |
                count := count + 1.
                aString < minSolution ifTrue: [minSolution := aString].
                aString > maxSolution ifTrue: [maxSolution := aString]. ].
        outputStream print: count; nextPutAll: ' solutions found'; cr; cr.
        board printSolution: minSolution on: outputStream.
        outputStream cr.
        board printSolution: maxSolution on: outputStream]

This works great, but rather slooowwwwly.
MessageTally spyOn: [ShootoutMeteorBoard solveDefault].
2098 solutions found

0 0 0 0 1
 2 2 2 0 1
2 6 6 1 1
 2 6 1 5 5
8 6 5 5 5
 8 6 3 3 3
4 8 8 9 3
 4 4 8 9 3
4 7 4 7 9
 7 7 7 9 9

9 9 9 9 8
 9 6 6 8 5
6 6 8 8 5
 6 8 2 5 5
7 7 7 2 5
 7 4 7 2 0
1 4 2 2 0
 1 4 4 0 3
1 4 0 0 3
 1 1 3 3 3

Almost 20 seconds on my mac mini with a Cog VM...
The version is at http://ss3.gemstone.com/ss/Shootout/Shootout.blog-nice.1.mcz

In next steps we are going to break this work