A133253 Number of possible 3 X n arrangements of black and white squares that can form three consecutive rows in an n X n crossword puzzle.

1, 23, 159, 649, 2424, 9574, 39913, 166639, 678898

Offset: 3

Author

Marc A. Brodie (mbrodie(AT)wju.edu), Jan 03 2008

Keywords

• nonn

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.

Crossrefs

Cf. A130578.

Programs

Mathematica

< 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 ] ]