Issue #402: [performance] Remove usage of get-in in compiled rules (#404

)

src/main/clojure/clara/rules/compiler.clj

@@ -384,10 +384,16 @@
              ~'?__bindings__ (atom ~initial-bindings)]
          ~(compile-constraints constraints)))))
 
+(defn build-token-assignment
+  "A helper function to build variable assignment forms for tokens."
+  [binding-key]
+  (list (symbol (name binding-key))
+        (list `-> '?__token__ :bindings binding-key)))
+
 ;; FIXME: add env...
 (defn compile-test [tests]
   (let [binding-keys (variables-as-keywords tests)
-        assignments (mapcat #(list (symbol (name %)) (list 'get-in '?__token__ [:bindings %])) binding-keys)]
+        assignments (mapcat build-token-assignment binding-keys)]
 
     `(fn [~'?__token__]
        (let [~@assignments]
@@ -407,8 +413,8 @@
 
         assignments (sequence
                      (comp
-                      (filter rhs-bindings-used)
-                      (mapcat #(list (symbol (name %)) (list '-> '?__token__ :bindings %))))
+                       (filter rhs-bindings-used)
+                       (mapcat build-token-assignment))
                      binding-keys)
 
         ;; The destructured environment, if any.
@@ -462,9 +468,7 @@
         ;; created element bindings for this condition removed.
         token-binding-keys (remove element-bindings (variables-as-keywords constraints))
 
-        token-assignments (mapcat #(list (symbol (name %))
-                                         (list 'get-in '?__token__ [:bindings %]))
-                                  token-binding-keys)
+        token-assignments (mapcat build-token-assignment token-binding-keys)
 
         new-binding-assignments (mapcat #(list (symbol (name %))
                                                (list 'get '?__element-bindings__ %))

src/main/clojure/clara/tools/testing_utils.cljc

@@ -8,11 +8,13 @@
                [clara.rules.update-cache.cancelling :as ca]
                [clara.rules.compiler :as com]
                [clara.macros :as m]
-               [clara.rules.dsl :as dsl]))
+               [clara.rules.dsl :as dsl]
+               [clojure.test :refer [is]]))
    :cljs
    (ns clara.tools.testing-utils
      (:require [clara.rules.update-cache.core :as uc])
-     (:require-macros clara.tools.testing-utils)))
+     (:require-macros [clara.tools.testing-utils]
+       [cljs.test :refer [is]])))
 
 #?(:clj
    (defmacro def-rules-test
@@ -99,3 +101,54 @@
   (reset! side-effect-holder nil)
   (t)
   (reset! side-effect-holder nil))
+
+#?(:clj
+   (defn time-execution
+     [func]
+     (let [start (System/currentTimeMillis)
+           _ (func)
+           stop (System/currentTimeMillis)]
+       (- stop start)))
+   :cljs
+   (defn time-execution
+     [func]
+     (let [start (.getTime (js/Date.))
+           _ (func)
+           stop (.getTime (js/Date.))]
+       (- stop start))))
+
+(defn execute-tests
+  [func iterations]
+  (let [execution-times (for [_ (range iterations)]
+                          (time-execution func))
+        sum #(reduce + %)
+        mean (/ (sum execution-times) iterations)
+        std (->
+              (into []
+                    (comp
+                      (map #(- % mean))
+                      (map #(Math/pow (double %) 2.0)))
+                    execution-times)
+              sum
+              (/ iterations)
+              Math/sqrt)]
+    {:std (double std)
+     :mean (double mean)}))
+
+(defn run-performance-test
+  "Created as a rudimentary alternative to criterium, due to assumptions made during benchmarking. Specifically, that
+   criterium attempts to reach a steady state of compiled and loaded classes. This fundamentally doesn't work when the
+   metrics needed rely on compilation or evaluation."
+  [form]
+  (let [{:keys [description func iterations mean-assertion verbose]} form
+        {:keys [std mean]} (execute-tests func iterations)]
+    (when verbose
+      (println (str \newline "Running Performance tests for:"))
+      (println description)
+      (println "==========================================")
+      (println (str "Mean: " mean "ms"))
+      (println (str "Standard Deviation: " std "ms" \newline)))
+    (is (mean-assertion mean)
+        (str "Actual mean value: " mean))
+    {:mean mean
+     :std std}))

src/test/clojure/clara/performance/test_compilation.clj

@@ -4,53 +4,14 @@
             [clara.rules :as r]
             [clara.rules.durability :as dura]
             [clara.rules.durability.fressian :as fres]
-            [clara.rules.accumulators :as acc])
+            [clara.rules.accumulators :as acc]
+            [clara.tools.testing-utils :as utils])
   (:import [java.io ByteArrayOutputStream ByteArrayInputStream]))
 
 (defn filter-fn
   [seed-keyword]
   (= seed-keyword (keyword (gensym))))
 
