src/arboretum/dengine/core.clj

@@ -5,9 +5,10 @@
   (:require
    [arboretum.dengine.case :refer [make-case]]
    [arboretum.dengine.feature :refer [make-feature]]
-   [arboretum.dengine.kb :refer [!kb find-feature-for]]
+   [arboretum.dengine.kb :refer [!kb]]
-   [arboretum.dengine.protocols :refer [Node]]
+   [arboretum.dengine.utils :refer [string->keyword]])
-   [arboretum.dengine.utils :refer [string->keyword]]))
+  
+  (:import [arboretum.dengine.case CaseImpl]))
 
 ;; (defn is? 
 ;;   [feature case kb]
@@ -35,12 +36,3 @@
    (let [f (make-feature proposition id default rootnode)]
      (swap! !kb assoc-in [:features id] f)
      f)))
-
-(defn add-dtree! [feature-or-id root-node]
-            (let [f (find-feature-for @!kb feature-or-id)
-                  id (:feature-id f)]
-              (if (satisfies? Node root-node)(swap! !kb assoc-in [:features id :rootnode] root-node)
-                (throw (ex-info (format "Unexpected value `%s` passed for feature" id)
-                                {:feature f
-                                 :root-node root-node
-                                 :type (type root-node)})))))

src/arboretum/dengine/kb.clj

