(*this code, which is written in three blocks, will find the number of 9x9 puzzles with dihedral symmetry group*) newcenters = {{{0}}, {{1}}}; For[m = 1, m <= 1, m++, nc = 2 m + 1; v = Ceiling[nc/2]; leftrows = Table[PadLeft[IntegerDigits[k, 2], v], {k, 0, 2^v - 1}]; rightrows = Reverse /@ leftrows; symmetricrows = Table[Drop[Join[leftrows[[i]], rightrows[[i]]], {v}], {i, Length[leftrows]}]; no101s = Function[FreeQ[Partition[#1, 3, 1], {1, 0, 1}]]; no1001s = Function[FreeQ[Partition[#1, 4, 1], {1, 0, 0, 1}]]; legalrows = Select[Select[symmetricrows, no1001s], no101s]; potentialnewcenters = {}; For[j = 1, j <= Length[legalrows], j++, droppedcorners = Drop[Drop[legalrows[[j]], 1], -1]; insertsides = Function[ Transpose[ Append[Prepend[Transpose[#], droppedcorners], droppedcorners]]]; insertlegalrow = Function[Append[Prepend[#, legalrows[[j]]], legalrows[[j]]]]; framethecenter = Function[insertlegalrow /@ (insertsides /@ #)]; framedpuzzles = framethecenter[newcenters]; potentialnewcenters = Append[potentialnewcenters, framedpuzzles]]; potentialcenters = Flatten[potentialnewcenters, 1]; allno101s = Function[Apply[And, Map[no101s, #, {1}]]]; allno1001s = Function[Apply[And, Map[no1001s, #, {1}]]]; newcenters = Select[Select[potentialcenters, allno101s], allno1001s]; insertzeros = Function[Append[Prepend[#1, 0], 0]]; rowofzeros = Table[0, {nc + 2}]; insertzerorows = Function[Append[Prepend[#1, rowofzeros], rowofzeros]]; framewithwhite = Function[insertzerorows[insertzeros /@ #]]; framedpuzzles = framewithwhite /@ newcenters; (*framedpuzzles now contains the new centers surrounded by white; we \ need to eliminate the disconnected ones*) connectedcount = 0; legalcentercount = 0; legalcenters = {}; For[k = 1, k <= Length[framedpuzzles], k++, framedpuzzlegraph = Table[framedpuzzles[[k, r, s]], {r, 1, nc + 2}, {s, 1, nc + 2}]; verts = {}; For[i2 = 1, i2 <= nc + 2, i2++, For[j2 = 1, j2 <= nc + 2, j2++, If[framedpuzzlegraph[[i2, j2]] == 1, verts = Append[verts, j2 + (nc + 2)^2 - (nc + 2)*i2]]]]; theframedgraph = DeleteVertices[GridGraph[nc + 2, nc + 2], verts]; If[ConnectedQ[theframedgraph] == True, legalcentercount = legalcentercount + 1; legalcenters = Append[legalcenters, newcenters[[k]]] ]]; plotnice /@ legalcenters; Print["The number of possible ", nc, " x ", nc, " centers of a sufficiently large puzzle with dihedral symmetry is \ ", Length[legalcenters]]; ] n = 9; v = Ceiling[n/2]; leftrows = Union[Table[PadLeft[IntegerDigits[k, 2], v], {k, 0, 2^(v - 3) - 1}], Table[PadLeft[IntegerDigits[k, 2], v], {k, 2^(v - 1), 2^v - 2}]]; rightrows = Reverse /@ leftrows; symmetricrows = Table[Drop[Join[leftrows[[i]], rightrows[[i]]], {v}], {i, Length[leftrows]}]; (*legalrows contains only those symmetric rows with internal runs of \ white having length at least 3*) legalrows = Select[Select[symmetricrows, no1001s], no101s]; toprows = Tuples[legalrows, 3]; takefirst3 = Function[Take[#, 3]]; takefirst4 = Function[Take[#, 4]]; nonisolatedcorners = Function[takefirst4 /@ # != {{0, 0, 0, 1}, {0, 0, 0, 1}, {0, 0, 0, 1}}]; corners = Function[takefirst3 /@ # == Transpose[takefirst3 /@ #]]; toprowswithgoodcorners = Select[Select[toprows, corners], nonisolatedcorners]; transposedtoprows = Transpose /@ toprowswithgoodcorners; freeof101s = Function[FreeQ[#, {1, 0, 1}]]; freeof011s = Function[FreeQ[#, {0, 1, 1}]]; freeof010s = Function[FreeQ[#, {0, 1, 0}]]; freeof001s = Function[FreeQ[#, {0, 0, 1}]]; legaltransposedtoprows = Select[Select[ Select[Select[transposedtoprows, freeof101s], freeof011s], freeof010s], freeof001s]; legaltoprows = Transpose /@ legaltransposedtoprows; legalbottomrows = Reverse /@ legaltoprows; leftsides = legaltransposedtoprows; rightsides = Map[Reverse, legaltransposedtoprows, {2}]; losecorners = Function[Drop[Drop[#, 3], -3]]; frameleft = losecorners /@ leftsides; frameright = losecorners /@ rightsides; completeframes = {}; runningTotal = 0; For[t = 1, t <= Length[legalcenters], t++, completeframes = {}; middlerows = Map[Flatten, Table[{frameleft[[i, j]], legalcenters[[t, j]], frameright[[i, j]]}, {i, 1, Length[frameleft]}, {j, 1, n - 6}], {2}]; completeframes = Append[completeframes, Table[Join[legaltoprows[[i2]], middlerows[[i2]], legalbottomrows[[i2]]], {i2, 1, Length[legaltoprows]}]]; completePuzzles = Flatten[completeframes, 1]; takefirst1 = Function[Take[#, 1]]; checkmiddlerows = Flatten[ takefirst1 /@ Map[Union, Table[MemberQ[legalrows, completePuzzles[[v, w]]], {v, 1, Length[completePuzzles]}, {w, 4, n - 3}]]]; noshortwords = Pick[completePuzzles, checkmiddlerows]; connectedcount = 0; For[t2 = 1, t2 <= Length[noshortwords], t2++, crosswordgraph = Table[noshortwords[[t2]][[r, n + 1 - s]], {r, 1, n}, {s, 1, n}]; verts = {}; For[i2 = 1, i2 <= n, i2++, For[j2 = 1, j2 <= n, j2++, If[crosswordgraph[[i2, j2]] == 1, verts = Append[verts, j2 + n^2 - n*i2]]]]; thegraph = DeleteVertices[GridGraph[n, n], verts]; If[ConnectedQ[thegraph] == True, connectedcount = connectedcount + 1]]; runningTotal = runningTotal + connectedcount; Print["The number of possible ", n, " x ", n, " puzzles with dihedral symmetry using legal center ", t, " is ", connectedcount, " (", runningTotal, ")"] ]