Smallissimo: Playing with Meteor contest in Smalltalk

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.

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:

Generate all possible positions of a piece on the board.
Then fill the board starting at south east, and progressing along the bit rank, toward W, then N directions.
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.
self initializeRowColMasks.

And

ShootoutMeteorBoard>>initializeRowColMasks
    southEdge := 1 << ncol - 1.
    southToNorthMasks := (0 to: nrow - 1) collect: [:i | southEdge << (ncol * i)].
    northEdge := southToNorthMasks last.
    eastEdge := 1<<ncell-1/southEdge.
    eastToWestMasks := (0 to: ncol - 1) collect: [:i | eastEdge << i].
    westEdge := eastToWestMasks last.
    oddRowsMask := 1<<ncell-1/(1<<twoRows-1)*southEdge.
    evenRowsMask := oddRowsMask << ncol.

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.

ShootoutMeteorBoard>>printMask: aPieceMask on: aStream
| mask |
mask := 1 << ncell.

    nrow to: 1 by: -1 do: [:irow |
        irow odd ifTrue: [aStream space].
        1 to: ncol do: [:icol |
            aStream
                nextPut: ((aPieceMask bitAnd: (mask := mask >> 1)) = 0
                    ifTrue: [$0]
                    ifFalse: [$1]);
                space].
        aStream cr]

ShootoutMeteorBoard>>printMask: aPieceMask
^String new: ncol * 2 + 1 * nrow streamContents: [:aStream | self printMask: aPieceMask on: aStream]

Lets try, ShootoutMeteorBoard default printMask: (ShootoutMeteorBoard default instVarNamed: 'oddRowsMask')

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:

shiftNW: aPieceMask
    | evens odds |
    odds := oddRowsMask bitAnd: aPieceMask.
    evens := evenRowsMask bitAnd: aPieceMask.
    ^evens << 1 + odds << ncol

shiftNE: aPieceMask
    | evens odds |
    odds := oddRowsMask bitAnd: aPieceMask.
    evens := evenRowsMask bitAnd: aPieceMask.
    ^odds >> 1 + evens << ncol

shiftSE: aPieceMask
    | evens odds |
    odds := oddRowsMask bitAnd: aPieceMask.
    evens := evenRowsMask bitAnd: aPieceMask.
    ^odds >> 1 + evens >> ncol

shiftSW: aPieceMask
    | evens odds |
    odds := oddRowsMask bitAnd: aPieceMask.
    evens := evenRowsMask bitAnd: aPieceMask.
    ^evens << 1 + odds >> ncol

Shifting toward E, or W is more trivial:

shiftE: aPieceMask
^aPieceMask >> 1

shiftW: aPieceMask
^aPieceMask << 1

But we must first test if we can shift.

canShiftNW: aPieceMask

^(aPieceMask bitAnd: (northEdge bitOr: (westEdge bitAnd: evenRowsMask))) = 0

canShiftNE: aPieceMask

^(aPieceMask bitAnd: (northEdge bitOr: (eastEdge bitAnd: oddRowsMask))) = 0

canShiftSW: aPieceMask

^(aPieceMask bitAnd: (southEdge bitOr: (westEdge bitAnd: evenRowsMask))) = 0

canShiftSE: aPieceMask

^(aPieceMask bitAnd: (southEdge bitOr: (eastEdge bitAnd: oddRowsMask))) = 0

canShiftE: aPieceMask
^(aPieceMask bitAnd: eastEdge) = 0

canShiftW: aPieceMask
^(aPieceMask bitAnd: westEdge) = 0

If we want to enumerate the directions, we can encode them with an integer:

ShootoutMeteorBoard>>initializeShiftMasks
    E := 1.
    NE := 2.
    NW := 3.
    W := 4.
    SW := 5.
    SE := 6.

