So our naive algorithm costs quite a lot. The analysis of MessageTally tells it is not in the initialization phase, but rather in the solving phase. Let's measure how many iterations we performed:
solvedPuzzleDo: solutionBlock
^self searchPuzzlesWithPermutation: (1 to: pieces size) asArray rank: 1 mask: 0 pieces: pieces copy ifFound: solutionBlock
^self searchPuzzlesWithPermutation: (1 to: pieces size) asArray rank: 1 mask: 0 pieces: pieces copy ifFound: solutionBlock
| index boardLowBit count |
count := 1.
i > perms size
ifTrue:
[solutionBlock value: (self boardStringWithPieces: pArray).
^count].
boardLowBit := (boardMask + 1) lowBit.
i to: perms size do: [:j |
index := perms at: j.
perms swap: i with: j.
((positionsPerPiece at: index) at: boardLowBit) do: [:rotMask |
0 = (boardMask bitAnd: rotMask)
ifTrue:
[pArray at: index put: rotMask.
count := count + (self searchPuzzlesWithPermutation: perms rank: i + 1 mask: boardMask + rotMask pieces: pArray ifFound: solutionBlock)]].
perms swap: i with: j].
^count
ShootoutMeteorBoard default solvedPuzzleDo: [:e | ]
-> 3096168
Since 10 loops are necessary for producing a solution, (but 11 are counted) and since there are 2098 solutions, that's 23078 productive loops...
First, we perform a minor refactoring: we handle permutations with a color bit mask, beacause it is more in line with the style of our algorithm:
searchPuzzlesWithColorMask: colorMask boardMask: boardMask pieces: pArray ifFound: solutionBlock
| boardLowBit colorBit count |
count := 1.
colorMask = 0
ifTrue:
[solutionBlock value: (self boardStringWithPieces: pArray).
^count].
boardLowBit := (boardMask + 1) lowBit.
colorBit := 1.
1 to: pArray size do: [:colorRank |
(colorMask bitAnd: colorBit) = 0
ifFalse: [
((positionsPerPiece at: colorRank) at: boardLowBit) do: [:rotMask |
0 = (boardMask bitAnd: rotMask)
ifTrue:
[pArray at: colorRank put: rotMask.
count := count + (self searchPuzzlesWithColorMask: colorMask - colorBit boardMask: boardMask + rotMask pieces: pArray ifFound: solutionBlock)]]].
colorBit := colorBit * 2].
^count
| boardLowBit colorBit count |
count := 1.
colorMask = 0
ifTrue:
[solutionBlock value: (self boardStringWithPieces: pArray).
^count].
boardLowBit := (boardMask + 1) lowBit.
colorBit := 1.
1 to: pArray size do: [:colorRank |
(colorMask bitAnd: colorBit) = 0
ifFalse: [
((positionsPerPiece at: colorRank) at: boardLowBit) do: [:rotMask |
0 = (boardMask bitAnd: rotMask)
ifTrue:
[pArray at: colorRank put: rotMask.
count := count + (self searchPuzzlesWithColorMask: colorMask - colorBit boardMask: boardMask + rotMask pieces: pArray ifFound: solutionBlock)]]].
colorBit := colorBit * 2].
^count
^self searchPuzzlesWithColorMask: 1 << pieces size - 1 boardMask: 0 pieces: pieces copy ifFound: solutionBlock
Now let's look an individual piece position:
| board |
board printMask: (((board := ShootoutMeteorBoard default) instVarNamed: 'pieces') at: 5)
...0 0 0 0 0
0 0 1 0 0
0 0 0 1 1
0 0 1 0 1
Ah yes, some are always invalid, because they generate a hole that we will never be able to fill. How could we detect this ?
For south row, this is easy, if there is one or more zero holes between ones, then there is a hole we cannot fill. Translated into bit tricks:
hasInsetZero: aMask
| allOnes |
allOnes := aMask bitOr: aMask - 1.
^(allOnes bitAnd: allOnes + 1) > 0
| allOnes |
allOnes := aMask bitOr: aMask - 1.
^(allOnes bitAnd: allOnes + 1) > 0
The first operation replaces trailing zeroes with ones:
110011000 mask 0111000
| 110010111 mask - 1 | 0110111
110011111 0111111
The second one replace trailing ones with zeroes
110011111 allOnes 0111111
& 110100000 allOnes + 1 & 1000000
110000000 0000000If the result is different from zero, then yes, there is an inset zero...
hasSouthOrNorthIsland: aMask
^(self hasInsetZero: (southEdge bitAnd: aMask))
^(self hasInsetZero: (southEdge bitAnd: aMask))
or: [self hasInsetZero: (northEdge bitAnd: aMask)]
What about east and west edges ?
If we bitAnd the piece mask with eastEdge, then we are looking for some bit pattern like
00001
00000
00001
How to remove the four west most columns? Well we don't, we fill them with 1s multiplying with 11111 (this happens to be our southEdge)
->
11111
00000
11111
Magically, we can use the hasInsetZero: trick on above bit pattern
hasEastOrWestIsland: aMask ^ (self hasInsetZero: southEdge * (eastEdge bitAnd: aMask))
or: [self hasInsetZero: southEdge * (westEdge bitAnd: aMask)]
There is one more case to eliminate, which is the hole in a corner. But a piece could fit in that corner if it has exactly 5 cell holes. In fact, a single piece can generate up to 7 holes:
...
0 0 0 0 0
0 0 0 1 1
0 0 1 0 0
0 0 1 0 0
0 1 0 0 0
0 0 0 0 0
0 0 0 1 1
0 0 1 0 0
0 0 1 0 0
0 1 0 0 0
One solution is to fill the mask with ones and count the filled bits
fill: aMask startingAt: pos count: countBlock| filled |
(aMask bitAnd: pos) = 0 ifFalse: [^aMask].
countBlock value.
filled := aMask + pos.
(self canShiftE: pos)
ifTrue: [filled := self fill: filled startingAt: (self shiftE: pos) count: countBlock].
(self canShiftNE: pos)
ifTrue: [filled := self fill: filled startingAt: (self shiftNE: pos) count: countBlock].
(self canShiftNW: pos)
ifTrue: [filled := self fill: filled startingAt: (self shiftNW: pos) count: countBlock].
(self canShiftW: pos)
ifTrue: [filled := self fill: filled startingAt: (self shiftW: pos) count: countBlock].
(self canShiftSW: pos)
ifTrue: [filled := self fill: filled startingAt: (self shiftSW: pos) count: countBlock].
(self canShiftSE: pos)
ifTrue: [filled := self fill: filled startingAt: (self shiftSE: pos) count: countBlock].
^filled
It could be interesting to factor above code with a loop on directions as proposed in Part1, but we'll let that as an exercise. We could also change the countBlock into a fillCount instance variable, we are state-full after all. We won't bother right now.
fill: aMask startingAt: pos
| count |
count := 0.
self fill: aMask startingAt: pos count: [count := count + 1].
^count
| count |
count := 0.
self fill: aMask startingAt: pos count: [count := count + 1].
^count
hasCornerIsland: aMask edge: verticalEdge edge: horizontalEdge
| corner |
^(aMask bitAnd: verticalEdge) > 0
and: [(aMask bitAnd: horizontalEdge) > 0
and: [(aMask bitAnd: (corner := verticalEdge bitAnd: horizontalEdge)) = 0
and: [(self fill: aMask startingAt: corner) \\ 5 > 0]]]
| corner |
^(aMask bitAnd: verticalEdge) > 0
and: [(aMask bitAnd: horizontalEdge) > 0
and: [(aMask bitAnd: (corner := verticalEdge bitAnd: horizontalEdge)) = 0
and: [(self fill: aMask startingAt: corner) \\ 5 > 0]]]
Let's detect these simple cases altogether and remove them from possible positions:
hasIsland1: aMask
^(self hasEastOrWestIsland: aMask)
or: [(self hasCornerIsland: aMask edge: southEdge edge: eastEdge)
or: [(self hasCornerIsland: aMask edge: southEdge edge: westEdge)
or: [(self hasCornerIsland: aMask edge: northEdge edge: eastEdge)
or: [(self hasCornerIsland: aMask edge: northEdge edge: westEdge)
or: [self hasSouthOrNorthIsland: aMask]]]]]
^(self hasEastOrWestIsland: aMask)
or: [(self hasCornerIsland: aMask edge: southEdge edge: eastEdge)
or: [(self hasCornerIsland: aMask edge: southEdge edge: westEdge)
or: [(self hasCornerIsland: aMask edge: northEdge edge: eastEdge)
or: [(self hasCornerIsland: aMask edge: northEdge edge: westEdge)
or: [self hasSouthOrNorthIsland: aMask]]]]]
Again, some tests will be duplicated, but we don't care yet, this is not a big CPU contributor.
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 |
(self hasIsland1: shifted) ifFalse: [(possible at: shifted lowBit) add: shifted]]].
possible collect: [:e | e asArray]].
positionsPerPiece := pieces collect: [:aPiece |
| possible |
possible := (Array new: ncell) collect: [:lowBit | Set new: 12].
self rotationsOf: aPiece do: [:rotated |
self placesFor: rotated do: [:shifted |
(self hasIsland1: shifted) ifFalse: [(possible at: shifted lowBit) add: shifted]]].
possible collect: [:e | e asArray]].
MessageTally spyOn: [ShootoutMeteorBoard solveDefault].
Still gives the good result, and now take a bit less than 13s.ShootoutMeteorBoard default solvedPuzzleDo: [:e | ]
-> 1999211
OK, we saved about 33% loops, and gained about 33% speed with this simple trick.
Now we can also see that turning the board by 180° gives us another possible solution. Great! we can add the pieces into a Set and stop as soon as we reach the quota of solutions.
Turning 180° is just reversing bit pattern, or reversing the compact string solution:
Deceivingly, we don't get a factor 2 speed up, only 2 seconds...
We transform the loopCount into an instance variable and count loops again:
ShootoutMeteorBoard class>>solveDefaultUntilFound: n
| board solutions |
solutions := Set new: n.
board := ShootoutMeteorBoard default.
^[:print |
board solvedPuzzleDo:
[:aString |
(solutions add: aString; add: aString reversed; size) >= n ifTrue: [^print value] ].
print value] value:
[solutions := solutions sorted.
String streamContents:
[:outputStream |
outputStream print: solutions size; nextPutAll: ' solutions found'; cr; cr.
board printSolution: solutions first on: outputStream.
outputStream cr.
board printSolution: solutions last on: outputStream]]
| board solutions |
solutions := Set new: n.
board := ShootoutMeteorBoard default.
^[:print |
board solvedPuzzleDo:
[:aString |
(solutions add: aString; add: aString reversed; size) >= n ifTrue: [^print value] ].
print value] value:
[solutions := solutions sorted.
String streamContents:
[:outputStream |
outputStream print: solutions size; nextPutAll: ' solutions found'; cr; cr.
board printSolution: solutions first on: outputStream.
outputStream cr.
board printSolution: solutions last on: outputStream]]
Deceivingly, we don't get a factor 2 speed up, only 2 seconds...
We transform the loopCount into an instance variable and count loops again:
-> 1664525 loops
Hmm case of unlucky ordering of pieces?
This is at http://ss3.gemstone.com/ss/Shootout/Shootout.blog-nice.3.mcz
But we don't really need a Set... We can omit the emission of those symmetric solutions by removing 3 rotations (and flipped rotations) of a single piece:
(ShootoutMeteorBoard default instVarNamed: 'positionsPerPiece')
collect: [:e | e detectSum: [:e2 | e2 size]]
-> #(195 221 231 228 219 273 231 263 183 228)
The piece of rank 6 seems more interesting
(ShootoutMeteorBoard default instVarNamed: 'positionsPerPiece')
collect: [:e | e detectSum: [:e2 | e2 size]]
-> #(195 221 231 228 219 273 231 263 183 228)
The piece of rank 6 seems more interesting
rotationsOf: aPieceMask do: aBlock
| next |
aBlock value: (next := aPieceMask); value: (self flip: next).
((aPieceMask = (pieces at: 6)) ifTrue: [2] ifFalse: [5])
timesRepeat: [aBlock value: (next := self rotate: next); value: (self flip: next)]
| next |
aBlock value: (next := aPieceMask); value: (self flip: next).
((aPieceMask = (pieces at: 6)) ifTrue: [2] ifFalse: [5])
timesRepeat: [aBlock value: (next := self rotate: next); value: (self flip: next)]
Then we add the symmetric solution again like in our Set variant:
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:
[:direct |
{direct. direct reversed} do: [:aString |
count := count + 1.
aString < minSolution ifTrue: [minSolution := aString].
aString > maxSolution ifTrue: [maxSolution := aString]]. ].
outputStream print: board loopCount; nextPutAll: ' loops'; cr;cr.
outputStream print: count; nextPutAll: ' solutions found'; cr; cr.
board printSolution: minSolution on: outputStream.
outputStream cr.
board printSolution: maxSolution on: outputStream]
^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:
[:direct |
{direct. direct reversed} do: [:aString |
count := count + 1.
aString < minSolution ifTrue: [minSolution := aString].
aString > maxSolution ifTrue: [maxSolution := aString]]. ].
outputStream print: board loopCount; nextPutAll: ' loops'; cr;cr.
outputStream print: count; nextPutAll: ' solutions found'; cr; cr.
board printSolution: minSolution on: outputStream.
outputStream cr.
board printSolution: maxSolution on: outputStream]
MessageTally spyOn: [ShootoutMeteorBoard solveDefault].
-> 1081569 loops
And a bit less than 7s.
This is at http://ss3.gemstone.com/ss/Shootout/Shootout.blog-nice.4.mcz
We have already saved 66% computations with easy steps.
We have already saved 66% computations with easy steps.
In next iteration, we'll try harder.
No comments:
Post a Comment