Rules engine. ThoughtWorks Clojure DOJO

gistfile1.clj

(ns twrule.core)

;; A is the B
;; fact: '(father a  b )
(def facts  #{'(father andrew bob) '(father bob charlie)})

;; Grandfather rule: if A is the father of B, and B is the father of C then A is the Grandfather C
(def rules [{:patterns ['(father ?a ?b) '(father ?b ?C)]
            :assertions ['(grandfather ?a ?C)]}])

(defn is-variable? [x]
  (= \? (first (str x))))


(defn match [p f b]
  (when (= (count p) (count f))
    (loop [pairs (map vector p f), b b]
      (if (empty? pairs)
        b
        (let [[phead fhead] (first pairs)]
          ;(println phead fhead b)
          (cond
           (and (is-variable? phead) (contains? b phead))
             (if (= fhead (get b phead))
               (recur (rest pairs) b)
               nil)
           (is-variable? phead) (recur (rest pairs) (assoc b phead fhead))
           :else (if (= phead fhead)
                   (recur (rest pairs) b)
                   nil)))))))


(defn var-bindings [r facts]
  (defn solve [ps b]
    (if (empty? ps)
      (list b)
      (let [p (first ps)
            bs (keep #(match p % b) facts)]
       (mapcat #(solve (rest ps) %) bs))))
  (solve (:patterns r) {}))


(defn eval-pattern [p b]
  (for [s p]
    (if (is-variable? s)
      (get b s)
      s)))

(defn eval-assertions [r b]
  (apply hash-set (map #(eval-pattern % b) (:assertions r))))

(defn instantiations [r facts]
  (let [bs (var-bindings r facts)]
    (map #(eval-assertions r %) bs)))


(defn algo [f rules]
   (defn step [facts]
     (let [is (mapcat #(instantiations % facts) rules)]
       (if-let [i (first is)]
         (clojure.set/union i facts)
         facts)))
  (let [states (iterate step (apply hash-set f))]
    (last (take 10 states))))

(def bi {'?a 'andrew '?b 'bob '?c 'charlie})

; (eval-pattern '(grandfather ?a ?c) bi)
;(eval-assertions (first rules) bi)
;(instantiations nil facts)

 ;(var-bindings (first rules) facts)

(algo facts rules )

;(match '(father ?a ?b) '(father andrew bob) {'?c 7})

;  [{'?a andrew '?b bob 'c charlie}]
;(algo facts rules)