(canShiftMasks := Array new: 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:

canShift: aPieceMask toward: aDirection

^(aPieceMask bitAnd: (canShiftMasks at: aDirection)) = 0

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.

shift: aPieceMask toward: aDirection

^((aPieceMask bitAnd: oddRowsMask) bitShift: (oddShifts at: aDirection)) +

((aPieceMask bitAnd: evenRowsMask) bitShift: (evenShifts at: aDirection))

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

shiftSEmost: aPieceMask
    | mostSEMask eastColumn lowBit |
    aPieceMask odd ifTrue: [^aPieceMask].
    lowBit := aPieceMask lowBit.
    mostSEMask := aPieceMask >> (lowBit - 1 // (2*ncol) * (2*ncol)).
    (mostSEMask bitAnd: southEdge) = 0
        ifTrue: [mostSEMask := (self canShiftSE: mostSEMask)
            ifTrue: [self shiftSE: mostSEMask]
            ifFalse: [self shiftSW: mostSEMask]].
    eastColumn := eastToWestMasks findFirst: [:e | (e bitAnd: mostSEMask) > 0].
    ^mostSEMask >> (eastColumn - 1)

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.

flip: aPieceMask
   ^self shiftSEmost: (southToNorthMasks
        inject: 0 into: [:mask :rowMask |
            mask << ncol + ((rowMask bitAnd: aPieceMask) >> (rowMask lowBit - 1))]) >> ncol

flipEW: aPieceMask
   ^self shiftSEmost: (eastToWestMasks
        inject: 0 into: [:mask :columnMask |
            mask << 1 + ((columnMask bitAnd: aPieceMask) >> (columnMask lowBit - 1))]) << ncol

That's it... Here is the N-S version

| board |
(board := ShootoutMeteorBoard default) printMask: (board flip: ((board instVarNamed: 'pieces') at: 8))

...

and the E-W

| board |
(board := ShootoutMeteorBoard default) printMask: (board flipEW: ((board instVarNamed: 'pieces') at: 8))

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.

rotate: aPieceMask
    | rotatedMask pivot rotatedPivot irow row |
    rotatedMask := 0.
    irow := 1.
    row := aPieceMask bitAnd: (southToNorthMasks at: irow).
    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.

    [rotatedMask := rotatedMask + rotatedPivot.
    [(row bitAnd: pivot - 1) = 0]
        whileFalse:
            [pivot := self shiftE: pivot.
            rotatedPivot := self shiftNE: rotatedPivot.
            (row bitAnd: pivot) = 0
                ifFalse:
                    [rotatedMask := rotatedMask + rotatedPivot]].

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.
                            rotatedMask := rotatedMask << twoRows.].
                    rotatedPivot := self shiftSW: rotatedPivot]].

6) Now we're done, just shift the result SE most to follow our convention
^self shiftSEmost: rotatedMask

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))

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:

rotationsOf: aPieceMask do: aBlock
    | 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:

placesFor: aPieceMask do: aBlock
    | westMask eastMask cellNumber |
    eastMask := self shiftSEmost: aPieceMask.

    [[westMask := eastMask.
    [aBlock value: westMask.
    self canShiftW: westMask] whileTrue: [westMask := self shiftW: westMask].
    self canShiftNE: eastMask] whileTrue: [eastMask := self shiftNE: eastMask].
    self canShiftNW: eastMask] whileTrue: [eastMask := self shiftNW: eastMask]

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.
    self initializeRowColMasks.
    pieces := rawString asSet asSortedArray collect: [:char |
        self shiftSEmost:
            (rawString inject: 0 into: [:pmask :c | pmask * 2 + (c = char ifTrue: [1] ifFalse: [0])])].
    self initializePossiblePositions.

Next step will be in next post. If you are impatient, code is located at squeaksource3. But it might be better with explanations, I was rather sparing with comments, following the existing Shootout code style.

Smallissimo

Friday, April 6, 2012

Playing with Meteor contest in Smalltalk - Part 1

No comments:

Post a Comment