Joy of Clojure, updated core.logic examples

joc-logic.clj

(ns logic.core
  (:require [clojure.core.logic.pldb :as pldb]    ;; facts are now stored in a logic database which requires the pldb ns
            [clojure.core.logic.fd :as fd]        ;; for constraint programming, no need to include include in project.clj 
            [clojure.core.logic :refer :all :exclude [record?]]))    ;; I left out ":as :logic"  for aesthetics

(run* [answer]
      (== answer 5))

(run* [val1 val2]
      (== {:a val1, :b 2}
          {:a 1, :b val2}))

(run* [x y]
      (== x y))

(run* [q]
      (== q 1)
      (== q 1))

(run* [george]
      (conde
       [(== george :born)]
       [(== george :unborn)]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; this is replacing the old "defrel" declarations
(pldb/db-rel orbits orbital body)
(pldb/db-rel stars star)

;; facts are now stored for later query, using the pldb namespace. It is much cleaner to group them this way.
(def facts
  (pldb/db
   [orbits :mercury :sun]
   [orbits :venus :sun]
   [orbits :earth :sun]
   [orbits :mars :sun]
   [orbits :jupiter :sun]
   [orbits :saturn :sun]
   [orbits :uranus :sun]
   [orbits :neptune :sun]
   [orbits :moon :earth]
   [orbits :Bb :alpha-centauri]
   [orbits :phobos :mars]
   [orbits :deimos :mars]
   [orbits :io :jupiter]
   [orbits :europa :jupiter]
   [orbits :ganymede :jupiter]
   [orbits :callisto :jupiter]

   [stars :sun]
   [stars :alpha-centauri]))


;; you have to use with-db name-of-fact-db to run queries, now
(pldb/with-db facts
  (run* [q]
        (fresh [x y]
               (orbits x y)
               (== q x))))

;; the "o" suffix is conventional for funtions that packaged relation queries
(defn planeto [body]
  (fresh [star]
         (stars star)
         (orbits body star)))


(pldb/with-db facts
  (run* [q]
        (planeto :earth)))

(pldb/with-db facts
  (run* [q]
        (planeto :earth)
        (== q true)))

(pldb/with-db facts
  (run* [q]
        (planeto :sun)
        (== q true)))

(pldb/with-db facts
  (run* [q]
        (fresh [orbital]
               (planeto orbital)
               (== q orbital))))

(pldb/with-db facts
  (run* [q]
        (planeto :Bb)))

(defn satelliteo [body]
  (fresh [p]
         (orbits body p)
         (planeto p)))

(pldb/with-db facts
  (run* [q]
        (satelliteo :sun)))

(pldb/with-db facts
  (run* [q]
        (satelliteo :earth)))

(pldb/with-db facts
  (run* [q]
        (satelliteo :moon)))

(pldb/with-db facts
  (run* [q]
        (satelliteo :io)))

(pldb/with-db facts
  (run* [q]
        (orbits :leda :jupiter)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(run* [q]
      (fresh [x y]
             (== q [x y])))

(run* [q]
      (fresh [x y]
             (== [:pizza "Java"] [x y])
             (== q [x y])))

(run* [q]
      (fresh [x y]
             (== q [x y])
             (!= y "Java")))

(run* [q]
      (fresh [x y]
             (== [:pizza "Java"] [x y])
             (== q [x y])
             (!= y "Java")))

(run* [q]
      (fresh [x y]
             (== [:pizza "Scala"] [x y])
             (== q [x y])
             (!= y "Java")))

(run* [q]
      (fresh [n]
             (== q n)))

(run* [q]
      (fresh [n]
             (!= 0 n)
             (== q n)))


;; beginning constraint programming and the use of the fd namespace

;; CAUTION: RUN THIS AT YOUR OWN RISK
;; (run* [q]
;;       (fresh [n]
;;             (fd/in n (fd/interval 1 Integer/MAX_VALUE))
;;             (== q n)))
;;
;;=> (1 2 3 ... many more numbers follow)

(run* [q]
      (fresh [n]
             (fd/in n (fd/domain 0 1))
             (== q n)))

(run* [q]
      (let [coin (fd/domain 0 1)]         ;; bind a local to a constraining interval
        (fresh [heads tails]              ;; declare the variables to be matched
               (fd/in heads 0 coin)       ;; heads is constrained to being 0 within the domain of coin
               (fd/in tails 1 coin)       ;; tails is constrained to being 1 within the domain of coin
               (== q [heads tails]))))   ;; return all head/tail combinations that satisfy the query for unification