OFFSET
3,2
COMMENTS
In a standard American crossword puzzle, such as those in the New York Times, in any row there must be at least one run of white squares and all runs of white squares must be of length at least three.
MATHEMATICA
<<DiscreteMath`Combinatorica`
(*This program counts, lists and displays the possible 3 - row patterns in an n x n crossword puzzle*)
plotnice = ArrayPlot [ #, Frame -> False, Mesh -> True, MeshStyle -> \
GrayLevel [ 0 ] ] &;
For [ n = 3, n <= 7, n++,
usablemods = {0, 1, 3, 7};
usablenumbers = Function [ MemberQ [ usablemods, Mod [ #, 8 ] ] ];
goodnumbers = Union [ Table [ k, {k, 0, 2^(n - 3) - 1} ], Table [ k, {k,
2^(n - 1), 2^n - 2} ] ];
numbers = Select [ goodnumbers, usablenumbers ];
rows = Table [ PadLeft [ IntegerDigits [ numbers [ [ j ] ],
2 ], n ], {j, 1, Length [ numbers ]} ];
no101s = Function [ FreeQ [ Partition [ #1, 3, 1 ], {1, 0, 1} ] ];
no1001s = Function [ FreeQ [ Partition [ #1, 4, 1 ], {1, 0, 0, 1} ] ];
legalrows = Select [ Select [ rows, no1001s ], no101s ];
threerows = Tuples [ legalrows, 3 ];
transposedthreerows = Transpose /@ threerows;
freeof101s = Function [ FreeQ [ #, {1, 0, 1} ] ];
transposedno101s = Select [ transposedthreerows, freeof101s ];
legalthreerows = Transpose /@ transposedno101s;
insertzerorows = Function [ Append [ Prepend [ #, Table [ 0, {n} ] ], Table [ 0, {n} ] ] ];
legalthreerowswithzeros = insertzerorows /@ legalthreerows;
finalthreerows = {};
legalthreerowscount = 0;
For [ v = 1, v <= Length [ legalthreerowswithzeros ], v++,
puzzlegraph = Table [ legalthreerowswithzeros [ [ v, r, s ] ], {r,
1, 5}, {s, 1, n} ];
verts = {};
For [ i2 =
1, i2 <= 5, i2++, For [ j2 = 1, j2
<= n, j2++, If [ puzzlegraph [ [ i2, j2 ] ] == 1, verts = Append [
verts, j2 + 5n - n*i2 ] ] ] ];
thegraph = DeleteVertices [ GridGraph [ n, 5 ], verts ];
If [ ConnectedQ [ thegraph ] == True, connectedcount = connectedcount + 1 ];
(*graph = ShowGraph [ thegraph, DisplayFunction -> Identity ];
thepuzzle = ArrayPlot [ legalthreerowswithzeros [ [ v ] ], Frame -> False,
Mesh -> True, MeshStyle -> GrayLevel [
0 ], DisplayFunction -> Identity ]; *)
(*Show [ GraphicsArray [ {thepuzzle, graph} ] ]; *)
(*Print [ ConnectedQ [ thegraph ] ]; *)
If [ ConnectedQ [ thegraph ] == True, legalthreerowscount = \
legalthreerowscount +
1; finalthreerows = Append [ finalthreerows, legalthreerows [ [ v ] ] ] ];
]
plotnice /@ finalthreerows;
Print [ "the number of threerow arrangements in a ", n, " x ", n, " puzzle is ", legalthreerowscount ] ]
CROSSREFS
KEYWORD
nonn
AUTHOR
Marc A. Brodie (mbrodie(AT)wju.edu), Jan 03 2008
STATUS
approved