## Friday, April 6, 2012

### Playing with Meteor contest in Smalltalk - Part 1

The shootout language benchmarks can be a source of fun too.
It will provide us this little exercise: the meteor contest.

The game consists in finding all the possible pavements of a 10x5 hexagonal cells board with 10 pieces of 5 hexagons.

The obvious idea is to represent the board as a bit mask, where 1 means occupied cells, 0 means free cells.
Also each piece can be represented as a bit mask of occupied cell.

I decided to initialize the pieces from the string representation of a board:
ShootoutMeteorBoard class>>default
^self basicNew fromString:
'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'
Where each digit represent a different color.

ShootoutMeteorBoard>>fromString: aString
| rawString |
rawString := aString reject: [:e | e isSeparator].
pieces := rawString asSet sorted collect: [:char |
rawString inject: 0 into: [:pmask :c | pmask * 2 + (c = char ifTrue: [1] ifFalse: [0])]].
The least significant bit is located at SE corner.

The pieces can be rotated in 6 different directions (E, NE, NW, W, SW, SE) and also flipped, giving 12 different orientations.
Here is our trivial ideas:
1. Generate all possible positions of a piece on the board.
2. Then fill the board starting at south east, and progressing along the bit rank, toward W, then N directions.
3. Try this for all different permutations of the colors, so as to generate all the possible solutions.
This is a rather naive algorithm, which won't be efficient because it will explore too many combinations. But let's do it, we will then see how to reduce the costs.

Lets see how to shift toward different directions : a piece cannot be shifted if it is already on an edge, so we have to test that. Let's just do it with bit masks. We modify a bit fromString:
ncell := rawString size.
ncol := (aString readStream upTo: Character cr) count: [:e | e isSeparator not].
nrow := ncell / ncol.
twoRows := ncol * 2.

And
southEdge := 1 << ncol - 1.
southToNorthMasks := (0 to: nrow - 1) collect: [:i | southEdge << (ncol * i)].
eastEdge := 1<<ncell-1/southEdge.
eastToWestMasks := (0 to: ncol - 1) collect: [:i | eastEdge << i].

Ah, good old bit tricks, remember the division I used in variant of Sieve of Eratosthenes?
If not, you can read old pages of this blog.
You see, 2r000010000100001 * 2r11111 -> 2r111111111111111, so just reverse the operation and you'll see that the division is the a way to create a bit pattern with one bit set every n bit.

Just for debug purpose, printing a mask won't be luxury
We just have to enumerate all bits from HSB to LSB.
nrow to: 1 by: -1 do: [:irow |
irow odd ifTrue: [aStream space].
1 to: ncol do: [:icol |
aStream
ifTrue: [\$0]
ifFalse: [\$1]);
space].
aStream cr]
^String new: ncol * 2 + 1 * nrow streamContents: [:aStream | self printMask: aPieceMask on: aStream]

0 0 0 0 0
1 1 1 1 1
0 0 0 0 0
1 1 1 1 1
0 0 0 0 0
1 1 1 1 1
0 0 0 0 0
1 1 1 1 1
0 0 0 0 0
1 1 1 1 1

Good, in Smalltalk indices starts at 1, the the 1st row is odd (this is the south one).

But why do we need masks for odd and even rows ? Lets see with color 7
...
0 0 0 0 0
0 7 0 7 0
7 7 7 0 0
There is one cell on the W edge, but since it is on an odd row this does not prevent us to shift toward NW.
...
7 0 7 0 0
7 7 7
0 0
0 0 0 0 0
Now there is a 7 on an even west edge, we cannot shift toward NE anymore...
Indeed, NE east shift shifts odd rows by 5, but even rows are shifted by 1 more bit. Thus:
| evens odds |
^evens << 1 + odds << ncol
| evens odds |
^odds >> 1 + evens << ncol
| evens odds |
^odds >> 1 + evens >> ncol
| evens odds |
^evens << 1 + odds >> ncol

Shifting toward E, or W is more trivial:

But we must first test if we can shift.

If we want to enumerate the directions, we can encode them with an integer:
E := 1.
NE := 2.
NW := 3.
W := 4.
SW := 5.
SE := 6.
at: E put: eastEdge;
at: NE put: (northEdge bitOr: (eastEdge bitAnd: oddRowsMask)));
at: NW put: (northEdge bitOr: (westEdge bitAnd: evenRowsMask)));
at: W put: westEdge;
at: SW put: (southEdge bitOr: (westEdge bitAnd: evenRowsMask)));
at: SE put: (southEdge bitOr: (eastEdge bitAnd: oddRowsMask))

And now, let's test:

