Frustratingly close to working, which is another way of saying not working at all.
This commit is contained in:
parent
33dcbf3f9c
commit
45f6b972c7
|
|
@ -4,5 +4,6 @@
|
|||
:license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
|
||||
:url "https://www.eclipse.org/legal/epl-2.0/"}
|
||||
: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"]]
|
||||
:repl-options {:init-ns arboretum.dengine.core})
|
||||
|
|
|
|||
|
|
@ -1,10 +1,14 @@
|
|||
(ns arboretum.dengine.case
|
||||
(:require [arboretum.dengine.protocols :refer [Case]]))
|
||||
|
||||
(defrecord CaseImpl [ id name knowledge]
|
||||
(defrecord CaseImpl [case-id case-name knowledge]
|
||||
Case
|
||||
(id [this] :foo);;(:id this))
|
||||
(name [this] "foo") ;;(or (:name this) (clojure.core/name (:id this))))
|
||||
(knowledge [this] (:knowledge this))
|
||||
(is? [this feature-id] ((:knowledge this) feature-id))
|
||||
)
|
||||
(authority [this feature-id] (:authority ((:knowledge this) feature-id)))
|
||||
(case-id [this] (:case-id this))
|
||||
(case-name [this] (or (:case-name this) (clojure.core/name (:case-id this)))))
|
||||
|
||||
(defn make-case
|
||||
([id name]
|
||||
(make-case id name {}))
|
||||
([id name knowledge]
|
||||
(CaseImpl. id name knowledge)))
|
||||
|
|
@ -1,14 +1,38 @@
|
|||
(ns arboretum.dengine.core
|
||||
;; (:require [arboretum.dengine.feature :refer [decide explain]]
|
||||
;; [arboretum.dengine.protocols :refer [proposition]])
|
||||
)
|
||||
|
||||
(defn foo
|
||||
"I don't do a whole lot."
|
||||
[x]
|
||||
(println x "Hello, World!"))
|
||||
(:require
|
||||
[arboretum.dengine.case :refer [make-case]]
|
||||
[arboretum.dengine.feature :refer [make-feature]]
|
||||
[arboretum.dengine.kb :refer [!kb]]
|
||||
[arboretum.dengine.utils :refer [string->keyword]])
|
||||
|
||||
(:import [arboretum.dengine.case CaseImpl]))
|
||||
|
||||
;; (defn is?
|
||||
;; [feature case kb]
|
||||
;; (let [evaluation (decide feature case kb)]
|
||||
;; ((proposition feature) evaluation)))
|
||||
|
||||
|
||||
(defn add-case!
|
||||
"Add a case to the knowledge base with this `name`, and, if supplied, this `id`."
|
||||
([^String name]
|
||||
(add-case! name (string->keyword name (set (map #(:case-id %) (.cases @!kb))))))
|
||||
([^String name ^clojure.lang.Keyword id]
|
||||
(let [c (make-case id name)]
|
||||
(swap! !kb assoc-in [:cases id] c)
|
||||
c))
|
||||
([^String name ^clojure.lang.Keyword id ^clojure.lang.PersistentArrayMap knowledge]
|
||||
(let [c (make-case id name knowledge)]
|
||||
(swap! !kb assoc-in [:cases id] c)
|
||||
c)))
|
||||
|
||||
(defn add-feature!
|
||||
([^String proposition default rootnode]
|
||||
(add-feature! proposition (string->keyword proposition (set (map #(:feature-id %) (.features @!kb)))) default rootnode))
|
||||
([^String proposition ^clojure.lang.Keyword id default rootnode]
|
||||
(let [f (make-feature proposition id default rootnode)]
|
||||
(swap! !kb assoc-in [:features id] f)
|
||||
f)))
|
||||
|
|
|
|||
33
src/arboretum/dengine/dengine.clj
Normal file
33
src/arboretum/dengine/dengine.clj
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
(ns arboretum.dengine.dengine
|
||||
(:require
|
||||
[arboretum.dengine.kb :refer [!kb find-case-for find-feature-for remember!]]
|
||||
[arboretum.dengine.protocols :refer [Case]]
|
||||
[taoensso.timbre :as timbre :refer [log]]))
|
||||
|
||||
|
||||
(defn dengine [feat c]
|
||||
(let [c' (if (satisfies? Case c) c (-> @!kb :cases c))
|
||||
f' (find-feature-for @!kb feat)]
|
||||
;; (log (format "Inferring value of `%s` for `%s`"
|
||||
;; (:case-id c') (:feature-id f')))
|
||||
(when (nil? c') (throw (ex-info "Unknown or invalid case"
|
||||
{:case-identifier c})))
|
||||
(when (:rootnode f')
|
||||
(first (remove nil? (map #(.evaluate % c)
|
||||
(:children (:rootnode f'))))))))
|
||||
|
||||
(defn decide-feat [feat c]
|
||||
(let [c' (find-case-for @!kb c)
|
||||
f' (find-feature-for @!kb feat)
|
||||
v (.knowledge @!kb (.case-id c') (.feature-id f'))
|
||||
k (cond v v
|
||||
(:rootnode f') (dengine f' c')
|
||||
:else {:value (:default f')
|
||||
:authority :default
|
||||
:reason (format
|
||||
"I assumed %s was %s of %s."
|
||||
(:name f')
|
||||
(:default f')
|
||||
(.name c'))})]
|
||||
(remember! f' c' k)
|
||||
(:value k)))
|
||||
|
|
@ -1,35 +1,25 @@
|
|||
(ns arboretum.dengine.feature
|
||||
(:require [arboretum.dengine.kb :refer [!kb]]
|
||||
[arboretum.dengine.protocols :refer [Case Feature Node]]
|
||||
[arboretum.dengine.utils :refer [string->keyword]]
|
||||
[clojure.spec.alpha :as spec]))
|
||||
(:require
|
||||
[arboretum.dengine.dengine :refer [decide-feat]]
|
||||
[arboretum.dengine.protocols :refer [Feature]]
|
||||
[arboretum.dengine.utils :refer [string->keyword]]))
|
||||
|
||||
(spec/def :arboretum.dengine.feature/name string?)
|
||||
;; (spec/def :arboretum.dengine.feature/name string?)
|
||||
|
||||
(spec/def :arboretum.dengine.feature/default boolean?)
|
||||
;; (spec/def :arboretum.dengine.feature/default boolean?)
|
||||
|
||||
(defn- dengine [this c]
|
||||
(let [c' (if (satisfies? Case c) c (-> @!kb :cases c))]
|
||||
(when (nil? c') (throw (ex-info "Unknown or invalid case"
|
||||
{:case-identifier c})))
|
||||
(if (:rootnode this)
|
||||
(when-not (satisfies? Node (:rootnode this))
|
||||
(throw (ex-info "Invalid DTree node"
|
||||
{:node (:rootnode this)
|
||||
:context this})))
|
||||
(first
|
||||
(filter boolean?
|
||||
(map #(.evaluate % c)
|
||||
(-> this :rootnode :children)))))))
|
||||
|
||||
(defrecord FeatureImpl [^String proposition ^boolean default rootnode]
|
||||
(defrecord FeatureImpl [^String proposition ^clojure.lang.Keyword feature-id ^boolean default rootnode]
|
||||
Feature
|
||||
(decide [this c] (let [v ((.id this) c)]
|
||||
(cond (boolean? v) v
|
||||
(:rootnode this) (dengine (:rootnode this) c)
|
||||
:else (:default this))))
|
||||
(decide [this c] (decide-feat this c))
|
||||
(default [this] (:default this))
|
||||
(id [this] (string->keyword (:proposition this)))
|
||||
(feature-id [this] (string->keyword (:proposition this)))
|
||||
(rootnode [this] (:rootnode this))
|
||||
(proposition [this] (:proposition this)))
|
||||
|
||||
(defn make-feature
|
||||
"A convenience function to make features."
|
||||
([proposition default rootnode]
|
||||
(make-feature proposition (string->keyword proposition) default rootnode))
|
||||
([proposition id default rootnode]
|
||||
(FeatureImpl. proposition id default rootnode)))
|
||||
|
|
@ -1,44 +1,78 @@
|
|||
(ns arboretum.dengine.kb
|
||||
(:require
|
||||
arboretum.dengine.case
|
||||
[arboretum.dengine.protocols :refer [Case Feature Kb]]
|
||||
[arboretum.dengine.utils :refer [string->keyword]]
|
||||
[clojure.pprint :refer [pprint]])
|
||||
(:import
|
||||
[arboretum.dengine.case CaseImpl]))
|
||||
[arboretum.dengine.protocols :refer [Case Feature KB]]
|
||||
[clojure.pprint :refer [pprint]]
|
||||
[taoensso.timbre :as timbre :refer [log trace debug info warn error fatal report
|
||||
logf tracef debugf infof warnf errorf fatalf reportf
|
||||
spy]]))
|
||||
|
||||
(defrecord KBImpl [cases features]
|
||||
Kb
|
||||
|
||||
;; (timbre/set-ns-min-level! :info)
|
||||
|
||||
(defn find-case-for [kb 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-feature-for [kb f]
|
||||
(cond (satisfies? Feature f) f
|
||||
(keyword? f) (-> kb :features f)
|
||||
:else (throw (ex-info (format "Unexpected value `%s` passed for feature" f)
|
||||
{:case f
|
||||
:type (type f)}))))
|
||||
|
||||
(defn do-is? [kb case-or-id feature-or-id]
|
||||
(let [c (find-case-for kb case-or-id)
|
||||
f (find-feature-for kb feature-or-id)]
|
||||
(-> c :knowledge (:feature-id f) :value)))
|
||||
|
||||
(defrecord KBImpl [^clojure.lang.APersistentMap cases ^clojure.lang.APersistentMap features]
|
||||
KB
|
||||
(cases [this] (:cases this))
|
||||
(features [this] (:features this))
|
||||
(get-case [this case-id] (-> this :cases case-id))
|
||||
(get-feature [this feature-id] (-> this :features feature-id))
|
||||
(is? [this case-or-id feature-or-id]
|
||||
(let [c (if (satisfies? Case case-or-id)
|
||||
case-or-id (-> this :cases case-or-id))
|
||||
f (if (satisfies? Feature feature-or-id) feature-or-id
|
||||
(-> this :features feature-or-id))]
|
||||
(-> c (:id f)))))
|
||||
(do-is? this case-or-id feature-or-id))
|
||||
(knowledge [this case-or-id feature-or-id]
|
||||
(let [c (find-case-for this case-or-id)
|
||||
f (find-feature-for this feature-or-id)]
|
||||
(-> c :knowledge (:feature-id f)))))
|
||||
|
||||
(def !kb
|
||||
"The one instance of the knowledge base."
|
||||
(atom (KBImpl. nil nil)))
|
||||
(atom (KBImpl. {} {})))
|
||||
|
||||
(defn add-case
|
||||
"Add a case to the knowledge base with this `name`, and, if supplied, this `id`."
|
||||
([^String name]
|
||||
(add-case name (string->keyword name (map :id (.cases @!kb)))))
|
||||
([^String name ^clojure.lang.Keyword id]
|
||||
(let [c (CaseImpl. id name {})]
|
||||
(swap! !kb update-in :cases conj c))))
|
||||
(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]
|
||||
;; (log (format "Remembering case `%s`, feature `%s`, value `%s`"
|
||||
;; case-id feature-id value))
|
||||
(cond
|
||||
(boolean? value) (swap! !kb assoc-in
|
||||
[:cases case-id :knowledge feature-id :value] value)
|
||||
(map? value) (swap! !kb assoc-in
|
||||
[:cases case-id :knowledge feature-id] value)
|
||||
:else (throw (ex-info "Unexpected value?" {:case-id case-id
|
||||
:feature-id feature-id
|
||||
:value value})))
|
||||
value)
|
||||
|
||||
(defn persist [filepath]
|
||||
(let [p (if (empty? filepath) "kb.edn" filepath)]
|
||||
;; (info (format "Persisting knowledge base with %d cases, %d features to `%s`"
|
||||
;; (count (:cases @!kb)) (count (:features @!kb)) filepath))
|
||||
(spit p (with-out-str (pprint @!kb)))))
|
||||
|
||||
(defn restore [filepath]
|
||||
(let [p (if (empty? filepath) "kb.edn" filepath)
|
||||
kb (read-string (slurp p))]
|
||||
(if (satisfies? Kb kb) (reset! !kb kb)
|
||||
;; (info (format "Read knowledge base with %d cases, %d features from `%s`"
|
||||
;; (count (:cases kb)) (count (:features kb)) filepath))
|
||||
(if (satisfies? KB kb) (reset! !kb kb)
|
||||
(throw (ex-info "Not a knowledge base?" {:filepath filepath
|
||||
:kb kb
|
||||
:type (type kb)})))))
|
||||
|
|
@ -1,12 +1,81 @@
|
|||
(ns arboretum.dengine.node
|
||||
(:require [arboretum.dengine.protocols :refer [Node]]
|
||||
[clojure.spec.alpha :as spec]))
|
||||
(:require
|
||||
[arboretum.dengine.kb :refer [!kb]]
|
||||
[arboretum.dengine.protocols :refer [Feature Node]]
|
||||
[clojure.string :as string]))
|
||||
|
||||
(defrecord NodeImpl [children ^Boolean colour feature ^String fragment]
|
||||
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" (:feature this))
|
||||
(fragment ^String [this] "The explanation fragment at this node")
|
||||
(evaluate [this case-id] )
|
||||
)
|
||||
(fragment ^String [this] "The explanation fragment at this node"
|
||||
(:fragment this))
|
||||
(evaluate [this case-id]
|
||||
(let [c (-> !kb .cases case-id)
|
||||
f (if (satisfies? Feature (:feature this)) (:feature this)
|
||||
(-> !kb .features (:feature this)))
|
||||
value (:value (.knowledge !kb c f))]
|
||||
(when
|
||||
value (if
|
||||
(empty? (:children this))
|
||||
;; If my feature value is true, and I have no
|
||||
;; children, return my colour and my fragment
|
||||
{:value (:colour this)
|
||||
:authority :rule
|
||||
:reason (:fragment this)}
|
||||
;; but if I have some children...
|
||||
(first (remove nil? (map #(.evaluate % c)
|
||||
(:children this)))))))))
|
||||
|
||||
|
||||
;; 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
|
||||
;; one error in it. My memory is that Peter felt real Interlisp wasn't
|
||||
;; sufficiently academic to publish in an academic paper, so he translated
|
||||
;; it into an 'idealised' Lisp, for which no implementation existed.
|
||||
;; However this was based on my Interlisp code, and, as we no longer have
|
||||
;; that, is the best we can currently do.
|
||||
;;
|
||||
;; I have to say, given this is certainly based on my code, it was a long
|
||||
;; time ago and I'm not proud of it.
|
||||
;;
|
||||
;; (DSearch (object feature)
|
||||
;; (LOCAL (node nodesToDo newNodes children stickNodes)
|
||||
;; (SET ’nodesToDo (LIST (GET feature ’dTreeRootNode))
|
||||
;; ;; {origin of the DTree}
|
||||
;; (SET ’stickNodes NIL)
|
||||
;; (LOOP
|
||||
;; (UNTIL (EMPTY? nodesToDo))
|
||||
;; {if no more to do, exit loop}
|
||||
;; (SET’node (POP nodesToDo))
|
||||
;; (SET’children (GET node ’children))
|
||||
;; {get a node from nodesToDo and obtain its children. ..}
|
||||
;; (SET’newNodes NIL)
|
||||
;; ;; {..the children that can be accessed will be newNodes}
|
||||
;; (LOOP
|
||||
;; (UNTIL (EMPTY? children))
|
||||
;; ;; {if all children have been done, exit this loop}
|
||||
;; (SET child (POP children))
|
||||
;; ;; {get the next child}
|
||||
;; (IF (EQUAL
|
||||
;; (DecideFeat
|
||||
;; object
|
||||
;; (GET child 'feature))
|
||||
;; Yes)
|
||||
;; ;; {Run the system to discover whether the feature of the child node is
|
||||
;; ;; true of object}
|
||||
;; (SET newNodes
|
||||
;; (APPEND child newNodes))))
|
||||
;; ;; {..if it is then the node can be accessed and is added to newNodes,
|
||||
;; ;; and loop}
|
||||
;; (IF (EMPTY? newNodes)
|
||||
;; (SET ’stickNodes
|
||||
;; (PUSH child stickNodes))
|
||||
;; {if no new nodes were added the child is a stickNode}
|
||||
;; (ELSE (PUSH newNodes nodesToDo)))))
|
||||
;; ;; {otherwise the newNodes must themselves be examined for
|
||||
;; ;; stickNodes}
|
||||
;; (RETURN (Decide stickNodes))
|
||||
;; {finally, make a decision on the basis of the stickNodes found}
|
||||
|
||||
|
|
|
|||
|
|
@ -10,14 +10,14 @@
|
|||
(defprotocol Case
|
||||
"A case to be decided. It represents an object-in-the-world about
|
||||
which knowledge may be held and enquiries may be made."
|
||||
(id ^Keyword [this] "Returns the `:id` of this case.")
|
||||
(name ^String [this] "Returns the name associated with this case")
|
||||
(knowledge ^APersistentMap [this] "Returns a map whose keys are ids of features
|
||||
and whose values are the values of those
|
||||
features in this case.")
|
||||
(is? ^Boolean [this feature-id] "Returns `true` if feature-id true of `this`,
|
||||
`false` if it's definitely not true, and
|
||||
`nil` if its truth value is unknown."))
|
||||
(authority [this feature-id] "Returns information about how the value of the
|
||||
feature identified be `feature-id` is known
|
||||
about `this` case.
|
||||
|
||||
At this stage, one of the keywords `:default`,
|
||||
`:inference`, `:user`.")
|
||||
(case-id ^Keyword [this] "Returns the `:case-id` of this case.")
|
||||
(case-name ^String [this] "Returns the name associated with this case"))
|
||||
|
||||
(defmacro case?
|
||||
"Return `true` if this `obj` appears to be a valid case.
|
||||
|
|
@ -28,29 +28,42 @@
|
|||
`(satisfies? Case ~obj))
|
||||
|
||||
(defprotocol Feature
|
||||
"A feature has three essential elements: a proposition, a default value, and
|
||||
a method of decision"
|
||||
(decide ^Boolean [this case] "Returns the default value of my proposition for this `case`.
|
||||
"A feature has three essential elements: a proposition, a default
|
||||
value, and a method of decision"
|
||||
(decide ^Boolean [this case] "Returns the default value of my
|
||||
proposition for this `case`.
|
||||
|
||||
`case` should be either an object which satisfies the `Case`
|
||||
protocol or else a keyword, in which case it should be the
|
||||
`case` should be either an object which
|
||||
satisfies the `Case` protocol or else a
|
||||
keyword, in which case it should be the
|
||||
key of some case in the global `kb`.")
|
||||
;; it would be a sensible addition for Feature have an additional slot for
|
||||
;; a decision function other than a DTree, so that a value could be fetched
|
||||
;; from some algorithmic or online source. But Cedar didn't have this and
|
||||
;; I am currently just reimplementing Cedar.
|
||||
(default ^Boolean [this] "Returns the default value of my proposition")
|
||||
(id ^Keyword [this] "Returns a keywordised representation of the proposition of this feature")
|
||||
(proposition ^String [this] "Returns the proposition associated with this feature")
|
||||
(rootnode [this] "Returns the root node of the dtree for this feature, if one exists, else `nil`"))
|
||||
(feature-id ^Keyword [this] "Returns a keywordised representation of the proposition
|
||||
of this feature")
|
||||
(rootnode [this] "Returns the root node of the dtree for this feature, if one
|
||||
exists, else `nil`")
|
||||
(proposition ^String [this] "Returns the proposition associated with this
|
||||
feature"))
|
||||
|
||||
(defmacro feature?
|
||||
[obj]
|
||||
`(satisfies? Feature ~obj))
|
||||
|
||||
(defprotocol Kb
|
||||
;; "The knowledge base"
|
||||
(get-case ^APersistentMap [this ^Keyword id]
|
||||
(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 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 `:id`")
|
||||
"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`")
|
||||
|
|
@ -58,13 +71,24 @@
|
|||
"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?"))
|
||||
by `case-or-id`? If feature is undecided for this case, return `nil`.")
|
||||
(knowledge ^APersistentMap [this case-or-id feature-or-id]
|
||||
"Return whatever is currently known for this `case-or-id` about this
|
||||
`feature-or-id`. If the feature is undecided for this case, return
|
||||
`nil`."))
|
||||
|
||||
(defprotocol Node
|
||||
"A node in a DTree"
|
||||
;; potentially add a field for `authority`, the authority for this (part of
|
||||
;; the) rule. But, version Cedar didn't have this -- this is really a
|
||||
;; Wildwood feature, and what I'm trying to do here is reimplement Cedar.
|
||||
(children [this] "The children of this node")
|
||||
(colour ^Boolean [this] "The colour of this node")
|
||||
(feature [this] "The feature at this node")
|
||||
(fragment ^String [this] "The explanation fragment at this node")
|
||||
(evaluate [this case-id] "evaluate this node in the context of the case identified by `case-id`.")
|
||||
(explain [this case-id] "return an explanation from this node or its children for the case identified by `case-id`"))
|
||||
(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`.")
|
||||
(explain [this case-id] "return an explanation from this node or its children
|
||||
for the case identified by `case-id`"))
|
||||
|
|
@ -1,17 +1,17 @@
|
|||
(ns arboretum.dengine.utils
|
||||
(:require
|
||||
[clojure.string :refer [lower-case replace]])
|
||||
[clojure.string :as s :refer [lower-case replace]])
|
||||
(:import
|
||||
[clojure.lang PersistentHashSet]))
|
||||
|
||||
(defn string->keyword
|
||||
"Produce a keyword based on this `s`. If `others` are supplied, the return
|
||||
value will be different from any of those others."
|
||||
([^String s]
|
||||
(let [x (replace
|
||||
(replace (lower-case s) #"[^]a-z0-9- ]" "")
|
||||
([^String x]
|
||||
(let [x' (s/replace
|
||||
(s/replace (s/lower-case x) #"[^]a-z0-9- ]" "")
|
||||
#" " "-")]
|
||||
(keyword (if (empty? x) (gensym) x))))
|
||||
(keyword (if (empty? x') (gensym) x'))))
|
||||
([^String s ^PersistentHashSet others]
|
||||
(let [c (string->keyword s)]
|
||||
(if (others c) (keyword (gensym (name c))) c))))
|
||||
|
|
|
|||
|
|
@ -1,20 +1,43 @@
|
|||
(ns dengine.feature-test
|
||||
(:require [clojure.test :refer [deftest is testing]]
|
||||
[arboretum.dengine.feature :refer :all])
|
||||
(:import [arboretum.dengine.feature FeatureImpl]))
|
||||
(:require
|
||||
[arboretum.dengine.core :refer [add-case! add-feature!]]
|
||||
[arboretum.dengine.kb :refer [!kb]]
|
||||
[clojure.pprint :refer [pprint]]
|
||||
[clojure.test :refer [deftest is testing]])
|
||||
(:import
|
||||
[arboretum.dengine.kb KBImpl]))
|
||||
|
||||
(def testkb (KBImpl. {}
|
||||
{}))
|
||||
|
||||
(reset! !kb testkb)
|
||||
|
||||
|
||||
(deftest feature-impl-test
|
||||
(testing "Testing feature implementation"
|
||||
(let [f (FeatureImpl. "Is entitled to Widow's 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
|
||||
{: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"}})]
|
||||
(pprint {:f f
|
||||
:c c})
|
||||
(let [expected :is-entitled-to-widows-allowance
|
||||
actual (.id f)]
|
||||
actual (.feature-id f)]
|
||||
(is (= actual expected)))
|
||||
(let [expected false
|
||||
actual (.default f)]
|
||||
(is (= actual expected)))
|
||||
(let [expected false
|
||||
actual (.decide f {})]
|
||||
(is (= actual expected) "If we have no knoledge and no decision method, take the defualt."))
|
||||
(let [expected false
|
||||
actual (.decide f {:is-entitled-to-widows-benefit true})]
|
||||
(is (= actual expected) "If we have knoledge, return it.")))))
|
||||
actual (.decide f c)]
|
||||
(is (= actual expected) "If we have no knowledge and no decision method, take the defualt."))
|
||||
(let [expected true
|
||||
actual (.decide (add-feature! "Married" :married false nil) :case_1)]
|
||||
(is (= actual expected) "If we have knowledge, return it."))))
|
||||
)
|
||||
|
|
@ -1,17 +1,30 @@
|
|||
(ns dengine.kb-test
|
||||
(:require [clojure.test :refer [deftest is testing]]
|
||||
arboretum.dengine.case
|
||||
arboretum.dengine.feature
|
||||
[arboretum.dengine.kb :refer :all])
|
||||
(:import [arboretum.dengine.case CaseImpl]
|
||||
[arboretum.dengine.feature FeatureImpl]
|
||||
(:require
|
||||
[arboretum.dengine.core :refer [add-case!]]
|
||||
[arboretum.dengine.kb :refer :all]
|
||||
[clojure.pprint :refer [pprint]]
|
||||
[clojure.test :refer [deftest is testing]])
|
||||
(:import
|
||||
[arboretum.dengine.kb KBImpl]))
|
||||
|
||||
(def testkb (KBImpl. [(CaseImpl. :case_1 "Mrs Nora Trellis" {:married true :divorced false})]
|
||||
[(FeatureImpl. "is entitled to Widow's Benefit" false nil)]))
|
||||
(def testkb (KBImpl. {}
|
||||
{}))
|
||||
|
||||
(pprint testkb)
|
||||
|
||||
(reset! !kb testkb)
|
||||
|
||||
(add-case! "Mrs Nora Trellis" :case_1
|
||||
{: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"}})
|
||||
|
||||
(deftest access-test
|
||||
(testing "Accessing knowledge in the knowledge base"
|
||||
(let [expected nil
|
||||
|
|
@ -22,5 +35,4 @@
|
|||
(is (= actual expected)))
|
||||
(let [expected false
|
||||
actual (.is? testkb :case_1 :divorced)]
|
||||
(is (= actual expected)))
|
||||
))
|
||||
(is (= actual expected)))))
|
||||
Loading…
Reference in a new issue