Building some domino tilings in code

Draft of 2017.09.19

May include: gamesgraphicscombinatoricsClojuredomino tiling&c.

I realized that it’s well-past time (after three [12 • 3] long-winded muse-pieces on the subject) to try to programmatically generate and visualize some domino tilings of a plane region of a square lattice.

I spent a while today (well, a few hours to be honest) refreshing my memory on how to build simple quil animations. And a few more hours trying to recall how to compile them to production, and include them in a web page….

But here:

There’s not a lot going on here, yet, though it’s been an interesting day.

What you’re seeing is a… I guess 20x20 region of a square lattice. I initially tile it with dominoes, and just because of why the hell not I positioned them all like little vertical tablets. So each domino covers two square cells of the lattice.

They’re all slightly different colors, mainly because they were all the same color for most of the day—a vibrating pink color—and it made my head hurt watching.

Then (as soon as you open or reload this page) a little diffusion dance starts: a random domino is picked, and if it has at least one “snug neighbor” (one that lines up right next to it on the long sides), it will rotate with one of its snug neighbors in a random direction. So if you see two little guys laying horizontally like an equal sign = at some point, there is a chance they will eventually rotate to be in this || orientation. And vice versa. Any two dominoes that aren’t snug like || or = won’t move; any domino that isn’t snug with anybody can’t move.

But eventually, they can all move. So eventually, this is a “picture” of every possible arrangement of dominoes in this region.

A quick overview

What happens when this starts to run is, roughly:

  1. A set of cells is constructed. For reasons I spelled out yesterday, I decided that I wouldn’t be storing the cells (or even the lattice) in an array. Instead, each cell is represented as a vector of index coordinates, with [0 0] representing the cell in the upper left corner because of Quil’s (and Processing’s) drawing conventions, and larger index numbers down and to the right.
  2. A lattice is constructed from the cells. Again, because of yesterday’s hypergraph sketching, I decided to represent the lattice as a hypergraph: that is, each “adjacency relation” is a subset of cells, and because this is a Von Neumann neighborhood (four neighbors) in this lattice, there are few shy of 800 “neighbor” subsets in the lattice structure.

    In Clojure terms, a cell at index position [1 2] is represented just like that: as a vector [1 2]. An edge connecting [1 2] to one of its neighboring cells is represented as a set. So in the square lattice here, the four edges in which [1 2] plays a role would be the four sets #{[1 2] [1 3]}, #{[1 2] [1 1]}, #{[1 2] [2 2]}, and #{[1 2] [0 2]}. The entire lattice is a set of those sets, like #{ #{[1 2] [1 3]} #{[1 2] [1 1]} ...} and so on.

  3. A tile is also a set of cells (the ones it occupies), plus a color so it can be drawn consistently when it moves.
  4. I can draw a cell just by simple addition and arithmetic. They’re squares, and we have an origin.
  5. I can draw a domino (but probably won’t be able to draw a more complicated tile) by knowing the indices of the cells where it’s sitting, and doing a little simple math. At one point, I had rounded the rectangles so they were easier to parse visually; to be able to generalize (in a forthcoming thing) I made them rectangular again.
  6. To determine the cells that are “neighbors” of a tile, we need to do a few set-theoretic steps. First there’s a function to return the cells that are neighbors of any given cell, using the lattice. Then, we can determine the cells that are neighbors of a given tile by taking the union of the neighbors of its cells, removing the cells in the tile itself. And then it’s “easy” to determine the tiles that are neighbors of a given tile: Find the cells that are its neighbors, and then filter the set of tiles to find those that occupy those cells.
  7. The “moves” represented here are (according to the Stack Exchange cites) sufficient to produce any and every valid domino tiling of this region. What we’re doing is this: I pick a random tile; I find all its neighbors; I find the subset of those tiles that are “snug” (form a square with the first tile we picked); we rotate the pair of tiles so that if the square they formed had a “horizontal seam”, it is now vertical, and vice versa.

    As I understand it, this results in an ergodic process that will eventually (for a very big “eventually”) visit every possibly valid tiling of the region. At least as long as it’s rectangular, or maybe convex. I’ll have to look into that in a little while….

  8. This goes on forever

Now this is, basically, a sketch. I spent the day mainly trying to recall my poor idiomatic Clojure, and refresh my out-of-date ClojureScript setup. So the code (as you’ll see below) is very ad hoc, and should be taken as exploratory.

But it does, in several senses, give me a good deal of hope. For example, it was remarkably painless for me to work out the process for identifying “snug neighbor” pairs of dominoes to rotate. I can imagine—maybe with a slight shudder, but tomorrow is another day—doing the analogous thing for I-trominoes, if I wanted to. I would need to find out what the correct set of moves might be (they could be analogous rotations), and I’d need to work out a slightly more convoluted set-theoretic approach to “being in a good neighborhood”. But that seems feasible.

