N Queens with core.logic, take 2

This post is a follow-up to my previous post on N Queens and core.logic, in which I tried to find solutions using “pure” logic (without arithmetic goals) and basic miniKanren/Reasoned Schemer building blocks.

After excellent feedback and hints from David Nolen (big thanks), I present a greatly simplified (and faster) way of using core.logic to find all solutions. Credit also goes to good old Bratko.

First, let’s fix the safeo function (and def-subo macro). In miniKanren, you can use arithmetic goals given two prerequisites: the fresh variable must be bound to a finite (number) space, and we must use project to bind the values. This means we can get rid of subo altogether.

Project is mentioned in passing in the Reasoned Schemer book. It says “project is syntactically like fresh, but it binds different values to the lexical variables. project binds walk*ed values, whereas fresh binds variables using var”. What that means in this case is that we can perform arithmetic operations on the projected variables. Here’s our new safeo:

(defn safeo [[x1 y1] [x2 y2]]
  (all
   (!= x1 x2)
   (!= y1 y2)
   (project [x1 x2 y1 y2]
            (!= (- x2 x1) (- y2 y1))
            (!= (- x1 y2) (- x2 y1)))))

This works if the x’s as bound to number range with membero (remember that the y’s are never fresh), this is done in a updated queens-run macro;

(defmacro queens-run
  "Search for all N queens solutions"
  [n]
  (let [xnames (->> (range n) (map (fn [_] (gensym "x"))) (into []))
        gen-safeos (fn []
                     (->> (range (dec n))
                          (map (fn [x] [x (range (inc x) n)]))
                          (map (fn [[s ts]]
                                 (map (fn [t] `(safeo [~(nth xnames s) ~s]
                                                      [~(nth xnames t) ~t])) ts)))
                          (apply concat)))
          ]
    `(run* [r#]
           (fresh [~@(map #(nth xnames %) (range n))]
                  ~@(map (fn [x] (list 'membero (xnames x) (into [] (range n)))) (range n))
                  ~@(gen-safeos)
                  (== r# [~@(map (fn [x] [(nth xnames x) x])
                                 (range n))])))))

As you can see, we got rid of subo (and all it’s associations). That improves performance on a 6-queens run with ~5x

Next, we want to get rid of the big macro above and replace it with some readable looping constructs. To replicate the block of safeos generated by this macro (the gen-safeos fn), we are going to need 2 loops, one outer loop that goes over all N queens q, and one inner loop that for every q checks that it’s safe against all other queens. Its time for some core.logic pattern matching magic!

Let’s change safeo again. Instead of checking if 2 queens are not attacking each other, it checks if a given queen is not attacking any other queen in a given list (this is our inner loop);

(defne safeo
  "Is the queen q safe from all queens in list others"
  [q others]
  ([_ ()])                    ;; others empty, s#
  ([[x1 y1] [[x2 y2] . t]]    ;; destruct q and head.tail of others
     (!= x1 x2)
     (!= y1 y2)
     (project [x1 x2 y1 y2]
       (!= (- x2 x1) (- y2 y1))
       (!= (- x1 y2) (- x2 y1)))
     (safeo [x1 y1] t)))

There’s a couple of things going on here. defne is a convenience macro to build conde functions (which you end up doing all the time), secondly there are some clever destructing / pattern matching going on to pick the head / tail of a list and recur.

Now for the outer loop, let’s introduce another recursive “conde function” called nqueenso, this function should loop over all queens in a list, check that they are all safe against each other (using safeo). It also needs to bind the x variables to a finite number space using membero;

(defne nqueenso [l n]
  ([() _])                    ;; queen list empty, s#
  ([[[x y] . t] _]            ;; match/destruct head.tail, ignore n
     (nqueenso t n)
     (membero x (range n))
     (safeo [x y] t)))

We’re almost done now, we just to need rewrite the (run* …) form. We can actually do without the (fresh …) expression by creating core.logic logical variables (lvar) directly, this also eliminates the need for a macro to generate n symbols. Here’s the whole thing;

(ns nqueens-cl
  (:refer-clojure :exclude [==])
  (:use [clojure.core.logic]))

(defne safeo [q others]
  ([_ ()])
  ([[x1 y1] [[x2 y2] . t]]
     (!= x1 x2)
     (!= y1 y2)
     (project [x1 x2 y1 y2]
       (!= (- x2 x1) (- y2 y1))
       (!= (- x1 y2) (- x2 y1)))
     (safeo [x1 y1] t)))

(defne nqueenso [l n]
  ([() _])
  ([[[x y] . t] _]
     (nqueenso t n)
     (membero x (range n))
     (safeo [x y] t)))

(defn solve-nqueens [n]
  (run* [q]
    (== q (map vector (repeatedly lvar) (range n)))
    (nqueenso q n)))

As you can see, with looping we are generating drastically less associations for core.logic to consider, that’s good for performance.

Now it’s approximately 70 times faster than the original solution in the previous post. For an 8-queens run, this is about 50 times slower than the hand-rolled functional backtracking solution in the very first posting. That’s still pretty good for a generic Prolog machinery with all the extra expressive power that it provides.

The next part in this series will use cKanren functionality that is being worked on at the moment in core.logic. That might be even faster!