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

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.
10110010000

For the case of LargeInteger, it is more efficient to avoid repeated allocation of LargeInteger:
LargePositiveInteger>>bitsDo: aBlock
1 to: self digitLength do: [:iByte |
offset := iByte - 1 << 3.
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.

Indeed:
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)
and continue with permutations of higher ranks
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:
| 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:
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 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