Started (but not completed) adding inference rules to the test knowledge base.
This commit consequently will not pass tests.
This commit is contained in:
parent
5c1427e8fa
commit
a3a69b8439
|
|
@ -18,7 +18,8 @@
|
|||
(proposition [this] (:proposition this)))
|
||||
|
||||
(defn make-feature
|
||||
"A convenience function to make features."
|
||||
"A convenience function to make features. TODO: these wrapper functions will
|
||||
probably disappear once I'm more comfortable with the architecture."
|
||||
([proposition default rootnode]
|
||||
(make-feature proposition (string->keyword proposition) default rootnode))
|
||||
([proposition id default rootnode]
|
||||
|
|
|
|||
|
|
@ -35,12 +35,20 @@
|
|||
{:feature f
|
||||
:type (type f)}))))
|
||||
|
||||
(defn do-knowledge [kb case-or-id feature-or-id]
|
||||
(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."
|
||||
[kb case-or-id feature-or-id]
|
||||
(let [c (find-case-for kb case-or-id)
|
||||
f (find-feature-id kb feature-or-id)]
|
||||
(-> c :knowledge f)))
|
||||
|
||||
(defn do-is? [kb case-or-id feature-or-id]
|
||||
(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."
|
||||
[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]
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
[arboretum.dengine.protocols :refer [Feature Node]]
|
||||
[clojure.string :as string]))
|
||||
|
||||
(defrecord NodeImpl [children ^Boolean colour feature ^String fragment]
|
||||
(defrecord NodeImpl [feature ^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))
|
||||
|
|
@ -28,6 +28,13 @@
|
|||
(first (remove nil? (map #(.evaluate % c)
|
||||
(:children this)))))))))
|
||||
|
||||
(defn make-node
|
||||
"Make a node. TODO: these wrapper functions will probably disappear once
|
||||
I'm more comfortable with the architecture."
|
||||
([feature ^Boolean colour ^String fragment]
|
||||
(make-node feature colour fragment nil))
|
||||
([feature ^Boolean colour ^String fragment children ]
|
||||
(NodeImpl. feature colour fragment children)))
|
||||
|
||||
;; Here's the algorithm as published in A Graphical Inference Mechanism,
|
||||
;; but it's not real Interlisp code, and I remember there being at least
|
||||
|
|
|
|||
6
test/dengine/dengine_test.clj
Normal file
6
test/dengine/dengine_test.clj
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(ns dengine.dengine-test
|
||||
(:require
|
||||
[arboretum.dengine.node :refer [make-node]]))
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,35 +1,30 @@
|
|||
(ns dengine.feature-test
|
||||
(:require
|
||||
[arboretum.dengine.case :refer [make-case]]
|
||||
[arboretum.dengine.core :refer [add-case! add-feature!]]
|
||||
[arboretum.dengine.feature :refer [make-feature]]
|
||||
[arboretum.dengine.kb :refer [!kb]]
|
||||
[clojure.pprint :refer [pprint]]
|
||||
[clojure.test :refer [deftest is testing]])
|
||||
(:import
|
||||
[arboretum.dengine.kb KBImpl]))
|
||||
[clojure.test :refer [deftest is testing]]
|
||||
[dengine.test-kb :refer [testkb]]))
|
||||
|
||||
(def testkb (KBImpl. {:case-1 (make-case :case-1 "Mrs Nora Trellis"
|
||||
{:married {:value true
|
||||
:authority :user
|
||||
:reason "I have been told that married is true of Mrs Norah Trellis"}
|
||||
:divorced {:value false
|
||||
:authority :default
|
||||
:reason "I assumed that divorced is false of Mrs Norah Trellis"}
|
||||
:is-entitled-to-widows-benefit {:value true
|
||||
:authority :rule
|
||||
:reason "I infered that is-entitled-to-widows-benefit is true of Mrs Norah Trellis"}})}
|
||||
{:widowed (make-feature "Widowed" :widowed false nil)
|
||||
:married (make-feature "Married" :married false nil)}))
|
||||
;; (def testkb (KBImpl. {:case-1 (make-case :case-1 "Mrs Nora Trellis"
|
||||
;; {:married {:value true
|
||||
;; :authority :user
|
||||
;; :reason "I have been told that married is true of Mrs Norah Trellis"}
|
||||
;; :divorced {:value false
|
||||
;; :authority :default
|
||||
;; :reason "I assumed that divorced is false of Mrs Norah Trellis"}
|
||||
;; :is-entitled-to-widows-benefit {:value true
|
||||
;; :authority :rule
|
||||
;; :reason "I infered that is-entitled-to-widows-benefit is true of Mrs Norah Trellis"}})}
|
||||
;; {:widowed (make-feature "Widowed" :widowed false nil)
|
||||
;; :married (make-feature "Married" :married false nil)}))
|
||||
|
||||
(reset! !kb testkb)
|
||||
;; (reset! !kb testkb)
|
||||
|
||||
(pprint @!kb)
|
||||
;; (pprint testkb)
|
||||
|
||||
(deftest feature-impl-test
|
||||
(testing "Testing feature implementation"
|
||||
(let [f1 (.get-feature @!kb :widowed)
|
||||
c (.get-case @!kb :case-1)]
|
||||
(let [f1 (.get-feature testkb :widowed)
|
||||
c (.get-case testkb :case-1)]
|
||||
(pprint {:f f1
|
||||
:c c})
|
||||
(let [expected :widowed
|
||||
|
|
@ -42,5 +37,5 @@
|
|||
actual (.decide f1 c)]
|
||||
(is (= actual expected) "If we have no knowledge and no decision method, take the defualt."))
|
||||
(let [expected true
|
||||
actual (.decide (.get-feature @!kb :married) :case-1)]
|
||||
actual (.decide (.get-feature testkb :married) :case-1)]
|
||||
(is (= actual expected) "If we have knowledge, return it.")))))
|
||||
|
|
@ -1,33 +1,10 @@
|
|||
(ns dengine.kb-test
|
||||
(:require
|
||||
[arboretum.dengine.case :refer [make-case]]
|
||||
[arboretum.dengine.core :refer [add-case! add-feature!]]
|
||||
[arboretum.dengine.feature :refer [make-feature]]
|
||||
[arboretum.dengine.core :refer [add-feature!]]
|
||||
[arboretum.dengine.kb :refer :all]
|
||||
[clojure.pprint :refer [pprint]]
|
||||
[clojure.test :refer [deftest is testing]])
|
||||
(:import
|
||||
[arboretum.dengine.kb KBImpl]))
|
||||
[clojure.test :refer [deftest is testing]]
|
||||
[dengine.test-kb :refer [testkb]]))
|
||||
|
||||
(def testkb (KBImpl. {:case-1 (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"}
|
||||
:divorced {:value false
|
||||
:authority :default
|
||||
:reason "I assumed that divorced is false of Mrs Norah Trellis"}
|
||||
:is-entitled-to-widows-benefit {:value true
|
||||
:authority :rule
|
||||
:reason "I infered that is-entitled-to-widows-benefit is true of Mrs Norah Trellis"}})}
|
||||
{:divorced (make-feature "Divorced" :divorced false nil)
|
||||
:married (make-feature "Married" :married false nil)
|
||||
:widowed (add-feature! "Widowed" :widowed false nil)
|
||||
:is-entitled-to-widows-benefit
|
||||
(add-feature! "Is entitled to widows' benefit"
|
||||
:is-entitled-to-widows-benefit false nil)}))
|
||||
|
||||
(pprint testkb)
|
||||
|
||||
(reset! !kb testkb)
|
||||
|
||||
(deftest access-test
|
||||
(testing "Accessing knowledge in the knowledge base"
|
||||
|
|
@ -42,7 +19,7 @@
|
|||
(is (= actual expected))))
|
||||
(testing "Adding features"
|
||||
(let [expected nil
|
||||
actual (.get-feature @!kb :has-children)]
|
||||
actual (.get-feature testkb :has-children)]
|
||||
(is (= actual expected) "Not present until added..."))
|
||||
(add-feature! "Has children" :has-children false nil)
|
||||
(let [expected :has-children
|
||||
|
|
|
|||
84
test/dengine/test_kb.clj
Normal file
84
test/dengine/test_kb.clj
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
(ns dengine.test-kb
|
||||
"Knowledge base to use in testing."
|
||||
(:require
|
||||
[arboretum.dengine.case :refer [make-case]]
|
||||
[arboretum.dengine.core :refer [add-feature!]]
|
||||
[arboretum.dengine.feature :refer [make-feature]]
|
||||
[arboretum.dengine.kb :refer [!kb]]
|
||||
[arboretum.dengine.node :refer [make-node]]
|
||||
[clojure.pprint :as pp])
|
||||
(:import
|
||||
[arboretum.dengine.kb KBImpl]))
|
||||
|
||||
(def testkb
|
||||
(KBImpl. {:case-1
|
||||
(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"}
|
||||
:divorced {:value false
|
||||
:authority :default
|
||||
:reason "I assumed that divorced is false of Mrs Norah Trellis"}})}
|
||||
{:divorced (make-feature "Divorced" :divorced false nil)
|
||||
:married (make-feature "Married" :married false nil)
|
||||
:widowed (make-feature "Widowed" :widowed false nil)
|
||||
:is-entitled-to-widows-allowance (make-feature "Is entitled to Widows' Allowance"
|
||||
:is-entitled-to-widows-allowance
|
||||
false nil)
|
||||
:satisfies-conditions-for-widows-allowance (make-feature "Satisfies conditions for Widows' Allowance"
|
||||
:satisfies-conditions-for-widows-allowance
|
||||
false nil)
|
||||
:gt-26-weeks-bereaved (make-feature "> 26 weeks bereaved" :gt-26-weeks-bereaved
|
||||
false nil)
|
||||
:killed-husband (make-feature "Killed husband" :killed-husband false nil)
|
||||
:dead (make-feature "Dead" :dead false nil)
|
||||
: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."
|
||||
(list (make-node :satisfies-conditions-for-widows-allowance true
|
||||
"You satisfy all the conditions for Widows' Allowance."
|
||||
(list (make-node :gt-26-weeks-bereaved false
|
||||
"You no longer qualify for Widows' Allowance as it is more than 26 weeks since you were bereaved")
|
||||
(make-node :killed-husband false
|
||||
"You do not qualify for Widows' Allowance as we understand that you killed your husband.")
|
||||
(make-node :dead false
|
||||
"The subject of this application does not qualify for Widows' Allowance as we understand that she is dead")
|
||||
(make-node :in-prison false
|
||||
"You do not qualify for Widows' Allowance while you are in prison")
|
||||
(make-node :living-with-partner false
|
||||
"You do not qualify for Widows' Allowance as we understand that you have a new partner.")
|
||||
)))))
|
||||
|
||||
(add-dtree! :satisfies-conditions-for-widows-allowance
|
||||
(make-node :satisfies-conditions-for-widows-allowance false
|
||||
"I have not been able to determine that you satisfy the conditions for Widows' Allowance."
|
||||
(list (make-node :widowed false
|
||||
"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)))))))
|
||||
|
||||
Loading…
Reference in a new issue