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