## Friday, April 6, 2012

### 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
self < 0 ifTrue: [^self error: 'Cannot enumerate bits of a negative integer'].
whileFalse:
[aBlock value: mask lowBit.

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.
& 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).
whileFalse:
[aBlock value: mask lowBit + offset.

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:
^ 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
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 |
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