I’ve been making notes when I have time, on the “17 x 17 challenge” posted a couple months back by Bill Gasarch. I’ve been sketching out algorithms for the problem and wanted to quickly produce some optimal rectangle free subsets to check my work and look at. So the code below answers the following question:

Imagine an n x n grid. You can color cells of the grid such that no rectangle overlayed on the grid will have all four corners colored. Find a grid with the maximum possible colored cells.

So this is a quick and stupid brute force algorithm, but it let me see an optimal 6-grid, which is what I needed. First out imports:

1
2
3

import Data.List
import Control.Monad
import Data.Ord

We’ll call a colored cell True, uncolored False:

1
2

type Row = [Bool]
type Grid = [Row]

Given the side length, we’ll spit out all the possible ways a row can be colored:

1
2

allRows :: Int -> [Row]
allRows = mapM (\a-> [a,not a]) . flip replicate True

A quick function to see if two rows form a rectangle:

1
2

areRectFree :: Row -> Row -> Bool
areRectFree r1 = not . or . delete True . zipWith (&&) r1

An ugly function to return all the n-length ordered subsets of the ordered set of rows. (Note: a grid can move about its columns and rows without changing itself fundamentally, which is why we do the extra effort to not return every n-length permutation of the rows):

1
2
3
4
5
6
7
8

allGrids :: Int -> [Grid]
allGrids n = allSubsets n (2^n) (allRows n)
    where allSubsets 0 _ _ = [[]]
          allSubsets ln (i+1) (r:rs)
            | ln > i    = [r:rs]
            | otherwise =
               [ r:rs' | rs' <- allSubsets (ln-1) i rs ] ++
               allSubsets ln i rs

Validate a grid by making sure each pair is rectangle free with every other…

1
2
3

validGrid :: [Row] -> Bool
validGrid [] = True
validGrid (r:rs) = all (areRectFree r) rs && validGrid rs

…and tie it all together:

1
2

bestSubset = maximumBy mostColored . filter validGrid . allGrids
    where mostColored = comparing (length . filter id . concat)

So a best subset of size four looks like:

[[True,True,False,False],[True,False,True,False],[True,False,False,True],[False,True,True,True]]

And a pretty picture:

+--+--+--+--+
|XX|XX|  |  |
+--+--+--+--+
|XX|  |XX|  |
+--+--+--+--+
|XX|  |  |XX|
+--+--+--+--+
|  |XX|XX|XX|
+--+--+--+--+

Does anyone have a more elegant way to represent the allGrids function? In the general sense it finds all n-length ordered subsets of an ordered set when the length of the set is known.