35 lines
1.0 KiB
Janet
35 lines
1.0 KiB
Janet
(use unify)
|
|
|
|
(defn rand-nth [e]
|
|
(get e (math/floor (* (math/random) (length e)))))
|
|
|
|
(defn unifications [clause facts context]
|
|
(if (> (length clause) 0)
|
|
(let [bindings (keep |(unify (first clause) $ context) facts)]
|
|
(mapcat |(unifications (slice clause 1) facts $) bindings))
|
|
[context]))
|
|
|
|
(defn union [a b]
|
|
(reduce |(if (find (fn [x] (deep= x $1)) $0) $0 (array/push $0 $1)) a b))
|
|
|
|
(defn select-rule [selection-strategy rules facts]
|
|
(let [possibilities
|
|
(map |(let [bindings (unifications ($ :antecedent) facts {})]
|
|
[$ (apply merge bindings)])
|
|
rules)]
|
|
(selection-strategy possibilities)))
|
|
|
|
(defn apply-rule [rule facts context]
|
|
(let [new-facts (map |(apply-subst context $) (rule :consequent))]
|
|
(union new-facts facts)))
|
|
|
|
(defn step [rules facts]
|
|
(when-let [[rule binds] (select-rule rand-nth rules facts)]
|
|
(apply-rule rule facts binds)))
|
|
|
|
(defn cycle [pred rules facts]
|
|
(var res @[(step rules facts)])
|
|
(while (pred res)
|
|
(set res (array/push res (step rules facts))))
|
|
res)
|