simon/dengine
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Nearer and nearer to working. No DTree testing yet, but other things good.

Browse source
This commit is contained in:
Simon Brooke 2025-08-14 11:16:20 +01:00
parent 45f6b972c7
commit 99fce9c98f
4 changed files with 45 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
project.clj
View file

@ -5,5 +5,5 @@
:url "https://www.eclipse.org/legal/epl-2.0/"} :url "https://www.eclipse.org/legal/epl-2.0/"}
:dependencies [[org.clojure/clojure "1.11.1"] :dependencies [[org.clojure/clojure "1.11.1"]
[org.clojure/clojure "1.12.0"] [org.clojure/clojure "1.12.0"]
[com.taoensso/timbre "4.10.0"]] [com.taoensso/telemere "1.0.1"]]
:repl-options {:init-ns arboretum.dengine.core}) :repl-options {:init-ns arboretum.dengine.core})

15
src/arboretum/dengine/dengine.clj
View file

@ -2,14 +2,14 @@
(:require (:require
[arboretum.dengine.kb :refer [!kb find-case-for find-feature-for remember!]] [arboretum.dengine.kb :refer [!kb find-case-for find-feature-for remember!]]
[arboretum.dengine.protocols :refer [Case]] [arboretum.dengine.protocols :refer [Case]]
[taoensso.timbre :as timbre :refer [log]])) [taoensso.telemere :refer [log!]]))
(defn dengine [feat c] (defn dengine [feat c]
(let [c' (if (satisfies? Case c) c (-> @!kb :cases c)) (let [c' (if (satisfies? Case c) c (-> @!kb :cases c))
f' (find-feature-for @!kb feat)] f' (find-feature-for @!kb feat)]
;; (log (format "Inferring value of `%s` for `%s`" (log! {:msg (format "Inferring value of `%s` for `%s`"
;; (:case-id c') (:feature-id f'))) (:case-id c') (:feature-id f'))})
(when (nil? c') (throw (ex-info "Unknown or invalid case" (when (nil? c') (throw (ex-info "Unknown or invalid case"
{:case-identifier c}))) {:case-identifier c})))
(when (:rootnode f') (when (:rootnode f')
@ -19,15 +19,16 @@
(defn decide-feat [feat c] (defn decide-feat [feat c]
(let [c' (find-case-for @!kb c) (let [c' (find-case-for @!kb c)
f' (find-feature-for @!kb feat) f' (find-feature-for @!kb feat)
v (.knowledge @!kb (.case-id c') (.feature-id f')) v (.knowledge @!kb (:case-id c') (:feature-id f'))
k (cond v v k (cond v v
(:rootnode f') (dengine f' c') (:rootnode f') (dengine f' c')
:else {:value (:default f') :else {:value (:default f')
:authority :default :authority :default
:reason (format :reason (format
"I assumed %s was %s of %s." "I assumed %s was %s of %s."
(:name f') (:proposition f')
(:default f') (:default f')
(.name c'))})] (:case-name c'))})]
(remember! f' c' k) (log! {:msg "decide-feat" :value k})
(remember! (:case-id c') (:feature-id f') k)
(:value k))) (:value k)))

58
src/arboretum/dengine/kb.clj
View file

@ -2,12 +2,7 @@
(:require (:require
[arboretum.dengine.protocols :refer [Case Feature KB]] [arboretum.dengine.protocols :refer [Case Feature KB]]
[clojure.pprint :refer [pprint]] [clojure.pprint :refer [pprint]]
[taoensso.timbre :as timbre :refer [log trace debug info warn error fatal report [taoensso.telemere :refer [log!]]))
logf tracef debugf infof warnf errorf fatalf reportf
spy]]))
;; (timbre/set-ns-min-level! :info)
(defn find-case-for [kb c] (defn find-case-for [kb c]
(cond (satisfies? Case c) c (cond (satisfies? Case c) c
@ -16,6 +11,11 @@
{:case c {:case c
:type (type c)})))) :type (type c)}))))
(defn find-case-id [kb c]
(cond
(and (keyword? c) (-> kb :cases c)) c
(satisfies? Case c) (:case-id c)))
(defn find-feature-for [kb f] (defn find-feature-for [kb f]
(cond (satisfies? Feature f) f (cond (satisfies? Feature f) f
(keyword? f) (-> kb :features f) (keyword? f) (-> kb :features f)
@ -23,10 +23,18 @@
{:case f {:case f
:type (type f)})))) :type (type f)}))))
(defn do-is? [kb case-or-id feature-or-id] (defn find-feature-id [kb f]
(cond
(and (keyword? f) (-> kb :features f)) f
(satisfies? Feature f) (:feature-id f)))
(defn do-knowledge [kb case-or-id feature-or-id]
(let [c (find-case-for kb case-or-id) (let [c (find-case-for kb case-or-id)
f (find-feature-for kb feature-or-id)] f (find-feature-id kb feature-or-id)]
(-> c :knowledge (:feature-id f) :value))) (-> c :knowledge f)))
(defn do-is? [kb case-or-id feature-or-id]
(-> (do-knowledge kb case-or-id feature-or-id) :value))
(defrecord KBImpl [^clojure.lang.APersistentMap cases ^clojure.lang.APersistentMap features] (defrecord KBImpl [^clojure.lang.APersistentMap cases ^clojure.lang.APersistentMap features]
KB KB
@ -37,9 +45,7 @@
(is? [this case-or-id feature-or-id] (is? [this case-or-id feature-or-id]
(do-is? this case-or-id feature-or-id)) (do-is? this case-or-id feature-or-id))
(knowledge [this case-or-id feature-or-id] (knowledge [this case-or-id feature-or-id]
(let [c (find-case-for this case-or-id) (do-knowledge this case-or-id feature-or-id)))
f (find-feature-for this feature-or-id)]
(-> c :knowledge (:feature-id f)))))
(def !kb (def !kb
"The one instance of the knowledge base." "The one instance of the knowledge base."
@ -48,18 +54,22 @@
(defn remember! (defn remember!
"Remember this `value` for the feature with this `feature-id` of the case "Remember this `value` for the feature with this `feature-id` of the case
with this `case-id`. Return the `value`." with this `case-id`. Return the `value`."
[case-id feature-id value] ([case-id feature-id value]
;; (log (format "Remembering case `%s`, feature `%s`, value `%s`" (let [v (cond (boolean? value) {:value value}
;; case-id feature-id value)) (and (map? value) (boolean? (:value value))) value)
(cond c (find-case-id @!kb case-id)
(boolean? value) (swap! !kb assoc-in f (find-feature-id @!kb feature-id)]
[:cases case-id :knowledge feature-id :value] value) (when-not (and v c f)
(map? value) (swap! !kb assoc-in (throw (ex-info "Missing data in remember!" {:value value
[:cases case-id :knowledge feature-id] value) :v v
:else (throw (ex-info "Unexpected value?" {:case-id case-id :feature-id feature-id
:feature-id feature-id :f f
:value value}))) :case-id case-id
value) :c c})))
(log! {:msg (format "Remembering case `%s`, feature `%s`, value `%s`"
case-id feature-id (:value v))})
(swap! !kb assoc-in [:cases c :knowledge f] v)
(:value v))))
(defn persist [filepath] (defn persist [filepath]
(let [p (if (empty? filepath) "kb.edn" filepath)] (let [p (if (empty? filepath) "kb.edn" filepath)]

3
test/dengine/feature_test.clj
View file

@ -15,7 +15,8 @@
(deftest feature-impl-test (deftest feature-impl-test
(testing "Testing feature implementation" (testing "Testing feature implementation"
(let [f (add-feature! "is entitled to Widow's Allowance" :is-entitled-to-widows-allowance false nil) (let [f (add-feature! "is entitled to Widow's Allowance"
:is-entitled-to-widows-allowance false nil)
c (add-case! "Mrs Nora Trellis" :case_1 c (add-case! "Mrs Nora Trellis" :case_1
{:married {:value true {:married {:value true
:authority :user :authority :user