$define fun procedure $define loc local $define ret return $define suc return &null $define _ &null $define write writes $define nl print("\n") fun print(args[]) ;ret write!([&output]|||args); end ##================================================================================ ## Solve the b.dazzle Scramble-Squares puzzle, in Icon - by Eugene Reimer 2004Dec ## ## Each square tile contains 4 half-objects; ## the objects are of 4 kinds, e.g. red, yellow, green, blue. ## Using an uppercase letter for a head-half, lowercase for a tail-half. ##================================================================================ fun N(t) ;ret t[1]; end ##the North half-object of tile t fun E(t) ;ret t[2]; end ##the East half-object of tile t fun S(t) ;ret t[3]; end ##the South ... fun W(t) ;ret t[4]; end ##the West ... fun C(x) ;ret char(ixor(ord(x),32)); end ##the other half for a given half-object fun O(t,n) ;ret case n of{0:t; 1:t[2]||t[3]||t[4]||t[1]; 2:t[3]||t[4]||t[1]||t[2]; 3:t[4]||t[1]||t[2]||t[3]}; end ##rotate tile t by n quarter-turns fun put(t) ##just appends to 3 strings: linetop, linemid, linebot linetop||:= " " ||N(t)||" " ||" " linemid||:= W(t)||" " ||E(t)||" " linebot||:= " " ||S(t)||" " ||" " suc;end fun putbeg() ;linetop:=linemid:=linebot:=""; suc;end fun putprt() ;print(linetop,"\n",linemid,"\n",linebot,"\n"); suc;end fun print3tiles(t1,t2,t3) ;putbeg(); put(t1); put(t2); put(t3); nl; putprt(); suc;end global linetop,linemid,linebot fun main(arg) ;loc t0,t1,T,M,ct,j,o,t,x,NX,EX,SX,WX,NEX,ESX,SWX,WNX,c,d; loc j11,j12,j13,j21,j22,j23,j31,j32,j33, o11,o12,o13,o21,o22,o23,o31,o32,o33, t11,t12,t13,t21,t22,t23,t31,t32,t33 t0:=&time ##-- the 9 tiles of father's NA-Birds puzzle, each in North,East,South,West order: T:= [ "bGRB", "ygBY", "YRBg", "yGBr", "YrBg", "bRYG", "bgYR", "bgrY", "bgry" ] ##-- the NA-Birds puzzle shown on b.dazzle website, each in N,E,S,W order -- HAS NO SOLUTION: ##T:= [ "rBYY", "gYrb", "ygRr", "GbRg", "ByGY", "rBrY", "RYbg", "gbYg", "GYgB" ] ##-- print the 9 tiles T1 T2...T9, plus 4 orientations of tile T1, explaining the notation: print("Solving the 9-tile Bird-Puzzle:\n") print("\nThe 9 tiles, where B=head of Blue object, b=tail of Blue object, Y/y for Yellow, R/r for Red, G/g for Green:\n\n") print("T1 T2 T3 T4 T5 T6 T7 T8 T9 \n") print("--- --- --- --- --- --- --- --- ---\n") putbeg(); put(T[1]); put(T[2]); put(T[3]); put(T[4]); put(T[5]); put(T[6]); put(T[7]); put(T[8]); put(T[9]); putprt() print("\nRotations will be shown as in the following, of tile T1 in all 4 orientations:\n\n") print("T1/0 T1/1 T1/2 T1/3\n") print("---- ---- ---- ----\n") putbeg(); put(O(T[1],0)); put(O(T[1],1)); put(O(T[1],2)); put(O(T[1],3)); putprt(); nl ##-- build indices on West, North, West+North, etc: NX:=table([]); EX:=table([]); SX:=table([]); WX:=table([]); NEX:=table([]); ESX:=table([]); SWX:=table([]); WNX:=table([]) every(j:=1 to 9, o:=0 to 3, t:=O(T[j],o))do{ NX[N(t)] |||:= [[j,o]]; NEX[N(t)||E(t)] |||:= [[j,o]] EX[E(t)] |||:= [[j,o]]; ESX[E(t)||S(t)] |||:= [[j,o]] SX[S(t)] |||:= [[j,o]]; SWX[S(t)||W(t)] |||:= [[j,o]] WX[W(t)] |||:= [[j,o]]; WNX[W(t)||N(t)] |||:= [[j,o]] } ##-- print the indices (DEBUG only): ##print("\n\nTiles indexed by West half-object:") ##every c:=!"rygbBGYR" do {print("\nWest=",c,":"); every x:=!(WX[c]) do{j:=x[1];o:=x[2];print(" T",j,"/",o)}} ##print("\n\nTiles indexed by West+North half-objects:") ##every c:=!"rygbBGYR" do ##every d:=!"rygbBGYR" do {print("\nWest+North=",c,d,":"); every x:=!(WNX[c||d])do{j:=x[1];o:=x[2];print(" T",j,"/",o)}} ##nl;nl ##--solve the puzzle: ct:=0 every(j22:=1 to 9, o22:=0, t22:=T[j22])do every(x:=! SX[C(N(t22)) ], j12:=x[1], o12:=x[2], t12:=O(T[j12],o12))do if not member(set([j22 ]), j12)then every(x:=! WX[C(E(t22)) ], j23:=x[1], o23:=x[2], t23:=O(T[j23],o23))do if not member(set([j22,j12 ]), j23)then every(x:=!SWX[C(N(t23))||C(E(t12))], j13:=x[1], o13:=x[2], t13:=O(T[j13],o13))do if not member(set([j22,j12,j23 ]), j13)then every(x:=! EX[C(W(t22)) ], j21:=x[1], o21:=x[2], t21:=O(T[j21],o21))do if not member(set([j22,j12,j23,j13 ]), j21)then every(x:=!ESX[C(W(t12))||C(N(t21))], j11:=x[1], o11:=x[2], t11:=O(T[j11],o11))do if not member(set([j22,j12,j23,j13,j21 ]), j11)then every(x:=! NX[C(S(t22)) ], j32:=x[1], o32:=x[2], t32:=O(T[j32],o32))do if not member(set([j22,j12,j23,j13,j21,j11 ]), j32)then every(x:=!NEX[C(S(t21))||C(W(t32))], j31:=x[1], o31:=x[2], t31:=O(T[j31],o31))do if not member(set([j22,j12,j23,j13,j21,j11,j32 ]), j31)then every(x:=!WNX[C(E(t32))||C(S(t23))], j33:=x[1], o33:=x[2], t33:=O(T[j33],o33))do if not member(set([j22,j12,j23,j13,j21,j11,j32,j31]), j33)then { ct+:=1; print("\n-- A SOLUTION --\n") print("11:T",j11,"/",o11," 12:T",j12,"/",o12," 13:T",j13,"/",o13, " 21:T",j21,"/",o21," 22:T",j22,"/",o22," 23:T",j23,"/",o23, " 31:T",j31,"/",o31," 32:T",j32,"/",o32," 33:T",j33,"/",o33); nl print3tiles(t11,t12,t13); print3tiles(t21,t22,t23); print3tiles(t31,t32,t33); nl } print("Number of solutions: ", ct); nl t1:=&time; print("time:",(t1-t0),"ms","\n") ##-- Trying all 9! arrangements in all 4^9 orientations, would take years to run! ##-- To make solving faster, use indices, eg: ##-- placing 2nd and 3rd tiles in first row can be made faster by an index on West-sides; ##-- placing 2nd and 3rd tiles in first col can be made faster by an index on North-sides; ##-- placing the remaining 4 tiles can be made faster by an index on West+North-sides. ##-- Note: brute-force for steps 1 and 2, takes minutes instead of years, since ##-- 5!*4^5= 120*1024 is about one-millionth of 9!*4^9= 362,880*262,144. ##-- Results, on a 1.0Ghz AMD-Duron cpu: ##-- A. simple try-everything method, runs in about 10 years; ##-- B. simple method for row-1, column-1, index for other 4 positions, runs in about 10 minutes; ##-- C. with indices wherever possible, runs in about 10 centi-seconds (the 4 solutions version); ##-- D. with indices; only one orientation in centre starting position, runs in 1 centi-second (and 1 solution rather than 4). suc;end