More, I don’t think there’s anything except the drawing that would make arbitrary polyomino tiles very complicated.

What it doesn’t do

These dominoes aren’t colored. Well, OK, they have colors, but those are just for the observer (me) to see that diffusion actually happens under this set of moves. In the problems I’ve been talking about in the last few days, I’ve said part was orange and part was blue. Now that seems like it’d be a relatively simple difference, but there would also be the matter of orientation to somehow capture. That might be interesting.

I haven’t yet tested this on stranger regions, or with non-domino tiles. I know some of the functions I’ve written today depend on the tiles being dominoes. It’ll be interesting and probably challenging to generalize, even if I move one step at a time.

For more general tilings, I suspect I’ll need to take an assembly approach rather than this diffusion-based one. For weird little polyominoes, which might get hooked together and “lock” or “block” one another quite a bit, I think these set-based representations have a lot of potential.

And of course I haven’t paid a lick of attention to computational complexity. I’m trying to think, not to produce e-commerce domino-tiling infrastructure, kids. If you wanna optimize, we’ll optimize later.

Oh, and there’s no interactivity. If nothing else, I’d like to remind myself how to build a “stop/go” button. And there are certainly possibilities for interactivity, like “zapping” individual polyominoes and seeing how things rebuild.

Tomorrow’s another day.

The code, such as it is today

