3,2

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.

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

Cf. A130578.

Adjacent sequences: A133250 A133251 A133252 this_sequence A133254 A133255 A133256

Sequence in context: A037068 A122615 A122162 this_sequence A098713 A042022 A142091

nonn

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