Simple inference engine

simple_infer.clj

;simple inference engine, using bruteforce propagation of modus ponens

;if the fact matches given clause (using supplied map of bindings),
;returns a map of established bindings, else returns false
(defn match
  ([clause fact] (match clause fact {}))
  ([clause fact bnds]
    (let [[cls & clsR] clause, [fct & fctR] fact]
      (cond (contains? #{:not=} cls) {:__special__ clause}
            (= clause fact) bnds
            (and (keyword? cls)
                 (= \? (first (name cls)))) (if (contains? bnds cls)
                                              (match (replace bnds clause) fact bnds)
                                              (let [bnds (conj bnds [cls fct])]
                                                (match (replace bnds clause) fact bnds)))
            (= cls fct) (match clsR fctR bnds)))))

;returns vector of [fact bindings] for all facts in fact-db that match the clause.
(defn matches [fact-db clause]
  (remove #(nil? (second %)) (map #(vector % (match clause %)) fact-db)))

;returns sequence of merged bindings or nil if some of the bindings conflict
;and also applies special clauses to bindings and tests them
(defn merged [bindings]
  (let [merged (apply merge-with #(if (= % %2) % nil) bindings)]
    (when-not (some nil? (vals merged))
      (if (contains? merged :__special__)
        (let [[fst & rst] (apply list (replace merged (:__special__ merged)))]
          (when (eval (cons (symbol (name fst)) rst)) merged))
        merged))))

;returns all possible combinations of seqs 
(defn combinate [seqs]
  (if (empty? seqs) [nil]
    (for [fst (first seqs) rst (combinate (rest seqs))] (cons fst rst))))

;returns the database of facts after adding new facts inferred by applying the rule actions to the facts
;that match the rule clauses. A rule is a vector of form: [[vector of clauses]   [vector of actions]]
;e.g.: [[[descendant ?X ?Y] [descendant ?Y ?Z]]   [[descendant ?X ?Z]]])
(defn apply-rule [fact-db [clauses actions]]
    (let [possible (keep merged
                         (combinate (map (comp (partial map second) (partial matches fact-db))
                                         clauses)))
          inferred (for [action actions] (map #(replace % action) possible))]
      (reduce into fact-db inferred)))

;returns new database of facts, augmented with new facts, inferred by applying supplied rules
(defn infer [fact-db rules]
  (loop [facts fact-db]
    (let [new-facts (reduce apply-rule facts rules)]
      (if (> (count new-facts) (count facts)) (recur new-facts) new-facts))))

;returns all possible answers to specified query, searching in db of facts inferring new ones using rules
(defn query [facts rules q] (map first (matches (infer facts rules) q)))

;example of use:

;we define relation 'greater than' as:
(let [facts #{[:> 9 8]
              [:> 8 7]
              [:> 7 6]
              [:> 6 5]
              [:> 5 4]
              [:> 4 3]
              [:> 3 2]
              [:> 2 1]
              [:> 1 0]}
      
      ;we define rules according to which new facts will be inferred:

      ;           clause1 && clause2      =>  action1
      rules [[[[:> :?X :?Y] [:> :?Y :?Z]],  [[:> :?X :?Z]]]       ;transitivity of 'greater than'
      ;           clause                  =>  action2
            [[[:> :?X :?Y]],                [[:< :?Y :?X]]]] ]    ;relation 'lower than' by inversion

      ;and we query the engine to find all numbers lower than 5:
      (print (query facts rules [:< :?X 5])))

;result will be:
;=> ([:< 4 5] [:< 3 5] [:< 2 5] [:< 1 5] [:< 0 5])