@@ -2,28 +2,38 @@
   (:require
    [arboretum.dengine.protocols :refer [Case Feature KB]]
    [clojure.pprint :refer [pprint]]
-   [taoensso.telemere :refer [log!]])
+   [taoensso.telemere :refer [log!]]))
-  (:import [arboretum.dengine.case CaseImpl]))
 
 (defn find-case-for [kb c]
-  (cond (or (satisfies? Case c) (instance? CaseImpl c)) c
+  (cond (satisfies? Case c) c
         (keyword? c) (-> kb :cases c)
         :else (throw (ex-info (format "Unexpected value `%s` passed for case" c)
                               {:case c
                                :type (type c)}))))
 
 (defn find-case-id [kb c]
-  (:case-id (find-case-for kb c)))
+  (cond
+    (and (keyword? c) (-> kb :cases c)) c
+    (satisfies? Case c) (:case-id c)
+     :else (throw (ex-info (format "Unexpected value `%s` passed for case" c)
+                           {:case c
+                            :type (type c)}))))
 
 (defn find-feature-for [kb f]
   (cond (satisfies? Feature f) f
-        (and (keyword? f) (-> kb :features f)) (-> kb :features f)
+        (keyword? f) (-> kb :features f)
         :else (throw (ex-info (format "Unexpected value `%s` passed for feature" f)
                               {:feature f
                                :type (type f)}))))
 
 (defn find-feature-id [kb f]
-  (:feature-id (find-feature-for kb f)))
+  (cond
+    (and (keyword? f) (-> kb :features f)) f
+    (satisfies? Feature f) (:feature-id f)
+    :else (throw 
+           (ex-info (format "Unexpected value `%s` passed for feature" f)
+                    {:feature f
+                     :type (type f)}))))
 
 (defn do-knowledge 
   "The working guts of the `knowledge` method, separated out to make testing 
@@ -43,20 +53,7 @@
 
 (defrecord KBImpl [^clojure.lang.APersistentMap cases ^clojure.lang.APersistentMap features]
   KB
-  (ask-user ^Boolean [this case-or-id feature-or-id]
-    "Ask the user whether `feature-or-id` is true of the case identified 
-       by `case-or-id?` If the user doesn't know, return `nil`."
-    (let [c (find-case-for this case-or-id)
-          f (find-feature-for this feature-or-id)] 
-        (print (format "What is the value of %s for %s [true/false]: " (:proposition f) (:name c)))
-        (flush)
-        (let [in (read-line)
-              v (try (read-string in)
-                     (catch Exception _))]
-          (when (boolean? v) v))))
   (cases [this] (:cases this))
-  (explain [this case-id feature-id]
-    (-> (do-knowledge this case-id feature-id) :reason))
   (features [this] (:features this))
   (get-case [this case-id] (-> this :cases case-id))
   (get-feature [this feature-id] (-> this :features feature-id))

src/arboretum/dengine/node.clj

@@ -1,22 +1,20 @@
 (ns arboretum.dengine.node
   (:require
-   [arboretum.dengine.kb :refer [!kb find-case-for find-feature-for]]
+   [arboretum.dengine.kb :refer [!kb find-feature-for]]
-   [arboretum.dengine.protocols :refer [Node]] 
+   [arboretum.dengine.protocols :refer [Feature Node]]))
-   [taoensso.telemere :refer [log!]]))
 
 (defrecord NodeImpl [feature-id ^Boolean colour ^String fragment children]
   Node
   (children [this] "The children of this node" (:children this))
   (colour ^Boolean [this] "The colour of this node" (:colour this))
-  (feature [this] "The id of the feature at this node" (.get-feature @!kb (:feature-id this)))
+  (feature [this] "The feature at this node" (find-feature-for @!kb (:feature-id this)))
   (fragment ^String [this] "The explanation fragment at this node"
     (:fragment this))
   (evaluate [this case-id]
-    (let [c (find-case-for @!kb case-id)
+    (let [c (-> !kb .cases case-id)
-          f (.get-feature @!kb (:feature-id this)) 
+          f (if (satisfies? Feature (:feature this)) (:feature this)
-          value (:value (.knowledge @!kb c f))]
+                (-> !kb .features (:feature this))) 
-      (log! {:msg (format "evaluating node %s (%s %s) for case %s"
+          value (:value (.knowledge !kb c f))]
-                          this (:feature-id this) (:colour this) (:case-id c))})
       (when
        value (if
               (empty? (:children this))

src/arboretum/dengine/protocols.clj

@@ -56,22 +56,19 @@
 (defprotocol KB
   "A knowledge base, comprising features and means to infer their value
     in a given case, and cases which have features with values."
-  (ask-user ^Boolean [this case-or-id feature-or-id]
+  (ask-user ^Boolean [this case-or-id]
     "Ask the user whether `feature-or-id` is true of the case identified 
      by `case-or-id?` If the user doesn't know, return `nil`.")
-  (cases ^APersistentMap [this] 
-    "All cases known in this knowledge base, keyed by `:case-id`")
-  (explain ^String [this case-id feature-id]
-    "Return the reason for believing the value that is believed of the feature
-     identified by `feature-id` in the case identified by `case-id`.")
-  (features ^APersistentMap [this] 
-    "All features known in this knowledge base, keyed by `:proposition`")
   (get-case ^APersistentMap [this ^Keyword case_id] 
     "Return the case with this `id` from among my cases,
      if present, else `nil`")
+  (cases ^APersistentMap [this] 
+    "All cases known in this knowledge base, keyed by `:case-id`")
   (get-feature ^APersistentMap [this id-or-prop] 
     "Return the feature with this `id` from among my features,
      if present, else `nil`")
+  (features ^APersistentMap [this] 
+    "All features known in this knowledge base, keyed by `:proposition`")
   (is? ^Boolean [this case-or-id feature-or-id] 
     "Is the feature identified by `feature-or-id` true of the case identified 
      by `case-or-id`? If feature is undecided for this case, return `nil`.")
@@ -92,4 +89,6 @@
   (evaluate [this case-id] "evaluate this node in the context of the case
                             identified by `case-id`.
                             Returns a map with keys `:value`, `:explanation` 
-                            and possibly `:authority`."))
+                            and possibly `:authority`.")
+  (explain [this case-id] "return an explanation from this node or its children
+                           for the case identified by `case-id`"))

test/dengine/dengine_test.clj

@@ -1,12 +1,6 @@
 (ns dengine.dengine-test
   (:require
-   [arboretum.dengine.dengine :refer [decide-feat]]
+   [arboretum.dengine.node :refer [make-node]]))
-   [clojure.test :refer [deftest is testing]]))
+
-
-(deftest decide-feat-test
-      (testing "Context of the test assertions"
-        (let [expected true
-              actual (:value
-                      (decide-feat :is-entitled-to-widows-allowance :case-1))](is (= actual expected)))))  
 
 

test/dengine/test_kb.clj

@@ -2,7 +2,7 @@
   "Knowledge base to use in testing."
   (:require
    [arboretum.dengine.case :refer [make-case]]
-   [arboretum.dengine.core :refer [add-dtree! add-feature!]]
+   [arboretum.dengine.core :refer [add-feature!]]
    [arboretum.dengine.feature :refer [make-feature]]
    [arboretum.dengine.kb :refer [!kb]]
    [arboretum.dengine.node :refer [make-node]]
@@ -35,10 +35,27 @@
             :in-prison (make-feature "In prison" :in-prison false nil)
             :husbands-contributions-qualify (make-feature "Husband's contributions qualify" :husbands-contributions-qualify true nil)}))
 
+(pp/pprint testkb)
+
 (reset! !kb testkb)
 
 (add-feature! "Is entitled to Widows' Allowance" :is-entitled-to-widows-allowance false nil)
 
+;; TODO:
+;; we can't add a node in `add-feature!` since creating the root node requires 
+;; that the feature already exists. So the 'rootnode' argument to `add-feature`
+;; and make-feature is not useful and should be deleted. We also need to test 
+;; when adding a dtree to an existing feature that the rootnode references that 
+;; feature.
+
+;; OK, it's worse than that. We can't persist and restore a knowledge base in
+;; which features are directly linked from DTree nodes, since then we would
+;; (probably) create multiple copies of the feature when reloading. So probably
+;; the node should only hold the id of the feature, not a direct link.
+
+;; This does mean, however, that the node could be made at feature creation 
+;; time.
+
 (add-dtree! :is-entitled-to-widows-allowance 
             (make-node :is-entitled-to-widows-allowance false 
                        "I have not been able to determine that you are entitled to Widows' Allowance."
@@ -63,9 +80,5 @@
                                         "Although you are a widow, your late husband's National Insurance contributions were not sufficient to qualify."
                                         (list (make-node :husbands-contributions-qualify false
                                                          "Although your late husband's contributions were sufficient, we understand you have a pension.")
-                                              (list (make-node :under-pension-age-when-bereaved true
+                                              (list (make-node :under-pension-age-when-bereaved)))))))
-                                                               "Because you were under pensionable age when bereaved, you are entitled to Widows' Allowance")
-                                                    (make-node :husband-not-entitled-to-cata-rp true
-                                                               "Because your husband was not entitled to a Category A Retirement Pension, you are entitled to Widows' Allowance")))))))
 
-(pp/pprint @!kb)