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.
@michaelballantyne
Copy link

Using the normal clojure arithmetic operators like +, -, etc. won't work now that you've rephrased the problem in a way such that core.logic needs to solve for a and b. Previously you functionally calculated values for a and b and assigned to the logic variables with ==; that code could have been written in pure clojure with cond instead of conde if you returned the values instead of unifying with them. Now, however, you call distance with the argument a as a fresh logic variable with unknown value and expect core.logic to solve for a and b satisfying the constraint. But the use of - from clojure.core in distance doesn't know what to do with a logic variable.

Instead, you need to use the finite domain operators from core.logic.fd. You provide the range of values each logic variable can take on and apply a set of arithmetic constraints; then core.logic can actually do the solving for you. Here's how you might write your example:

(ns firstshot.chessknightmove
  (:refer-clojure :exclude [== >= <= > < = + - *])
  (:require [clojure.core.logic :refer :all])
  (:require [clojure.core.logic.fd :as fd]))

(defn distanceo
  [a b out]
  "Returns the distance between two numbers"
  (conde
    [(fd/- a b out)]
    [(fd/- b a out)]))

(defn knight-moveso
  [x y a b]
  (fresh [d1 d2]
    (fd/in d1 d2 (fd/interval 1 2))
    (distanceo a x d1)
    (distanceo b y d2)
    (fd/+ d1 d2 3)))

(defn knight-moves-smaller
  "Returns the available moves for a knight and aims at cleaning the code."
  [x y]
  (run* [q]
    (fresh [a b d1 d2]
      (fd/in a b (fd/interval 0 7))
      (knight-moveso x y a b)
      (== q [a b]))))

(knight-moves-smaller 4 4)

Things to notice:

  • The finite domain operators are three-argument relations, rather than two argument functions. Don't think of them as having a return value. We've written the distance operator similarly. Relations are conventionally named with an o at the end to distinguish from similarly-named functions.
  • Negative finite domain values aren't supported in core.logic, so we changed the way distance works a bit. if a - b would be negative, that branch of the conde fails and our result is instead b - a.

@piotr-yuxuan
Copy link
Author

Hello @michaelballantyne, thanks very much for your detailed answer. It was great help for me and produced the "Ahhh" moment I needed to get it! Actually this chess example was only intended to be a basic getting started project but now I'm trying to go a bit farther before to start the real project I am willing to work on with logic programming.

Would you mind help me a bit further? 😃

First I define some helper functions:

(defn board-constraint
  [boardsize]
  #(fd/in %1 %2 (fd/interval 0 boardsize)))

(defn pieces-by-colour
  "The implementation should return the position of pieces given their colour."
  [kw]
  (case kw
    ;; first: x →, second y ↑
    :white '([0 0] [1 0] [2 0]
             [0 1] [1 1] [2 1]
             [0 2] [1 2] [2 2])
    :black '([6 6] [6 7] [6 8]
             [7 6] [7 7] [7 8]
             [8 6] [8 7] [8 8])))

(defn ¬
  "goal is a goal form to be negated."
  [goal]
  (conda
     [goal fail]
     [succeed]))

and now I use them to find which positions the pawn to move to according to its colour (let's say the white player is at the bottom and the black one is at the top):

(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)
        (== q [a b])
        (¬ (membero q (pieces-by-colour colour)))))))

(def chess-with-positions-and-colours (chess-lambda (board-constraint 8)))

(defn pawn
  ([x y a b colour]
    (fresh [d1]
      (fd/in d1 (fd/interval 1 2))
      (case colour
        :black (fd/- y b d1)
        :white (fd/- b y d1))
      (== x a))))

;; This test fails.
(test/is (chess-with-positions-and-colours pawn :black 7 7)
         '([7 5]))

I believe that trouble comes from that I don't understand properly how the function ¬ is dealt with by core.logic. I want it to express a negation of membero but it seems all possible values of q are invalidated when only one of them matches a value in membero second parameter.

@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