Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Sorted coll Fressian handler fixes #228

Merged
merged 1 commit into from
Oct 17, 2016
Merged

Sorted coll Fressian handler fixes #228

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
100 changes: 62 additions & 38 deletions src/main/clojure/clara/rules/durability.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -401,60 +401,84 @@
:activation-group-fn
:alphas-fn))))

(defn create-default-get-alphas-fn [rulebase]
(@#'com/create-get-alphas-fn type ancestors rulebase))
(def ^:private create-get-alphas-fn @#'com/create-get-alphas-fn)

(defn- opts->get-alphas-fn [rulebase opts]
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't think this is quite right either, and is unnecessarily complex. How about

(defn opts->get-alphas-fn [rulebase opts]
       (let [fact-type-fn (or (:fact-type-fn opts) type)
              ancestors-fn (or (:ancestors-fn opts) ancestors)]
       (create-get-alphas-fn fact-type-fn ancestors-fn rulebase)))

Currently this doesn't allow the user to specify the ancestors-fn without overriding the fact-type-fn as well. More generally, I don't think we need to intermingle the "default or override" selection logic with the call to actually create the get-alphas-fn; doing so just creates unnecessary complexity.

Copy link
Collaborator Author

@mrrodriguez mrrodriguez Oct 17, 2016 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yeah, you're right. I think it is unlikely to override one and not the other, but obviously possible.
Either way, the implementation like what you are saying here makes more sense. I just didn't put enough thought into this part since it wasn't a usage I was concerned with.

I'll push the change soon.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

They are pushed now.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

+1

(let [fact-type-fn (:fact-type-fn opts type)
ancestors-fn (:ancestors-fn opts ancestors)]
(create-get-alphas-fn fact-type-fn
ancestors-fn
rulebase)))

(defn assemble-restored-session
"Builds a Clara session from the given rulebase and memory components.
"Builds a Clara session from the given rulebase and memory components. When no memory is given a new
one is created with all of the defaults of eng/local-memory.
Note! This function should not typically be used. It is left public to assist in ISessionSerializer
durability implementations. Use clara.rules/mk-session typically to make rule sessions.

Options can be provided via opts.
These include:

* :fact-type-fn
* :ancestors-fn
* :activation-group-sort-fn
* :activation-group-fn
* :get-alphas-fn

If the options are not provided, they will default to the Clara session defaults.
These are all described in detail in clara.rules/mk-session docs.

Note! Currently this only supports the clara.rules.memory.PersistentLocalMemory implementation
of memory."
[rulebase memory opts]
(let [opts (-> opts
(assoc :rulebase rulebase)
;; Right now activation fns do not serialize.
(update :activation-group-sort-fn
#(eng/options->activation-group-sort-fn {:activation-group-sort-fn %}))
(update :activation-group-fn
#(eng/options->activation-group-fn {:activation-group-fn %}))
;; TODO: Memory doesn't seem to ever need this or use it. Can we just remove it from memory?
(update :get-alphas-fn
#(or % (create-default-get-alphas-fn rulebase))))

{:keys [listeners transport get-alphas-fn]} opts

memory-opts (select-keys opts
#{:rulebase
:activation-group-sort-fn
:activation-group-fn
:get-alphas-fn})

transport (or transport (clara.rules.engine.LocalTransport.))
listeners (or listeners [])

memory (-> memory
(merge memory-opts)
;; Naming difference for some reason.
(set/rename-keys {:get-alphas-fn :alphas-fn})
mem/map->PersistentLocalMemory)]

(eng/assemble {:rulebase rulebase
:memory memory
:transport transport
:listeners listeners
:get-alphas-fn get-alphas-fn})))
([rulebase opts]
(let [opts (assoc opts
:rulebase
rulebase
:get-alphas-fn
(opts->get-alphas-fn rulebase opts))
{:keys [listeners transport get-alphas-fn]} opts]

(eng/assemble {:rulebase rulebase
:memory (eng/local-memory rulebase
(clara.rules.engine.LocalTransport.)
(eng/options->activation-group-sort-fn opts)
(eng/options->activation-group-fn opts)
;; TODO: Memory doesn't seem to ever need this or use
;; it. Can we just remove it from memory?
get-alphas-fn)
:transport (or transport (clara.rules.engine.LocalTransport.))
:listeners (or listeners [])
:get-alphas-fn get-alphas-fn})))

([rulebase memory opts]
(let [opts (-> opts
(assoc :rulebase
rulebase
;; Right now get alphas fn does not serialize.
:get-alphas-fn
(opts->get-alphas-fn rulebase opts))
;; Right now activation fns do not serialize.
(update :activation-group-sort-fn
#(eng/options->activation-group-sort-fn {:activation-group-sort-fn %}))
(update :activation-group-fn
#(eng/options->activation-group-fn {:activation-group-fn %})))

{:keys [listeners transport get-alphas-fn]} opts

memory-opts (select-keys opts
#{:rulebase
:activation-group-sort-fn
:activation-group-fn
:get-alphas-fn})]

(eng/assemble {:rulebase rulebase
:memory (-> memory
(merge memory-opts)
;; Naming difference for some reason.
(set/rename-keys {:get-alphas-fn :alphas-fn})
mem/map->PersistentLocalMemory)
:transport (or transport (clara.rules.engine.LocalTransport.))
:listeners (or listeners [])
:get-alphas-fn get-alphas-fn}))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Serialization protocols.
Expand Down
31 changes: 24 additions & 7 deletions src/main/clojure/clara/rules/durability/fressian.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -255,32 +255,49 @@
:writer (reify WriteHandler
(write [_ w o]
(let [cname (d/sorted-comparator-name o)]
(.writeTag w "clj/treeset" 2)
(.writeTag w "clj/treeset" 3)
(if cname
(.writeObject w cname true)
(.writeNull w))
;; Preserve metadata.
(if-let [m (meta o)]
(.writeObject w m)
(.writeNull w))
(.writeList w o))))
:readers {"clj/treeset"
(reify ReadHandler
(read [_ rdr tag component-count]
(let [c (some-> rdr .readObject resolve deref)]
(d/seq->sorted-set (.readObject rdr) c))))}}

(let [c (some-> rdr .readObject resolve deref)
m (.readObject rdr)
s (-> (.readObject rdr)
(d/seq->sorted-set c))]
(if m
(with-meta s m)
s))))}}

"clj/treemap"
{:class clojure.lang.PersistentTreeMap
:writer (reify WriteHandler
(write [_ w o]
(let [cname (d/sorted-comparator-name o)]
(.writeTag w "clj/treemap" 2)
(.writeTag w "clj/treemap" 3)
(if cname
(.writeObject w cname true)
(.writeNull w))
;; Preserve metadata.
(if-let [m (meta o)]
(.writeObject w m)
(.writeNull w))
(write-map w o))))
:readers {"clj/treemap"
(reify ReadHandler
(read [_ rdr tag component-count]
(let [c (some-> rdr .readObject resolve deref)]
(d/seq->sorted-map (.readObject rdr) c))))}}
(let [c (some-> rdr .readObject resolve deref)
m (.readObject rdr)
s (d/seq->sorted-map (.readObject rdr) c)]
(if m
(with-meta s m)
s))))}}