And if we want to generalize the shifts too,
(oddShifts := Array new: 6)
at: E put: -1;
at: NE put: ncol - 1;
at: NW put: ncol;
at: W put: 1;
at: SW put: 0 - ncol;
at: SE put: -1 - ncol.
(evenShifts := Array new: 6)
at: E put: -1;
at: NE put: ncol;
at: NW put: ncol + 1;
at: W put: 1;
at: SW put: 1 - ncol;
at: SE put: 0 - ncol.

Now we are going to shift a piece to the south east most position possible.

Does it work ?
| board |
(board := ShootoutMeteorBoard default) printMask: (board shiftSEmost: ((board instVarNamed: 'pieces') at: 8))
...
0 0 0 0 0
0 0 0 0 0
0 0 1 0 1
0 1 1 1 0
OK, fine.
Now, let's flip the piece. we can flip east-west or north-south.
But in both cases, the odd rows becomes even, so we have to shift by ncol in either direction.
or

That's it... Here is the N-S version
| board |
(board := ShootoutMeteorBoard default) printMask: (board flip: ((board instVarNamed: 'pieces') at: 8))
...
0 0 0 0 0
0 0 0 0 0
0 0 1 1 1
0 0 1 0 1

and the E-W
| board |
(board := ShootoutMeteorBoard default) printMask: (board flipEW: ((board instVarNamed: 'pieces') at: 8))
...
0 0 0 0 0
0 0 0 0 0
0 0 1 0 1
0 0 1 1 1
OK

Now the rotation is a bit more involving with just these shifts...
Here is our algorithm, assuming the piece is shifted SE most:
1) choose the pivot point, invariant during rotation on south row, west most.
| rotatedMask pivot rotatedPivot irow row |
irow := 1.
rotatedPivot := pivot := 1 << (row highBit - 1).
2) choose to rotate anti clock wise and sweep the board toward east. if the next cell is toward east, then the next rotated cell will be toward NE.
[(row bitAnd: pivot - 1) = 0]
whileFalse:
[pivot := self shiftE: pivot.
rotatedPivot := self shiftNE: rotatedPivot.
(row bitAnd: pivot) = 0
ifFalse:
3) Now continue on next row, toward north, until it is empty
(row := aPieceMask bitAnd: (southToNorthMasks at: (irow := irow + 1))) = 0]
whileFalse:
4) Begin scanning NE of pivot if possible
[(self canShiftNE: pivot)
ifTrue:
[pivot := self shiftNE: pivot.
rotatedPivot := self shiftNW: rotatedPivot]
ifFalse:
[pivot := self shiftNW: pivot.
rotatedPivot := self shiftW: rotatedPivot].
5) Then scan toward west, until west most is encountered on this row
[row >= (pivot << 1)]
whileTrue:
[pivot := self shiftW: pivot.
Notice that shifting SW is dangerous, we might rotate a cell out of the board.
We detect such case and move the rotated piece two rows up.
(self canShiftSW: rotatedPivot)
ifFalse:
[rotatedPivot := rotatedPivot << twoRows.
rotatedPivot := self shiftSW: rotatedPivot]].
6) Now we're done, just shift the result SE most to follow our convention

Surely a bit too clever, this will by far be our worse method. Let's just try it:

| board |
(board := ShootoutMeteorBoard default) printMask: (board rotate: ((board instVarNamed: 'pieces') at: 8))
...
0 0 0 0 0
0 0 0 0 0
0 0 0 0 1
0 0 0 0 1
0 0 0 1 1
0 0 0 1
Good. If I tell you that above code was not my first attempt, you'll probably believe me. How great it is to have an interpreted language and a good debugger, it's invaluable for those super fast feedback loops.

Now lets enumerate possible orientations of a piece:
| next |
aBlock value: (next := aPieceMask); value: (self flip: next).
5 timesRepeat:  [aBlock value: (next := self rotate: next); value: (self flip: next)]

Then shift a piece at every possible position.
We start SE most, then scan toward W while possible, then toward NE if possible, else toward NW, this gonna give us a quite regular code:

We are ready to fulfil our first algorithm step, that is to generate all possible pieces positions, which is the map of possible position for each orientation of each piece
initializePossiblePositions
positionsPerPiece := pieces collect: [:aPiece |
| possible |
possible := (Array new: ncell) collect: [:lowBit | Set new: 12].
self rotationsOf: aPiece do: [:rotated |
self placesFor: rotated do: [:shifted |
(possible at: shifted lowBit) add: shifted]].
possible collect: [:e | e asArray]].

Our step is finished, let's put it together
fromString: aString
| rawString |
rawString := aString reject: [:e | e isSeparator].
ncell := rawString size.
ncol := (aString readStream upTo: Character cr) count: [:e | e isSeparator not].
twoRows := ncol * 2.
nrow := ncell / ncol.