The Castle of Glyphs

Well, in English they're not called castles, but rooks. Surprisingly, the castling move is called enroque in Spanish, which is cognate to rook. Suppose you want to find non-self-intersecting closed rook's tours on a m-by-n chessboard. How would you go about it? But first, why would you want to do that?

I've found they make pretty linear patterns, somewhat reminiscent of arabesques and square Kufic script. For instance, the closed tours on a 4-by-4 chessboard are:

and some of the 1072 closed rook tours on a 6-by-6 chessboard are:

It is convenient to think of the board as a collection of cells accessible according to the rules governing the movement of a given piece. In this way, a piece's movements and a given board size give rise to a leap graph, viewed as a collection of vertices connected one another through edges:

type vertex = {
          cell : int * int;
  mutable next : vertex list;
  mutable deg  : int;
  mutable free : bool;

The cell are its coordinates in the board, the next list links together the vertex neighbors; deg is that list length (for faster computation), and free is a mark that will be used in traversing the graph. Given a definition of how a piece moves and a board size, I build the leap graph:

let board moves m n =

First, I preallocate an array of unconnected vertices:

  let size = m * n in
  let gg = Array.init size (fun j ->
    { cell = (j / n, j mod n); next = []; deg = 0; free = true; })
  in

Then, I thread the cells into a graph. For that, from each cell's (r, c) coordinate I find the neighboring cells reachable by applying the corresponding move, represented as a (dr, dc) shift, taking care of not falling outside the board:

  Array.iter (fun v ->
    let r, c = v.cell in
    List.iter (fun (dr, dc) ->
      let r', c' = r + dr, c + dc in
      if 0 <= r' && r' < m && 0 <= c' && c' < n then begin
        v.deg  <- v.deg + 1;
        v.next <- gg.(n * r' + c') :: v.next
      end) moves;
    ) gg;
  Array.to_list gg

There's always the tension between the convenience of naming each member of a datum and the implicit pattern matching afforded by function. In any case, having the vertices already created makes representing the edges as shared references to neighbors easy. The end result is that the board is represented as the list of linked cells.

In the full program I output the solutions graphically to a PostScript file. In order to not get mired into details, I'll abstract the output procedure and write the tour-finding as a higher order function, in the style of an iterator:

let tour out board =

A visited cell gets marked, and its out-degree decremented to record the fact that we entered it:

  let visit v =
    v.free <- false;
    v.deg  <- v.deg - 1

Backtracking must restore the cell's previous state by undoing the visit:

  and unvisit v =
    v.deg  <- v.deg + 1;
    v.free <- true
  in

A tour must begin somewhere, and the first cell in the vertex list is as good candidate as any other. Also, as the code finds valid tours it will keep track of the generated solutions:

  let first = List.hd board
  and sols = ref 0 in

Now, the generation proceeds cell by cell, by trying appending to the current tour a cell reachable from v. The easiest way to know when a tour is complete is to count the number of remaining cells to visit, that's rem:

  let rec advance tour rem v =

The next cell in the tour is, precisely and as a precondition, v:

    let tour = v.cell :: tour
    and rem  = pred rem in

A tour is, by definition, a sequence of cells visited one by one according to the rules for moving the piece, without repetition, which visits the entire board and returns to the starting place. If one is found, it is recorded and output:

    if rem == 0 && List.memq first v.next then begin
      incr sols;
      out tour

Otherwise, I mark the current cell as visited and try to extend the tour:

    end else begin
      visit v;

As a simple heuristic to prune the search space, I try first forced cells, that is, unvisited neighboring cells with only one way to go through them:

      begin try
        let force = List.find (fun w -> w.free && w.deg == 1) v.next in
        advance tour rem force

If no such forced cell is found, I expand the search tree with all the unvisited neighbors to the current vertex and try each in turn:

      with Not_found ->
        let next = List.filter (fun w -> w.free) v.next in
        List.iter (advance tour rem) next
      end;

Since the search is exhaustive, I have to restore the graph to the state it was upon entering the search, by un-visiting the current cell:

      unvisit v
    end
  in

How does the ball gets started? By the beginning, of course:

  visit first;
  advance [first.cell] (pred (List.length board)) (List.hd first.next);

Then, the graph is restored and the we return the solution count:

  unvisit first;
  !sols

A rook can move any number of cells vertically or horizontally; however, for doing so it must visit every intervening cell. Hence, it's best to make it move just one cell in each orthogonal direction: what we have is not a rook but the Wazir of Fantasy Chess:

let rook   = [  1,  0;  0,  1;  0, -1; -1,  0; ]

And now we that have all the pieces together, we could ask how many tours there are an a 4-by-6 chessboard:

# tour (fun _ -> ()) (board rook 4 6) ;;
- : int = 37

Which is odd, because some symmetries are taken into account. Can you tell which? Here's a hint:

They do look like letters in a strange script…