
MATHEMATICA

<< DiscreteMath`Combinatorica` (*This program counts, lists and displays the possible 2  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 ];
tworows = Tuples [ legalrows, 2 ];
addrows = Function [ Plus [ # [ [ 1 ] ], # [ [ 2 ] ] ] ];
goodrows = Function [ Not [ FreeQ [ Plus [ # [ [ 1 ] ], # [ [ 2 ] ] ], 0 ] ] ];
goodtworows = Select [ tworows, goodrows ];
Print [ "the number of tworow arrangements in a ", n, " x ", n, " puzzle is \
", Length [ goodtworows ] ];
plotnice /@ goodtworows;
]
