The Alioth Shootout has the Meteor contest:
http://shootout.alioth.debian.org/gp4/benchmark.php?test=meteor&lang=all
I have a working solution but with very poor performance compared to the
other entries. I am posting a simplified version here in the hopes I will
get some good suggestions for improvement. This solves the problem in both
depth first search (required for the contest) and breadth first search
(generally better for J).
The part which sets up the game data is probably overcomplicated, but
correct. I am most interested in improving the code after "playing the
game". Unless I have missed it, looking for islands is not feasible.
Best wishes,
John
--------------------------------------------------------------
NB. This requires 64-bit J.
NB. The basic user functions are
NB. dfs <s> : depth first search to produce s solutions
NB. bfs <n> : breadth first search to depth n
NB. where n<:10.
NB. The output is expressed in terms of piece numbers.
NB. Setting up the pieces.
NB. Coordinates from position
cfp =:13 : '((5|y)-y<....@%10),y<....@%5'
C =:cfp"0 i.50
getc=:({&C) :: (_ _"_) "0
NB. Position from coordinates
I =:C+"1 (10 10)
dx =:dy=:30
P =:(i.50) (<"1 I) } _ $~ dx,dy
getp=:13 : ' P {~ < 10 10 + y'"1
NB. Smallest puzzle solution: used to get piece shapes
solution=:'00001222012661126155865558633348893448934747977799'
NB. Extract piece shapes
shapes=:I. (i.10)=/"."0 solution
NB. utility functions
mp=:+/ .* NB. matrix product
I=:13 : '#. |. (i.50) e. y'"1 f. NB. I <list> -> integer
L=:13 : 'I. 50 {. |. #: y'"0 f. NB. L <integer> -> list
NB. symmetry group
id =:>1 0;0 1
ref=:>1 1;0 _1
rot=:>1 1;_1 0
group=:(ref&mp"_1,]) rot&mp^:(i.6) id
orbit=:13 : '|:"2 group mp"1 _ |: getc y'
NB. distribute piece in all orientations and all positions on the board
flood=:[: getp C+"1 / (-"1 {.)
legal=:([: -. _ e. ])"1
getpos=:13 : '~.I (#~ legal),/flood"_1 orbit y'
PIECES=:getpos &.> <"1 shapes
NB. Board graph
R=:rot&mp^:(i.6) 0 1
neighbors=:(#~ _~:])@: getp @:(R+"1 getc)
EG=:(}.@:,"_ neighbors)&.> <"0 i. 50
E=:;(,"_ 0 neighbors)&.> <"0 i. 50
BG=:EG,&.> <"0 i.50 NB. reflexive board graph
NB. Connected components
cc=:3 : 0
g=.y&(e. # [)&.>BG
comp=.50 $ _1
for_v. y do.
if. _1=v{ comp do.
C=.(~.@:/:~@:;@:({&g))^:_ v
comp=.v C } comp
end.
end.
*./0=5|#&></.~ comp-._1
)
NB. Global arrays holding game data
PC=:;PIECES NB. positions occupied by pieces, integer form
LPC=:L PC NB. positions occupied by pieces, list form
N=:#PC NB. number of pieces
PN=:(#&> PIECES) # i.10 NB. piece number
FIRST=:{."1 LPC NB. first cell occupied
FIRSTB=:(/:~ FIRST) </. ( (i.N)/: FIRST) NB. FIRSTB has index first
ff=:13 : '<y#~ x=y{PN'
gg=:13 : 'y ff~"_ 0 i.10'
FIRSTBB=:50 {. >gg&.>FIRSTB
BADPIECES=:(-.cc"1 (i.50)-."_ 1 LPC) # i.#PC
FIRSTBB=:FIRSTBB-.&.> <BADPIECES NB. FIRSTBB is indexed by first,piecenumber
GOODCAP=:1-*(17 b.)/~PC NB. 1=(<i,j) { GOODCAP if pieces i and j do not
intersect
NB. This is the only place 64 bit code is used. The same effect on 32 bit
NB. with loss of performance in initialization, though not at runtime can
be achieved by saying:
NB. ncap=:(#=#@:~.)@:,
NB. GOODCAP=:LPC ncap"1/LPC
NB. Playing the game
NB. first move
init=:,.;{.FIRSTBB
NB. We always put the next piece starting in the first empty cell.
firstempty=:13 : '{. (i.50)-., y { LPC'"1
unused=:13 : '(i.10)-.y{PN'"1
NB. Extend a single position
xtend1=:3 : 0
cand0=.; (<(firstempty y);(unused y)){ FIRSTBB
y,"_ 0 cand0 #~ *./(<y;cand0) { GOODCAP
)
NB. Extend a list of positions
xtend=:13 : ';xtend1&.><"1 y'
NB. Breadth first search
bfs=:13 : 'xtend^:(y-1) init'
NB. Depth first search
dfs=:3 : 0
r=.(0,10)$ 0
stack=.<"1 \:~ init
while. #stack do.
s=.>{: stack
stack=.}: stack
if. #s do.
if. 10=#s do.
r=.r,s
if. y=#r do. r return. end.
else.
e=.xtend s
if. #e do.
stack=.stack,<"1 \:~ xtend s
end.
end.
end.
end.
r
)
----------------------------------------------------------------------
For information about J forums see http://www.jsoftware.com/forums.htm
