Merge branch 'master' of ssh://git.journeyman.cc:4022/simon/dengine

src/arboretum/dengine/core.clj

@@ -5,10 +5,9 @@
   (:require
    [arboretum.dengine.case :refer [make-case]]
    [arboretum.dengine.feature :refer [make-feature]]
-   [arboretum.dengine.kb :refer [!kb]]
+   [arboretum.dengine.kb :refer [!kb find-feature-for]]
-   [arboretum.dengine.utils :refer [string->keyword]])
+   [arboretum.dengine.protocols :refer [Node]]
-  
+   [arboretum.dengine.utils :refer [string->keyword]]))
-  (:import [arboretum.dengine.case CaseImpl]))
 
 ;; (defn is? 
 ;;   [feature case kb]
@@ -36,3 +35,12 @@
    (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,40 +2,30 @@
   (: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 (satisfies? Case c) c
+  (cond (or (satisfies? Case c) (instance? CaseImpl 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]
-  (cond
+  (:case-id (find-case-for kb c)))
-    (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
-        (keyword? f) (-> kb :features f)
+        (and (keyword? f) (-> kb :features 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]
-  (cond
+  (:feature-id (find-feature-for kb f)))
-    (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 
+(defn do-knowledge
   "The working guts of the `knowledge` method, separated out to make testing 
    easier. TODO: these wrapper functions will probably disappear once
    I'm more comfortable with the architecture."
@@ -44,7 +34,7 @@
         f (find-feature-id kb feature-or-id)]
     (-> c :knowledge f)))
 
-(defn do-is? 
+(defn do-is?
   "The working guts of the `is?` method, separated out to make testing 
    easier. TODO: these wrapper functions will probably disappear once
    I'm more comfortable with the architecture."
@@ -53,7 +43,20 @@
 
 (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))
@@ -69,9 +72,9 @@
 (defn remember!
   "Remember this `value` for the feature with this `feature-id` of the case
    with this `case-id`. Return the `value`."
-  ([case-id feature-id value] 
+  ([case-id feature-id value]
    (let [v (cond (boolean? value) {:value value}
-                  (and (map? value) (boolean? (:value value))) value)
+                 (and (map? value) (boolean? (:value value))) value)
          c (find-case-id @!kb case-id)
          f (find-feature-id @!kb feature-id)]
      (when-not (and v c f)

src/arboretum/dengine/node.clj

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

src/arboretum/dengine/protocols.clj

@@ -56,19 +56,22 @@
 (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]
+  (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`.")
-  (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] 
+  (explain ^String [this case-id feature-id]
-    "Return the feature with this `id` from among my features,
+    "Return the reason for believing the value that is believed of the feature
-     if present, else `nil`")
+     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`")
+  (get-feature ^APersistentMap [this id-or-prop]
+             "Return the feature with this `id` from among my features,
+     if present, else `nil`")
   (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`.")
@@ -89,6 +92,4 @@
   (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,6 +1,12 @@
 (ns dengine.dengine-test
   (:require
-   [arboretum.dengine.node :refer [make-node]]))
+   [arboretum.dengine.dengine :refer [decide-feat]]
-
+   [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-feature!]]
+   [arboretum.dengine.core :refer [add-dtree! add-feature!]]
    [arboretum.dengine.feature :refer [make-feature]]
    [arboretum.dengine.kb :refer [!kb]]
    [arboretum.dengine.node :refer [make-node]]
@@ -12,7 +12,7 @@
 
 (def testkb
   (KBImpl. {:case-1
-            (make-case :case-1 "Mrs Norah Trellis"
+            (make-case :case-1 "Mrs Norah Trellis" 
                        {:married {:value true
                                   :authority :user
                                   :reason "I have been told that married is true of Mrs Norah Trellis"}
@@ -35,27 +35,10 @@
             :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."
@@ -80,5 +63,9 @@
                                         "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)))))))
+                                              (list (make-node :under-pension-age-when-bereaved true
+                                                               "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)