Skip to content

Instantly share code, notes, and snippets.

@piotr-yuxuan
Created January 16, 2016 16:10
Show Gist options
  • Star 14 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save piotr-yuxuan/54347c4bf9b6f85227b7 to your computer and use it in GitHub Desktop.
Save piotr-yuxuan/54347c4bf9b6f85227b7 to your computer and use it in GitHub Desktop.
Learning try-and-diy: how can I simplify this example?
(ns firstshot.chessknightmove
(:refer-clojure :exclude [== >= <= > < =])
(:use clojure.core.logic
clojure.core.logic.arithmetic))
(defn knight-moves
"Returns the available moves for a knight (on a 8x8 grid) given its current position."
[x y]
(let [xmax 8 ymax 8]
(run* [q]
(fresh [a b]
(conde
[(< (+ x 1) xmax) (< (+ y 2) ymax) (== a (+ x 1)) (== b (+ y 2))]
[(< (+ x 2) xmax) (< (+ y 1) ymax) (== a (+ x 2)) (== b (+ y 1))]
[(< (+ x 2) xmax) (>= (- y 1) 0) (== a (+ x 2)) (== b (- y 1))]
[(< (+ x 1) xmax) (>= (- y 2) 0) (== a (+ x 1)) (== b (- y 2))]
[(>= (- x 1) 0) (>= (- y 2) 0) (== a (- x 1)) (== b (- y 2))]
[(>= (- x 2) 0) (>= (- y 1) 0) (== a (- x 2)) (== b (- y 1))]
[(>= (- x 2) 0) (< (+ y 1) ymax) (== a (- x 2)) (== b (+ y 1))]
[(>= (- x 1) 0) (< (+ y 2) ymax) (== a (- x 1)) (== b (+ y 2))])
(== q [a b])))))
;; This instruction
(knight-moves 4 4)
;; will give the following result
([5 6] [6 5] [6 3] [5 2] [3 2] [2 3] [2 5] [3 6])
;; Now let's try to go beyond that verbose way.
;; First, let's define an helper function
(defn distance
[a b]
"Returns the distance between two numbers"
(let [diff (- a b)]
(max diff (- diff))))
(defn knight-moves-smaller
"Returns the available moves for a knight and aims at cleaning the code."
[x y]
(let [xmax 8 ymax 8]
(run* [q]
(fresh [a b]
(== 3 (+ (distance a x) (distance b y)))
(>= a 0) (< a xmax)
(>= b 0) (< b ymax)
(== q [a b])))))
;; But we've got a problem with the arithmetic part then this doesn't work:
(knight-moves-smaller 4 4)
;; => Unhandled java.lang.ClassCastException, clojure.core.logic.LVar cannot be cast to java.lang.Number
;; I'm new to core.logic (and Clojure in general) so I'll like to understand how we can do to factorise the previous into something similar to the latter.
@piotr-yuxuan
Copy link
Author

Ok so basically I found a way to get the expected result but methinks it's "fake" logic programming and much more like a disguised "traditionnal" way:

(defn gen-positions
  ""
  [x-start x-end y-start y-end]
  (reduce (fn [v r]
            (into v
                  (map
                   #(vector % r)
                   (range x-start
                          (inc x-end)))))
          '()
          (range y-start
                 (inc y-end))))

(defn fake-available-positions
  [all-positions not-available-positions]
  (seq (clojure.set/difference (set all-positions)
                               (set not-available-positions))))

(defn chess-lambda
  [board-constraint]
  (fn [type colour x y]
    (run* [q]
      (fresh [a b]
        (board-constraint a b)
        (type x y a b colour)

        (membero [a b]
                 (fake-available-positions
                  (run* [q]
                    (fresh [x y]
                      (board-constraint x y)
                      (== q [x y])))
                  (pieces-by-colour colour)))
        (== q [a b])))))

@michaelballantyne
Copy link

GitHub doesn't seem to ping me when you include my username - I just happened to check back on this and see it. If you'd like to get in touch again, drop me a line at michael.ballantyne@gmail.com.

I'll start from the code in your first candidate solution; you are correct that the second isn't quite logic programming anymore (and will fall apart if you want to make, say, the current positions of pieces a logic variable).

The problem you're running into is that your definition of negation-as-failure doens't work as expected when combined with the finite domain constraints. The different possibilities for the value of b (5 and 6) are contained within a single substitution as an interval, and conda is treating that as a single answer. I'm not aware of a negation-as-failure implementation for core.logic that works with the finite domain constraints in this situation properly (I tried the built-in nafc without success).

Instead, you can describe the property positively with a relation describing what it means for a point to not be in the list.

(defn not-memberfo [f!= el l]
  (conde
    [(fresh (head tail)
       (== (lcons head tail) l)
       (f!= el head)
       (not-memberfo f!= el tail))]
    [(== '() l)]))

The trick is what operator to use for the f!= comparator. I'm not entirely sure whether core.logic's != CLP(TREE) operator interacts correctly with the CLP(FD) values. It seems to in this test case, but it may not always. To be safe, we can define our own inequality between points using only the CLP(FD) fd/!=:

(defn pair-not-equalo [p1 p2]
  (fresh (x1 y1 x2 y2)
    (== [x1 y1] p1)
    (== [x2 y2] p2)
    ; must enumerate ways of being disequal here to ensure non-overlapping.
    (conde
      [(fd/!= x1 x2)
       (fd/!= y1 y2)]
      [(fd/!= x1 x2)
       (fd/== y1 y2)]
      [(fd/== x1 x2)
       (fd/!= y1 y2)])))

Finally, the line that was previously (¬ (membero q (pieces-by-colour colour))) becomes (not-memberfo pair-not-equalo q (pieces-by-colour colour)).

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment