initial
This commit is contained in:
40
kanon.janet
Normal file
40
kanon.janet
Normal file
@@ -0,0 +1,40 @@
|
|||||||
|
(use unify)
|
||||||
|
|
||||||
|
(defn rand-nth [e] (math/floor (* (math/random) (length e))))
|
||||||
|
|
||||||
|
(def rules
|
||||||
|
'[{:antecedent [[?id :emergency/type :emergency.type/fire]]
|
||||||
|
:consequent [[-1000 :response/type :response.type/activate-sprinklers]
|
||||||
|
[-1000 :response/to ?id]]}
|
||||||
|
{:antecedent [[?id :emergency/type :emergency.type/flood]]
|
||||||
|
:consequent [[-1002 :response/type :response.type/kill-electricity]
|
||||||
|
[-1002 :response/to ?id]]}])
|
||||||
|
|
||||||
|
(def all-facts @[[-50 :emergency/type :emergency.type/fire]
|
||||||
|
[-51 :emergency/type :emergency.type/flood]])
|
||||||
|
|
||||||
|
(def KB {:rules rules
|
||||||
|
:facts all-facts})
|
||||||
|
|
||||||
|
(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]))
|
||||||
|
|
||||||
|
# TODO
|
||||||
|
(defn union [a b] a)
|
||||||
|
|
||||||
|
(defn select-rule [selection-strategy rules facts]
|
||||||
|
(let [possibilities
|
||||||
|
(map |(let [bindings (unifications ($ :antecedent) facts {})]
|
||||||
|
[$ bindings])
|
||||||
|
rules)]
|
||||||
|
(selection-strategy possibilities)))
|
||||||
|
|
||||||
|
(defn apply-rule [rule facts context]
|
||||||
|
(let [new-facts (map |(apply-subst $ context) (rule :consequent))]
|
||||||
|
(union new-facts facts)))
|
||||||
|
|
||||||
|
(printf "%j" (let [[rule binds] (select-rule first (KB :rules) (KB :facts))]
|
||||||
|
(apply-rule rule (KB :facts) binds)))
|
10
project.janet
Normal file
10
project.janet
Normal file
@@ -0,0 +1,10 @@
|
|||||||
|
(declare-project
|
||||||
|
:name "κανών"
|
||||||
|
:author "Veit Heller"
|
||||||
|
:license "WTFPL"
|
||||||
|
:url "https://github.com/hellerve/kanon"
|
||||||
|
:repo "git+https://github.com/hellerve/kanon.git")
|
||||||
|
|
||||||
|
(declare-source
|
||||||
|
:name "kanon"
|
||||||
|
:source ["kanon.janet"])
|
Reference in New Issue
Block a user