(ns domino-tilings.core
  (:require [quil.core :as q :include-macros true]
            [quil.middleware :as m]
            [clojure.math.combinatorics :as combo]
            [clojure.set :as set]

(def config
  "global stuff for setting up"
   {:cell-size 20
    :lattice-side 20}

(defn rectangular-region-of-cells
  "returns a Clojure set containing 2-d position index vectors; yes, this is weird"
  [width height]
  (into #{}
    (for [i (range width)
          j (range height)]
      [i j]))

(defn adjacent-cells?
  "given two cells (2d index vectors), returns `true` if they are Von Neumann neighbors of one another"
  [cell1 cell2]
  (let [[i1 j1] cell1
        [i2 j2] cell2]
      (and (= i1 i2) (= 1 (Math/abs (- j1 j2))))
      (and (= j1 j2) (= 1 (Math/abs (- i1 i2))))

(defn neighboring-cells
  "given a cell and a set of cells, returns all neighbors of the former"
  [cell set-of-cells]
  (filter #(adjacent-cells? cell set-of-cells)))

(defn all-neighbors
  "produces a set of all pairs of Von Neumann neighbors (as sets) from a given set of cells"
  (set (map
      #(apply adjacent-cells? %)
      (combo/combinations set-of-cells 2)

(defn draw-cell
  "draw a square, with a 1-pixel border on the right and bottom"
  [cell size hue saturation brightness]
  (q/fill hue saturation brightness)
  (q/rect (* size (first cell)) (* size (second cell)) (dec size) (dec size))

(defrecord Domino [cells color])

(defn initial-rectangle-dominoes
  "given a rectangular region/collection of cells, construct nonoverlapping dominoes covering the region, in vertical alignment; assign them various colors as well, just to be a bit fancy"
  [width height]
  (let [scale (:lattice-side config)
        delta-h (/ 256 scale)]
    (for [i (range width)
          j (range 0 height 2)]
        #{[i j] [i (inc j)]}
        {:hue (mod (+ (* delta-h i) (* delta-h j)) 256)
         :saturation (+ (* delta-h i) j 150)
         :brightness (+ (* delta-h j) i 100)}

(defn draw-domino
  "given a domino, place it on the canvas in the appropriate position, size and color"
  ([domino size hue saturation brightness]
    (let [columns (map first (:cells domino))
          rows    (map second (:cells domino))
          left    (apply min columns)
          right   (apply max columns)
          top     (apply min rows)
          bottom  (apply max rows)
          width   (- right left)
          height  (- bottom top)]
      (q/fill hue saturation brightness)
      (q/rect (* size left)
              (* size top)
              (dec (* (inc width) size))
              (dec (* (inc height) size))
    ([domino size]
      (let [color (:color domino)
            h (:hue color)
            s (:saturation color)
            b (:brightness color)]
        (draw-domino domino size h s b))))

(defn highlight-domino
  "draw a highlighted border around a given domino"
  [domino size]
  (let [color (:color domino)
        h (:hue color)
        s (:saturation color)
        b (:brightness color)]
    (q/stroke h (+ s 50) (+ b 50) 125)
    (q/stroke-weight 10)
    (draw-domino domino size h s b)

(defn neighboring-cells-of-cell
  "given a cell, return a set of all the other cells that are its neighbors, accoring to the neighborhood lattice provided"
  [cell neighbor-lattice]
  (apply set/union (filter #(contains? % cell) neighbor-lattice)))

(defn neighboring-cells-of-tile
  "given a tile, return a set of all cells that are neighbors of any of the tile's cells (and not part of the tile)"
  [tile neighbor-lattice]
  (let [insides (:cells tile)]
        (map #(neighboring-cells-of-cell % neighbor-lattice) insides))

(defn tile-on-cell
  "return the tile that occupies a given cell"
  [cell tiles]
  (first (filter #(contains? (:cells %) cell) tiles)))

(defn set-overlap?
  "return `true` if the intersection of two sets is nonempty"
  [set1 set2]
  (not (empty? (set/intersection set1 set2))))

(defn neighboring-tiles-of-tile
  "given a tile, return all other tiles that contain cells adjacent to that tile's cells"
  [tile tiles neighbor-lattice]
  (let [surroundings (neighboring-cells-of-tile tile neighbor-lattice)]
    (into #{} (map #(tile-on-cell % tiles) surroundings))

(defn snug-neighbors-of-tile
  "given a tile, return all neighboring tiles where _every cell_ of the tile is a neighbor of the given tile; these are the 'snug' neighbors, at least for dominoes"
  [tile tiles neighbor-lattice]
  (let [surroundings (neighboring-cells-of-tile tile neighbor-lattice)]
      #(set/subset? (:cells %) surroundings)
      (neighboring-tiles-of-tile tile tiles neighbor-lattice))

(defn highlight-cell
  "draw a black dot on a cell"
  [cell size]
  (let [half-square (/ size 2)]
    (q/translate half-square half-square)
    (q/fill 10 10 10)
      (* size (first cell))
      (* size (second cell))
    (q/translate (- half-square) (- half-square))

(defn rotated-domino-pair
  "given two snug dominoes, return the pair of rotated dominoes, with equal probability of clockwise or counterclockwise rotation"
  [domino1 domino2]
  (let [c1 (sort (:cells domino1))
        c2 (sort (:cells domino2))]
    (if (< (rand) 0.5)
        (assoc domino1 :cells #{(first c1) (first c2)})
        (assoc domino2 :cells #{(second c1) (second c2)}))
        (assoc domino1 :cells #{(second c1) (second c2)})
        (assoc domino2 :cells #{(first c1) (first c2)}))

(defn setup []
  "build the Quil state"
  (let [s              (:lattice-side config)
        all-positions  (rectangular-region-of-cells s s)
        cell-neighbors (all-neighbors all-positions)
        initial-tiles  (initial-rectangle-dominoes s s)]
  (q/frame-rate 60)
  (q/color-mode :hsb)
  {:cells         all-positions
   :lattice       cell-neighbors
   :tiles         initial-tiles
   :changed-tiles []}

(defn swap-in-pair
  "replace a pair of 'old' tiles with a pair of 'new' ones (probably because you rotated a snug pair)"
  [old1 old2 new1 new2 tiles]
    (into (set (remove #{old1 old2} tiles)) #{new1 new2})

(defn update-state [state]
  "pick a random tile, and see if it has any snug neighbors; if it does, rotate it with one of the snug neighbors picked at random; if it doesn't, return it; make a note of the dominoes that want to be highlighted"
  (let [cells       (:cells state)
        tiles       (:tiles state)
        lattice     (:lattice state)
        focus-tile  (rand-nth (into [] tiles))
        neighbors   (snug-neighbors-of-tile
                      (:tiles state)
                      (:lattice state))
    (if (empty? neighbors)
      {:cells         cells
       :lattice       lattice
       :tiles         tiles
       :changed-tiles [focus-tile]}
      (let [old1 focus-tile
            old2 (rand-nth neighbors)
            [new1 new2] (rotated-domino-pair old1 old2)]
        {:cells         cells
         :lattice       lattice
         :tiles         (swap-in-pair old1 old2 new1 new2 tiles)
         :changed-tiles [new1 new2]}

(defn draw-state [state]
  "clear the background, draw all the cells and domino tiles, and highlight any that want highlighting"
  (let [s (:cell-size config)]
    (q/background 240)
    (doall (map #(draw-cell % s 0 0 200) (:cells state)))
    (doall (map #(draw-domino % s) (:tiles state)))
    (doall (map #(highlight-domino % s) (:changed-tiles state)))

(q/defsketch domino-tilings
  :host "domino-tilings"
  :size [400 400]
  :setup setup
  :update update-state
  :draw draw-state
  :middleware [m/fun-mode])