-(defn time-execution
-  [func]
-  (let [start (System/currentTimeMillis)
-        _ (func)
-        stop (System/currentTimeMillis)]
-    (- stop start)))
-
-(defn execute-tests
-  [func iterations]
-  (let [execution-times (for [_ (range iterations)]
-                          (time-execution func))
-        sum #(reduce + %)
-        mean (/ (sum execution-times) iterations)
-        std (->
-              (into []
-                    (comp
-                      (map #(- % mean))
-                      (map #(Math/pow (double %) 2.0)))
-                    execution-times)
-              sum
-              (/ iterations)
-              Math/sqrt)]
-    {:std (double std)
-     :mean (double mean)}))
-
-(defn run-performance-test
-  "Created as a rudimentary alternative to criterium, due to assumptions made during benchmarking. Specifically, that
-   criterium attempts to reach a steady state of compiled and loaded classes. This fundamentally doesn't work when the
-   metrics needed rely on compilation or evaluation."
-  [form]
-  (let [{:keys [description func iterations mean-assertion]} form
-        {:keys [std mean]} (execute-tests func iterations)]
-    (println (str \newline "Running Performance tests for:"))
-    (println description)
-    (println "==========================================")
-    (println (str "Mean: " mean "ms"))
-    (println (str "Standard Deviation: " std "ms" \newline))
-    (is (mean-assertion mean)
-        (str "Actual mean value: " mean))))
-
 (def base-production
   {:ns-name (symbol (str *ns*))})
 
@@ -129,7 +90,7 @@
 (deftest compilation-performance-test
   (let [rules (generate-rules-and-opts 500)]
     (testing "Session creation performance"
-      (run-performance-test
+      (utils/run-performance-test
         {:description "Generated Session Compilation"
          :func #(com/mk-session rules)
          :iterations 50
@@ -138,7 +99,7 @@
     (let [session (com/mk-session rules)
           os (ByteArrayOutputStream.)]
       (testing "Session rulebase serialization performance"
-        (run-performance-test
+        (utils/run-performance-test
           {:description "Session rulebase serialization"
            :func #(dura/serialize-rulebase
                     session
@@ -152,7 +113,7 @@
           (fres/create-session-serializer os))
 
         (let [session-bytes (.toByteArray os)]
-          (run-performance-test
+          (utils/run-performance-test
             {:description "Session rulebase deserialization"
              :func #(dura/deserialize-rulebase
                       (fres/create-session-serializer (ByteArrayInputStream. session-bytes)))

src/test/clojurescript/clara/test.cljs

@@ -19,7 +19,8 @@
             [clara.test-simple-rules]
             [clara.test-rhs-retract]
             [clara.test-bindings]
-            [clara.test-clear-ns-productions]))
+            [clara.test-clear-ns-productions]
+            [clara.performance.test-rule-execution]))
 
 (enable-console-print!)
 
@@ -54,5 +55,6 @@
                     'clara.test-simple-rules
                     'clara.test-rhs-retract
                     'clara.test-bindings
-                    'clara.test-clear-ns-productions)
+                    'clara.test-clear-ns-productions
+                    'clara.performance.test-rule-execution)
     @*successful?*))

src/test/common/clara/performance/test_rule_execution.cljc

@@ -0,0 +1,42 @@
+(ns clara.performance.test-rule-execution
+  (:require [clara.rules.accumulators :as acc]
+            [clara.rules :as r]
+    #?(:clj
+            [clojure.test :refer :all]
+       :cljs [cljs.test :refer-macros [is deftest]])
+    #?(:clj
+            [clara.tools.testing-utils :refer [def-rules-test run-performance-test]]
+       :cljs [clara.tools.testing-utils :refer [run-performance-test]]))
+  #?(:cljs (:require-macros [clara.tools.testing-utils :refer [def-rules-test]])))
+
+(defrecord AFact [id])
+(defrecord BFact [id])
+(defrecord ParentFact [a-id b-id])
+
+(def counter (atom {:a-count 0
+                    :b-count 0}))
+
+(def number-of-facts #?(:clj 1500 :cljs 150))
+
+(def-rules-test test-get-in-perf
+  {:rules [rule [[[?parent <- ParentFact]
+                  [?as <- (acc/all) :from [AFact (= (:a-id ?parent) id)]]
+                  [?bs <- (acc/all) :from [BFact (= (:b-id ?parent) id)]]]
+                 '(do (swap! counter update :a-count inc))]]
+   :sessions [session [rule] {}]}
+  (let [parents (for [x (range number-of-facts)]
+                  (->ParentFact x (inc x)))
+        a-facts (for [id (range number-of-facts)]
+                  (->AFact id))
+        b-facts (for [id (range number-of-facts)]
+                  (->BFact id))
+
+        facts (doall (concat parents
+                             a-facts
+                             b-facts))]
+    (run-performance-test {:description "Slow get-in perf"
+                           :func #(-> session
+                                      (r/insert-all facts)
+                                      r/fire-rules)
+                           :iterations 5
+                           :mean-assertion (partial > 10000)})))

src/test/common/clara/test_testing_utils.cljc

@@ -1,6 +1,7 @@
 #?(:clj
    (ns clara.test-testing-utils
-     (:require [clara.tools.testing-utils :refer [def-rules-test]]
+     (:require [clara.tools.testing-utils :refer [def-rules-test
+                                                  run-performance-test]]
                [clara.rules :as r]
 
                [clara.rules.testfacts :refer [->Temperature ->Cold]]
@@ -14,7 +15,8 @@
      (:require [clara.rules :as r]
                [clara.rules.testfacts :refer [->Temperature Temperature
                                               ->Cold Cold]]
-               [cljs.test :as t])
+               [cljs.test :as t]
+               [clara.tools.testing-utils :refer [run-performance-test]])
      (:require-macros [clara.tools.testing-utils :refer [def-rules-test]]
                       [cljs.test :refer (is deftest run-tests)])))
 
@@ -54,3 +56,18 @@
                   (r/insert (->Temperature -50 "MCI"))
                   r/fire-rules
                   (r/query query1)))))
+
+(def fire-rules-counter (atom 0))
+
+(def-rules-test test-performance-test
+  {:rules [rule1 [[[?t <- Temperature (< temperature 0)]]
+                  (swap! fire-rules-counter inc)]]
+   :queries []
+   :sessions [session1 [rule1] {}]}
+  (run-performance-test {:description "Simple fire-rules demonstration"
+                         :func #(-> session1
+                                    (r/insert (->Temperature -50 "MCI"))
+                                    r/fire-rules)
+                         :iterations 5
+                         :mean-assertion (partial > 500)})
+  (is (= @fire-rules-counter 5)))