"clj/mapentry"
{:class clojure.lang.MapEntry
Expand Down
142 changes: 131 additions & 11 deletions src/test/clojure/clara/test_durability.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -78,15 +78,8 @@
"expected fact: " expected-fact \newline
"fact: " fact \newline)))))))

(defn durability-test
"Test runner to run different implementations of d/ISessionSerializer."
[serde-type]
(let [s (mk-session 'clara.durability-rules)

;; Testing identity relationships on the IWorkingMemorySerializer facts received to serialize.
;; So this is a little weird, but we want to know the exact object identity of even these
;; "primitive" values.
mci "MCI"
(defn session-test [s]
(let [mci "MCI"
lax "LAX"
san "SAN"
chi "CHI"
Expand Down Expand Up @@ -119,7 +112,66 @@
cold-res (query fired dr/cold-temp)
hot-res (query fired dr/hot-temp)
temp-his-res (query fired dr/temp-his)
temps-under-thresh-res (query fired dr/temps-under-thresh)
temps-under-thresh-res (query fired dr/temps-under-thresh)]
{:all-objs [mci
lax
san
chi
irk
ten
twenty
fifty
forty
thirty
thresh50
temp50
temp40
temp30
temp20
ws50
ws40
ws10]
:fired-session fired
:query-results {:unpaired-res unpaired-res
:cold-res cold-res
:hot-res hot-res
:temp-his-res temp-his-res
:temps-under-thresh-res temps-under-thresh-res}}))

(defn durability-test
"Test runner to run different implementations of d/ISessionSerializer."
[serde-type]
(let [s (mk-session 'clara.durability-rules)
results (session-test s)
;; Testing identity relationships on the IWorkingMemorySerializer facts received to serialize.
;; So this is a little weird, but we want to know the exact object identity of even these
;; "primitive" values.
[mci
lax
san
chi
irk
ten
twenty
fifty
forty
thirty
thresh50
temp50
temp40
temp30
temp20
ws50
ws40
ws10] (:all-objs results)

fired (:fired-session results)

{:keys [unpaired-res
cold-res
hot-res
temp-his-res
temps-under-thresh-res]} (:query-results results)

create-serializer (fn [stream]
;; Currently only one.
Expand Down Expand Up @@ -254,4 +306,72 @@
(check-fact expected-fact fact)))))))

(deftest test-durability-fressian-serde
(durability-test :fressian))
(testing "SerDe of the rulebase along with working memory"
(durability-test :fressian))

(testing "Repeated SerDe of rulebase"
(let [rb-serde (fn [s]
(with-open [baos (java.io.ByteArrayOutputStream.)]
(d/serialize-rulebase s (df/create-session-serializer baos))
(let [rb-data (.toByteArray baos)]
(with-open [bais (java.io.ByteArrayInputStream. rb-data)]
(d/deserialize-rulebase (df/create-session-serializer bais))))))

s (mk-session 'clara.durability-rules)
rb (-> s eng/components :rulebase)
deserialized1 (rb-serde s)
;; Need a session to do the 2nd round of SerDe.
restored1 (d/assemble-restored-session deserialized1 {})
deserialized2 (rb-serde restored1)
restored2 (d/assemble-restored-session deserialized2 {})

init-qresults (:query-results (session-test s))
restored-qresults1 (:query-results (session-test restored1))
restored-qresults2 (:query-results (session-test restored2))]

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

So test-durability-fressian-serde tests the functional correctness via queries and assertions on their results, and this just does the same thing as test-durability-fressian-serde, adds another iteration of SerDe, and validates that the query results didn't change, correct? That should work to test this.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes. Obviously it doesn't test total correctness of the session or anything, but gives reasonable confidence since the results end up coming out the same after inserting the test facts, firing, and querying.

The working memory style test uses this same test, but takes it a step further and checks the object-identity found within the query results etc.

(is (= init-qresults
restored-qresults1
restored-qresults2)))))

(deftest test-assemble-restored-session-opts
(let [orig (mk-session 'clara.durability-rules)

test-assemble (fn [rulebase memory]
(let [activation-group-fn-called? (volatile! false)
activation-group-sort-fn-called? (volatile! false)
fact-type-fn-called? (volatile! false)
ancestors-fn-called? (volatile! false)

opts {:activation-group-fn (fn [x]
(vreset! activation-group-fn-called? true)
(or (some-> x :props :salience)
0))
:activation-group-sort-fn (fn [x y]
(vreset! activation-group-sort-fn-called? true)
(> x y))
:fact-type-fn (fn [x]
(vreset! fact-type-fn-called? true)
(type x))
:ancestors-fn (fn [x]
(vreset! ancestors-fn-called? true)
(ancestors x))}

restored (if memory
(d/assemble-restored-session rulebase memory opts)
(d/assemble-restored-session rulebase opts))]

(is (= (:query-results (session-test orig))
(:query-results (session-test restored))))

(is (true? @activation-group-sort-fn-called?))
(is (true? @activation-group-fn-called?))
(is (true? @fact-type-fn-called?))
(is (true? @ancestors-fn-called?))))

{:keys [rulebase memory]} (eng/components orig)]

(testing "restoring without given memory"
(test-assemble rulebase nil))

(testing "restoring with memory"
(test-assemble rulebase memory))))
Loading