First and most obvious, we can use runQ to see the abstract TH syntax which a quasi-quoted expression expands to:

Prelude> :set -XTemplateHaskell
Prelude> :m + Language.Haskell.TH
Prelude Language.Haskell.TH> runQ [| \a -> a+1 |]
LamE [VarP a_1] (InfixE (Just (VarE a_1)) (VarE GHC.Num.+) (Just (LitE (IntegerL 1))))

The second thing that was really helpful to me was turning on the dump-splices debugging option which causes GHC to print the expansions of all $(top-level splices):

Prelude Language.Haskell.TH> :set -ddump-splices 
Prelude Language.Haskell.TH> :l Zipper.hs
[1 of 1] Compiling Zipper           ( Zipper.hs, interpreted )
Zipper.hs:1:0:
    Zipper.hs:1:0: Splicing declarations
        mkLabelsNoTypes ['Test]
      ======>
        Zipper.hs:119:2-25
        t1 = lens _t1 (\ b a -> a {_t1 = b})
        t2 = lens _t2 (\ b a -> a {_t2 = b})
Zipper.hs:1:0:
    Zipper.hs:1:0: Splicing declarations
        mkLabelsNoTypes ['Zipper]
      ======>
        Zipper.hs:123:2-27
        lStack = lens stack (\ b a -> a {stack = b})
        focus = lens _focus (\ b a -> a {_focus = b})
Ok, modules loaded: Zipper.

You can use splices directly in GHCi with the XTemplateHaskell extension turned on (although you get some funny output with -ddump-splices, perhaps related to this):

*Zipper Language.Haskell.TH> let tup = $(tupE $ take 4 $ cycle [ [| "hi" |] , [| 5 |] ])
*Zipper Language.Haskell.TH> tup
("hi",5,"hi",5)

That’s all for now! Let me know if you have any tips and I’ll add them here.

Note: this is part of a series of posts is related to the “17×17 Challenge” posted by Bill Gasarch. The goal is to color cells of a 17 by 17 grid, using only four colors, such that no rectangle is formed from four cells of the same color.

Just a few follow-ups to my previous post in which I use a simulated annealing-type algorithm to find a good (hopefully complete) cover of a grid by swapping rows and columns from four identical sub-grids of 74 colors.

Easing into new thresholds

I modified my algorithm so that the likelihood of jumping into the highest permitted energy level is decreased over time; thus instead of having an abrupt transition to a new threshold, resulting in a steep dive, we instead ease into the new energy level.

Here is a graph of a run with the adjusted meta-heuristic (in blue) alongside a previous abrupt threshold transition run (in black). You can check compare it to the graph from the previous post:

Unfortunately this change didn’t cause any improvement in the solutions generated. They still seem to flatten at a grid with 19 – 22 uncolored cells.

Testing a combination of sub-grids with known good solution

I wondered if the lower bound I was smacking into was caused by the fact that I was trying to find a combination of four permutations of the same subset, and perhaps this particular subset didn’t mesh all that well with itself.

In the original blog posting laying out this challenge there is four-coloring of 17×17 with only one cell left un-colorable in a truly painful refactoring process, I modified my script to take four separate and distinct sub-grids and perform the same shuffling procedure.

Rather than find the original arrangement of the colored subsets or one nearly as good, the program settles on a solution with around 30 uncolored cells. That is worse than my original version, corresponding to the fact that there are fewer cells to work with in this latter set of colored subsets: 288 vs. 296.

Conclusion

This doesn’t say anything about whether a full-cover can likely be obtained by permuting four overlapping copies of a single subset of colors. It does tell us that either my code is flawed, this isn’t a particularly effective method for this kind of search, or it needs to be tuned better.

Note: this is part of a series of posts is related to the “17×17 Challenge” posted by Bill Gasarch. The goal is to color cells of a 17 by 17 grid, using only four colors, such that no rectangle is formed from four cells of the same color.

In my last post I noticed that all of the smaller optimal single-colorings I generated showed diagonal symmetry, meaning that row 1 is the same as column 1, row 8 is the same as column 8, etc. It’s my hypothesis that all complete single-colorings are symmetrical in this way.

I decided to play with making the known 74-cell subset symmetrical by applying rotations and came up with this:

Figuring out an automorphism that would give me that diagonal symmetry was easier than inputting the original points into Google Spreadsheet. The colors show the hints that helped anchor the rotations. (I’m going to try to come up with an algorithm for permuting a grid into a symmetrical form).

It seems that symmetry is a very interesting quality in a graph, but when the Graph Theorists study symmetric graphs, they are looking at graphs with where (as I understand it)

any two linked vertices can be mapped onto any to other linked vertices, resulting in essentially the same graph

…which is much cooler. Another interesting thing to mention is that a valid coloring is essentially a hypergraph where the higher dimensional edges are the row/column relationship. It can be flattened into a graph in any number of ways, for example by connecting every colored cell with it’s four neighbors (possibly itself).

So up next for me is a brute force algorithm for single-colorings generated symmetrically.

This isn’t clear from the docs, and you might try to do this and wonder at the output you got:

*Main> groupBy (< =) [3,4,5,3,2,1,4,4,1,1,2,3,4,5,4,5,6,7]
[[3,4,5,3],[2],[1,4,4,1,1,2,3,4,5,4,5,6,7]]

We can redefine groupBy as follows, so that the supplied predicate function compares adjacent elements one-by-one and returns True if they should be grouped together:

> groupBy' :: (a -> a -> Bool) -> [a] -> [[a]]
> groupBy' c []     = []
> groupBy' c (a:as) = (a:ys) : groupBy' c zs
>     where (ys,zs) = spanC a as
>           spanC _  []    = ([], [])
>           spanC a' (x:xs)
>             | a' `c` x   = let (ps,qs) = spanC x xs 
>                            in (x:ps,qs)
>             | otherwise = ([], x:xs)

Now we can use the groupBy function to return a list of ascending lists, like we (probably) wanted:

*Main> groupBy' (< =) [3,4,5,3,2,1,4,4,1,1,2,3,4,5,4,5,6,7]
[[3,4,5],[3],[2],[1,4,4],[1,1,2,3,4,5],[4,5,6,7]]

The functionality is of course the same for groupBy (==).

A function like group is in this category. It’s conceptually very simple, but defining it actually requires a bit of indirection. Here I’ve translated the definition from Data.List to use explicit recursion:

66 > group :: (Eq a) => [a] -> [[a]]
67 > group []     = []
68 > group (a:as) = (a:ys) : group zs
69 >     where (ys,zs) = spanEq as
70 >           spanEq []     = ([], [])
71 >           spanEq (x:xs)
72 >             | a == x    = let (ps,qs) = spanEq xs 
73 >                            in (x:ps,qs)
74 >             | otherwise = ([], x:xs)
75

I think if I were asked to define this having never seen it, the first thing I would think of would be something using foldl1, which wouldn’t work.

EDIT: see also an alternative definition for Data.List.groupBy