/ http://shootout.alioth.debian.org/debian/benchmark.php?test=meteor&lang=all#about / http://www-128.ibm.com/developerworks/java/library/j-javaopt/ / P = pieces P:()!() P[`b]:`e`e`e`se P[`y]:`se`sw`w`sw P[`p]:`w`sw`se`se P[`w]:`sw`w`se`se P[`g]:`w`se`se`sw P[`t]:`se`sw`ne`e`se P[`k]:`ne`ne`nw`sw P[`m]:`nw`sw`sw`se P[`r]:`e`e`ne`e P[`c]:`e`e`ne`se / Q = rotations D:`nw`w`sw`se`e`ne!`w`sw`se`e`ne`nw Q:()!() Q[!P]:5 D\'P@!P / Q , rotations of flips E:`nw`w`sw`se`e`ne!`ne`e`se`sw`w`nw Q[!P]:Q[!P],'E@/:Q@!P / R = reversals F:`nw`w`sw`se`e`ne!`se`e`ne`nw`w`sw R:()!() R[!P]:F@/:Q@!P / N = neighbors n:{(`nw`ne`w`e`sw`se i)!x i:&x>-1} N:n'(-1 -1 -1 1 -1 5 -1 -1 0 2 5 6 -1 -1 1 3 6 7 -1 -1 2 4 7 8 -1 -1 3 -1 8 9 0 1 -1 6 10 11 1 2 5 7 11 12 2 3 6 8 12 13 3 4 7 9 13 14 4 -1 8 -1 14 -1 -1 5 -1 11 -1 15 5 6 10 12 15 16 6 7 11 13 16 17 7 8 12 14 17 18 8 9 13 -1 18 19 10 11 -1 16 20 21 11 12 15 17 21 22 12 13 16 18 22 23 13 14 17 19 23 24 14 -1 18 -1 24 -1 -1 15 -1 21 -1 25 15 16 20 22 25 26 16 17 21 23 26 27 17 18 22 24 27 28 18 19 23 -1 28 29 20 21 -1 26 30 31 21 22 25 27 31 32 22 23 26 28 32 33 23 24 27 29 33 34 24 -1 28 -1 34 -1 -1 25 -1 31 -1 35 25 26 30 32 35 36 26 27 31 33 36 37 27 28 32 34 37 38 28 29 33 -1 38 39 30 31 -1 36 40 41 31 32 35 37 41 42 32 33 36 38 42 43 33 34 37 39 43 44 34 -1 38 -1 44 -1 -1 35 -1 41 -1 45 35 36 40 42 45 46 36 37 41 43 46 47 37 38 42 44 47 48 38 39 43 -1 48 49 40 41 -1 46 -1 -1 41 42 45 47 -1 -1 42 43 46 48 -1 -1 43 44 47 49 -1 -1 44 -1 48 -1 -1 -1) / island detection isl:{[v] while[(#v)>i:v?0b;c:1;v[i]:1b while[#i:?,/{x@!x}'N(),i;c+:#i@:&~v i;v[i]:1b] if[c-5*c div 5;:0b]];1b} / positions on board b of piece c, transformation t, cell i pos:{[b;c;t;i]b,(b N\i_Q[c;t]),b N\|i#R[c;t]} / print solution / print:{`0:(,""),(10#1 0)!'-1 10#,/2$'_ssr[x;" ";"."];} / K = pieces x transformations x cells (nb: piece t has an extra cell) K:+(,/,/:\:)/(!Q;!12;!6) K:K[;&(5>K 2)|`t=*K] / I = all positions of all permutations of all pieces at all positions / C = corresponding colors (pieces) I:{(pos[x]'). K}'!50 / all positions w:(&~0N in')'I / where valid positions I:I@'w / keep those positions C:,/'$K[0;w] / keep those colors w:I{&~y>&/'x}'!50 / where i <= cell in position I:I@'w / keep those positions C:C@'w / keep those colors w:&0<#:'w / where non-empty I@:w / keep those positions C@:w / keep those colors / S = solution counter, T = termination, U = recursion counter S:0 T:2098 U:0 / solve solve:{[b] U+:1 / count recursions if[S=T;:()] / if terminate, exit if[(#b)=p:b?" ";S+:1;:,b] / if no empties, return solution if[p=#C;:()] / if no colors for this position, exit c:C p;i:I p / colors, positions w:&~c in?b / where unused colors w@:&~i[w](|/in)\:&~b=" " / where no overlap t:@[b;;:;]'[i w;c w] / place colors at positions t@:&isl'~t=" " / eliminate islands ,/solve't} / solve next layer / run -> T solutions B:solve 50#"" \ nb: because solve is tail-recursive, we can rewrite it as a convergence: solve:{[b] if[(#b)=p:b?" ";:,b] / if no empties, return solution if[p=#C;:()] / if no colors for this position, exit c:C p;i:I p / colors, positions w:&~c in?b / where unused colors w@:&~i[w](|/in)\:&~b=" " / where no overlap t:@[b;;:;]'[i w;c w] / place colors at positions t@:&isl'~t=" " / eliminate islands t} / return set B:(,/solve')/,50#"" / solve all