├── .clj-kondo └── config.edn ├── package.json ├── src ├── test │ ├── html │ │ ├── advanced.html │ │ └── simple.html │ ├── clojure │ │ └── clara │ │ │ ├── order_ruleset.clj │ │ │ ├── sample_ruleset_seq.clj │ │ │ ├── other_ruleset.clj │ │ │ ├── generative │ │ │ ├── test_generators.clj │ │ │ ├── generators.clj │ │ │ └── test_accum.clj │ │ │ ├── sample_ruleset.clj │ │ │ ├── long_running_tests.clj │ │ │ ├── durability_rules.clj │ │ │ ├── test_java.clj │ │ │ ├── test_java_facts.clj │ │ │ ├── test_compiler.clj │ │ │ ├── test_fressian.clj │ │ │ └── performance │ │ │ └── test_compilation.clj │ ├── js │ │ └── runner.js │ ├── java │ │ └── clara │ │ │ └── test │ │ │ └── facts │ │ │ └── BeanTestFact.java │ ├── common │ │ └── clara │ │ │ ├── rule_defs.cljc │ │ │ ├── performance │ │ │ └── test_rule_execution.cljc │ │ │ ├── test_rules_require.cljc │ │ │ ├── test_rhs_retract.cljc │ │ │ ├── test_queries.cljc │ │ │ ├── test_performance_optimizations.cljc │ │ │ ├── test_testing_utils.cljc │ │ │ ├── test_clear_ns_productions.cljc │ │ │ ├── test_common.cljc │ │ │ ├── tools │ │ │ ├── test_fact_graph.cljc │ │ │ └── test_tracing.cljc │ │ │ ├── test_exists.cljc │ │ │ ├── test_simple_rules.cljc │ │ │ └── test_memory.cljc │ └── clojurescript │ │ └── clara │ │ ├── test.cljs │ │ ├── test_complex_negation.cljs │ │ ├── test_salience.cljs │ │ └── test_rules.cljs └── main │ ├── java │ └── clara │ │ └── rules │ │ ├── QueryResult.java │ │ ├── package-info.java │ │ ├── RuleLoader.java │ │ └── WorkingMemory.java │ └── clojure │ └── clara │ ├── rules │ ├── testfacts.cljc │ ├── update_cache │ │ ├── core.cljc │ │ └── cancelling.clj │ ├── java.clj │ ├── test_rules_data.clj │ ├── platform.cljc │ ├── listener.cljc │ ├── schema.cljc │ └── accumulators.cljc │ └── tools │ ├── internal │ └── inspect.cljc │ ├── loop_detector.cljc │ ├── fact_graph.cljc │ └── tracing.cljc ├── .gitignore ├── resources └── public │ └── index.html ├── NOTICE ├── clj-kondo └── clj-kondo.exports │ └── clara │ └── rules │ └── config.edn ├── CONTRIBUTORS.md ├── RELEASE.md ├── .github └── workflows │ └── clojure.yml ├── SECURITY.md ├── CONTRIBUTING.md ├── README.md └── project.clj /.clj-kondo/config.edn: -------------------------------------------------------------------------------- 1 | {:config-paths ["../clj-kondo/clj-kondo.exports/clara/rules"]} 2 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "devDependencies": { 3 | "puppeteer": "^22.11.2" 4 | } 5 | } 6 | -------------------------------------------------------------------------------- /src/test/html/advanced.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /src/test/html/simple.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | /resources/public/js/* 6 | pom.xml 7 | pom.xml.asc 8 | *.jar 9 | *.class 10 | .lein-deps-sum 11 | .lein-failures 12 | .lein-plugins 13 | .lein-repl-history 14 | figwheel_server.log 15 | *.*~ 16 | .idea/* 17 | *.iml 18 | .clj-kondo 19 | .lsp 20 | node_modules/* -------------------------------------------------------------------------------- /src/main/java/clara/rules/QueryResult.java: -------------------------------------------------------------------------------- 1 | package clara.rules; 2 | 3 | import java.util.List; 4 | 5 | /** 6 | * Result of a Clara query. This is typically returned in 7 | * a list of results from the working memory. 8 | */ 9 | public interface QueryResult { 10 | 11 | /** 12 | * Returns the object matching the field specified in the query. 13 | */ 14 | public Object getResult(String fieldName); 15 | } 16 | -------------------------------------------------------------------------------- /resources/public/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
10 |

Figwheel template

11 |

Checkout your developer console.

12 |
13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /NOTICE: -------------------------------------------------------------------------------- 1 | Copyright 2016 Cerner Innovation, Inc. 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | -------------------------------------------------------------------------------- /clj-kondo/clj-kondo.exports/clara/rules/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {clara.rules/defsession clojure.core/def 2 | clara.rules.platform/eager-for clojure.core/for} 3 | :hooks {:analyze-call {clara.rules/defquery hooks.clara-rules/analyze-defquery-macro 4 | clara.rules/defrule hooks.clara-rules/analyze-defrule-macro 5 | clara.rules.dsl/parse-query hooks.clara-rules/analyze-parse-query-macro 6 | clara.rules.dsl/parse-rule hooks.clara-rules/analyze-parse-rule-macro 7 | clara.tools.testing-utils/def-rules-test hooks.clara-rules/analyze-def-rules-test-macro}}} 8 | -------------------------------------------------------------------------------- /src/test/clojure/clara/order_ruleset.clj: -------------------------------------------------------------------------------- 1 | (ns clara.order-ruleset 2 | (:use clara.rules 3 | clara.rules.testfacts) 4 | (:refer-clojure :exclude [==]) 5 | (:import [clara.rules.testfacts 6 | Temperature 7 | WindSpeed 8 | Cold 9 | ColdAndWindy 10 | LousyWeather])) 11 | 12 | (def ^:dynamic *rule-order-atom* nil) 13 | 14 | (def ^{:dynamic true 15 | :production-seq true} 16 | *rule-seq-prior* []) 17 | 18 | (defrule rule-C 19 | [Cold (constantly true)] 20 | => 21 | (swap! *rule-order-atom* conj :C)) 22 | 23 | (defrule rule-D 24 | [Cold (constantly true)] 25 | => 26 | (swap! *rule-order-atom* conj :D)) 27 | 28 | (def ^{:dynamic true 29 | :production-seq true} 30 | *rule-seq-after* []) 31 | -------------------------------------------------------------------------------- /src/test/clojure/clara/sample_ruleset_seq.clj: -------------------------------------------------------------------------------- 1 | (ns clara.sample-ruleset-seq 2 | "This namespace contains all productions in clara.sample-ruleset, but instead of containing them 3 | in individual rule and query structures they are contained in a seq that is marked as containing a sequence 4 | of productions. This namespace exists so that tests can validate the functionality of scanning namespaces for 5 | rule sequences as discussed in https://github.com/cerner/clara-rules/issues/134" 6 | (:require [clara.sample-ruleset])) 7 | 8 | (def ^:production-seq all-rules (->> (ns-interns 'clara.sample-ruleset) 9 | vals 10 | (filter #((some-fn :rule :query) (meta %))) 11 | (map deref) 12 | doall)) 13 | -------------------------------------------------------------------------------- /src/test/clojure/clara/other_ruleset.clj: -------------------------------------------------------------------------------- 1 | (ns clara.other-ruleset 2 | (:use clara.rules 3 | clara.rules.testfacts) 4 | (:refer-clojure :exclude [==]) 5 | (:import [clara.rules.testfacts 6 | Temperature 7 | WindSpeed 8 | Cold 9 | ColdAndWindy 10 | LousyWeather])) 11 | 12 | (defrule is-lousy 13 | (ColdAndWindy (= temperature 15)) 14 | => 15 | (insert! (->LousyWeather))) 16 | 17 | ;;; These rules are used for unit testing loading from a namespace. 18 | (defquery subzero-locations 19 | "Query the subzero locations." 20 | [] 21 | (Temperature (< temperature 0) (== ?loc location))) 22 | 23 | (defquery temp-by-location 24 | "Query temperatures by location." 25 | [:?loc] 26 | (Temperature (== ?temp temperature) 27 | (== ?loc location))) 28 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /src/test/clojure/clara/generative/test_generators.clj: -------------------------------------------------------------------------------- 1 | (ns clara.generative.test-generators 2 | (:require 3 | [clara.generative.generators :refer :all] 4 | [clojure.test :refer :all] 5 | [schema.test])) 6 | 7 | (use-fixtures :once schema.test/validate-schemas) 8 | 9 | ;; Basic sanity test of the insert/retract/fire permutation generation. 10 | (deftest test-basic-permutations 11 | (let [base-ops [{:type :insert 12 | :facts [:a]}] 13 | permuted-ops (ops->permutations base-ops {:dup-level 1})] 14 | (is (= (set permuted-ops) 15 | #{[{:type :insert, :facts [:a]}] 16 | [{:type :insert, :facts [:a]} 17 | {:type :insert, :facts [:a]} 18 | {:type :retract, :facts [:a]}] 19 | [{:type :insert, :facts [:a]} 20 | {:type :retract, :facts [:a]} 21 | {:type :insert, :facts [:a]}]})))) 22 | -------------------------------------------------------------------------------- /CONTRIBUTORS.md: -------------------------------------------------------------------------------- 1 | Cerner Corporation 2 | 3 | - Ryan Brush [@rbrush] 4 | - Mike Rodriguez [@mrrodriguez] 5 | - William Parker [@WilliamParker] 6 | - Ethan Christian [@EthanEChristian] 7 | - Pushkar Kulkarni [@kulkarnipushkar] 8 | 9 | Community 10 | 11 | - David Goeke [@dgoeke] 12 | - Dave Dixon [@sparkofreason] 13 | - Baptiste Fontaine [@bfontaine] 14 | - Jose Gomez [@k13gomez] 15 | - Imre Kószó [@imrekoszo] 16 | 17 | [@rbrush]: https://github.com/rbrush 18 | [@mrrodriguez]: https://github.com/mrrodriguez 19 | [@WilliamParker]: https://github.com/WilliamParker 20 | [@EthanEChristian]: https://github.com/EthanEChristian 21 | [@kulkarnipushkar]: https://github.com/kulkarnipushkar 22 | [@dgoeke]: https://github.com/dgoeke 23 | [@sparkofreason]: https://github.com/sparkofreason 24 | [@bfontaine]: https://github.com/bfontaine 25 | [@sunilgunisetty]: https://github.com/sunilgunisetty 26 | [@k13gomez]: https://github.com/k13gomez 27 | [@imrekoszo]: https://github.com/imrekoszo 28 | -------------------------------------------------------------------------------- /src/test/js/runner.js: -------------------------------------------------------------------------------- 1 | var puppeteer = require('puppeteer'); 2 | 3 | if (process.argv.length !== 3) { 4 | console.log('Expected a target URL parameter.'); 5 | process.exit(1); 6 | } 7 | 8 | (async () => { 9 | const browser = await puppeteer.launch({ headless: true }); // Launch headless Chrome 10 | const page = await browser.newPage(); // Create a new page 11 | 12 | // test html file 13 | var url = 'file://' + process.cwd() + '/' + process.argv[2]; 14 | 15 | await page.goto(url); 16 | 17 | page.on('console', async (msg) => { 18 | const msgArgs = msg.args(); 19 | for (let i = 0; i < msgArgs.length; ++i) { 20 | console.log(await msgArgs[i].jsonValue()); 21 | } 22 | }); 23 | 24 | var success = await page.evaluate(() => { 25 | return clara.test.run(); 26 | }) 27 | 28 | await browser.close(); 29 | 30 | return success; 31 | })().then(success => 32 | { 33 | if (success){ 34 | process.exit(0); 35 | } else { 36 | process.exit(1); 37 | } 38 | }) 39 | 40 | 41 | 42 | 43 | 44 | -------------------------------------------------------------------------------- /src/main/clojure/clara/rules/testfacts.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.rules.testfacts 2 | "This namespace exists primary for testing purposes, working around the fact that we cannot AOT compile test classes. This should be moved to the tests once a workaround for this is solved.") 3 | 4 | ;; Reflection against records requires them to be compiled AOT, so we temporarily 5 | ;; place them here as leiningen won't AOT compile test resources. 6 | (defrecord Temperature [temperature location]) 7 | (defrecord WindSpeed [windspeed location]) 8 | (defrecord Cold [temperature]) 9 | (defrecord Hot [temperature]) 10 | (defrecord ColdAndWindy [temperature windspeed]) 11 | (defrecord LousyWeather []) 12 | (defrecord TemperatureHistory [temperatures]) 13 | 14 | 15 | ;; Test facts for chained rules. 16 | (defrecord First []) 17 | (defrecord Second []) 18 | (defrecord Third []) 19 | (defrecord Fourth []) 20 | 21 | ;; Record utilizing clj flexible field names. 22 | (defrecord FlexibleFields [it-works? 23 | a->b 24 | x+y 25 | bang!]) 26 | -------------------------------------------------------------------------------- /src/main/java/clara/rules/package-info.java: -------------------------------------------------------------------------------- 1 | /** 2 | * The Java API for working Clara rules. It contains three simple pieces: 3 | * 4 | * 9 | * 10 | *

11 | * Note this API does not have a separate "knowledge base" class like those of other rules engines. Instead, 12 | * the user can simply create and reuse a single, empty WorkingMemory object for multiple rule instances -- optionally 13 | * sticking the initial empty working memory in a static variable. This type of pattern is efficient and possible 14 | * since the WorkingMemory is immutable, creating a new instance that shares internal state when changes occur. 15 | *

16 | * 17 | * See the Clara Examples 18 | * project for an example of this in action. 19 | */ 20 | package clara.rules; 21 | -------------------------------------------------------------------------------- /src/main/clojure/clara/rules/update_cache/core.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.rules.update-cache.core) 2 | 3 | ;; Record indicating pending insertion or removal of a sequence of facts. 4 | (defrecord PendingUpdate [type facts]) 5 | 6 | ;; This is expected to be used while activating rules in a given salience group 7 | ;; to store updates before propagating those updates to the alpha nodes as a group. 8 | (defprotocol UpdateCache 9 | (add-insertions! [this facts]) 10 | (add-retractions! [this facts]) 11 | (get-updates-and-reset! [this])) 12 | 13 | ;; This cache replicates the behavior prior to https://github.com/cerner/clara-rules/issues/249, 14 | ;; just in a stateful object rather than a persistent data structure. 15 | (deftype OrderedUpdateCache [updates] 16 | 17 | UpdateCache 18 | 19 | (add-insertions! [this facts] 20 | (swap! updates into [(->PendingUpdate :insert facts)])) 21 | 22 | (add-retractions! [this facts] 23 | (swap! updates into [(->PendingUpdate :retract facts)])) 24 | 25 | (get-updates-and-reset! [this] 26 | (let [current-updates @updates] 27 | (reset! updates []) 28 | (partition-by :type current-updates)))) 29 | 30 | (defn get-ordered-update-cache 31 | [] 32 | (OrderedUpdateCache. (atom []))) 33 | -------------------------------------------------------------------------------- /RELEASE.md: -------------------------------------------------------------------------------- 1 | # How to Release 2 | 3 | This project is hosted on [Clojars][clojars]. You can see it [here][release-site]. 4 | 5 | Releasing the project requires these steps: 6 | 7 | 0. Assert all tests are passing and the project builds : `lein do clean, test` 8 | 1. Make sure CHANGELOG.md is up-to-date for the upcoming release. 9 | 2. Assert you have Github setup with [gpg](https://docs.github.com/en/authentication/managing-commit-signature-verification/adding-a-gpg-key-to-your-github-account) 10 | 3. Add gpg key to [sign](https://git-scm.com/book/en/v2/Git-Tools-Signing-Your-Work) your commits 11 | * GPG will likely require an additional export to spawn an interactive prompt for signing: 12 | ```export GPG_TTY=$(tty)``` 13 | 4. Create a [Clojars][clojars] Account and [Deploy Token](https://github.com/clojars/clojars-web/wiki/Deploy-Tokens) if you do not already have one. 14 | 5. Create a lein [credentials](https://leiningen.org/deploy.html#gpg) file using the account and token above. 15 | 6. Run `lein release `, where release-type is one of `:patch`,`:minor` and `:major` 16 | 7. Push the new main branch to the repo. 17 | 8. Push the new tag to the repo. 18 | 19 | [clojars]: https://clojars.org 20 | [release-site]: https://clojars.org/com.cerner/clara-rules 21 | 22 | -------------------------------------------------------------------------------- /src/test/clojure/clara/sample_ruleset.clj: -------------------------------------------------------------------------------- 1 | (ns clara.sample-ruleset 2 | (:use clara.rules 3 | clara.rules.testfacts 4 | clojure.pprint 5 | clara.rules.dsl) 6 | (:refer-clojure :exclude [==]) 7 | (:import [clara.rules.testfacts 8 | Temperature 9 | WindSpeed 10 | Cold 11 | ColdAndWindy 12 | LousyWeather])) 13 | 14 | 15 | ;;; These rules are used for unit testing loading from a namespace. 16 | (defquery freezing-locations 17 | "Query the freezing locations." 18 | [] 19 | (Temperature (< temperature 32) (== ?loc location))) 20 | 21 | (defrule is-cold-and-windy 22 | "Rule to determine whether it is indeed cold and windy." 23 | 24 | (Temperature (< temperature 20) (== ?t temperature)) 25 | (WindSpeed (> windspeed 30) (== ?w windspeed)) 26 | => 27 | (insert! (->ColdAndWindy ?t ?w))) 28 | 29 | (defquery find-cold-and-windy 30 | [] 31 | (?fact <- ColdAndWindy)) 32 | 33 | (defquery find-lousy-weather 34 | [] 35 | (?fact <- LousyWeather)) 36 | 37 | (comment 38 | freezing-locations 39 | 40 | ;; Example usage: 41 | (-> (mk-session 'clara.sample-ruleset) 42 | (insert (->Temperature 10 "KC") 43 | (->WindSpeed 40 "KC")) 44 | (fire-rules) 45 | (query find-cold-and-windy))) 46 | -------------------------------------------------------------------------------- /.github/workflows/clojure.yml: -------------------------------------------------------------------------------- 1 | name: Clojure CI 2 | 3 | on: 4 | push: 5 | branches: [ "main" ] 6 | pull_request: 7 | branches: [ "main" ] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | steps: 13 | - uses: actions/checkout@v3 14 | - name: Setup Java JDK 15 | uses: actions/setup-java@v1.4.4 16 | with: 17 | # The Java version to make available on the path. Takes a whole or semver Java version, or 1.x syntax (e.g. 1.8 => Java 8.x). Early access versions can be specified in the form of e.g. 14-ea, 14.0.0-ea, or 14.0.0-ea.28 18 | java-version: 1.8 19 | - name: Setup Node.js environment 20 | uses: actions/setup-node@v2.5.2 21 | with: 22 | # Version Spec of the version to use. Examples: 12.x, 10.15.1, >=10.15.0 23 | node-version: 18.16.0 24 | - name: Install Puppeteer 25 | run: npm install puppeteer 26 | - name: Install Chrome 27 | run: npx puppeteer browsers install chrome 28 | - name: Install dependencies 29 | run: lein deps 30 | - name: Run tests 31 | run: lein test 32 | - name: Run generative tests 33 | run: lein test :generative 34 | - name: Run recent-clj tests 35 | run: lein with-profile dev,recent-clj test 36 | - name: Run clj-kondo linter 37 | run: lein with-profile dev,recent-clj clj-kondo-lint 38 | -------------------------------------------------------------------------------- /src/main/java/clara/rules/RuleLoader.java: -------------------------------------------------------------------------------- 1 | package clara.rules; 2 | 3 | import clojure.lang.IFn; 4 | import clojure.lang.RT; 5 | import clojure.lang.Symbol; 6 | import clojure.lang.Var; 7 | 8 | /** 9 | * Clara rule loader. Produces a {@link WorkingMemory WorkingMemory} given one or more Clojure 10 | * namespaces containing rules. 11 | */ 12 | public class RuleLoader { 13 | 14 | /** 15 | * The clojure require function. 16 | */ 17 | static final IFn require = RT.var("clojure.core", "require"); 18 | 19 | /** 20 | * Function to make a new Clara session. 21 | */ 22 | static final IFn makeSession; 23 | 24 | static { 25 | 26 | require.invoke(Symbol.intern("clara.rules.java")); 27 | 28 | makeSession = RT.var("clara.rules.java", "mk-java-session"); 29 | } 30 | 31 | /** 32 | * Returns a new working memory with rules loaded from the given namespaces. 33 | * 34 | * @param namespaces namespaces from which to load rules 35 | * @return an empty working memory with rules from the given namespaces. 36 | */ 37 | public static WorkingMemory loadRules(String... namespaces) { 38 | 39 | // Ensure requested namespaces are loaded. 40 | for (String namespace: namespaces) 41 | require.invoke(Symbol.intern(namespace)); 42 | 43 | // Create a new working memory. 44 | return (WorkingMemory) makeSession.invoke(namespaces); 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /src/test/java/clara/test/facts/BeanTestFact.java: -------------------------------------------------------------------------------- 1 | package clara.test.facts; 2 | 3 | /** 4 | * A Java Pojo for the express purpose of testing the behavior of compilation and execution of rules. 5 | * 6 | * This class should not be included in the released artifact, if it did make it into a released artifact it should be 7 | * ignored and not consumed as it may be moved/removed without warning to consumers. 8 | */ 9 | public class BeanTestFact { 10 | private String[] locations; 11 | private String[] roadConditions; 12 | 13 | public BeanTestFact(String[] locations) { 14 | this.locations = locations; 15 | } 16 | 17 | // Standard and Indexed property accessors 18 | public void setLocations(String[] locations) { 19 | this.locations = locations; 20 | } 21 | public String[] getLocations() { 22 | return locations; 23 | } 24 | public void setLocations(int pos, String location) { 25 | locations[pos] = location; 26 | } 27 | public String getLocations(int pos){ 28 | return locations[pos]; 29 | } 30 | 31 | // Partial Indexed property accessor, ie. no standard accessor 32 | // See https://github.com/cerner/clara-rules/issues/446 for more details 33 | public void setRoadConditions(int pos, String condition) { 34 | roadConditions[pos] = condition; 35 | } 36 | public String getRoadConditions(int pos){ 37 | return roadConditions[pos]; 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /src/test/clojure/clara/long_running_tests.clj: -------------------------------------------------------------------------------- 1 | (ns clara.long-running-tests 2 | (:require [clojure.test :refer :all] 3 | [clara.rules.compiler :as com] 4 | [schema.core :as sc])) 5 | 6 | (deftest test-maximum-forms-per-eval 7 | ;; 5472 to ensure that we have enough forms to create a full batch, see clara.rules.compiler/forms-per-eval-default 8 | ;; or Issue 381 for more info 9 | (let [rules (for [_ (range 5472) 10 | :let [fact-type (keyword (gensym))]] 11 | {:ns-name (ns-name *ns*) 12 | :lhs [{:type fact-type 13 | :constraints []}] 14 | :rhs `(println ~(str fact-type))}) 15 | rules-and-opts (conj (vector rules) :forms-per-eval 5472 :cache false) 16 | 17 | e (try 18 | ;; Not validating schema here because it will be very expensive 19 | (sc/without-fn-validation (com/mk-session rules-and-opts)) 20 | (is false "Max batching size should have been exceeded, and exception thrown") 21 | (catch Exception e e))] 22 | 23 | ;; Validating that there were 5472 forms in the eval call. 24 | (is (= 5472 (count (-> e ex-data :compilation-ctxs)))) 25 | (is (re-find #"method size exceeded" (.getMessage e))) 26 | 27 | ;; Validate that the stated 5471 forms per eval will compile 28 | (is (sc/without-fn-validation (com/mk-session (conj (vector rules) :forms-per-eval 5471 :cache false)))))) -------------------------------------------------------------------------------- /src/test/common/clara/rule_defs.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.rule-defs 2 | (:require [clara.rules.accumulators :as acc] 3 | [clara.rules.testfacts :as tf] 4 | [clara.tools.testing-utils :as tu] 5 | #?(:clj [clara.rules :refer [defrule defquery insert!]]) 6 | #?(:cljs [clara.rules :refer-macros [defrule defquery] :refer [insert!]])) 7 | #?(:clj 8 | (:import [clara.rules.testfacts Temperature WindSpeed ColdAndWindy]))) 9 | 10 | ;; Rule definitions used for tests in clara.test-rules-require. 11 | 12 | (defrule test-rule 13 | [?t <- #?(:clj Temperature :cljs tf/Temperature) (< temperature 20)] 14 | => 15 | (reset! tu/side-effect-holder ?t)) 16 | 17 | (defquery cold-query 18 | [] 19 | [#?(:clj Temperature :cljs tf/Temperature) (< temperature 20) (== ?t temperature)]) 20 | 21 | ;; Accumulator for getting the lowest temperature. 22 | (def lowest-temp (acc/min :temperature)) 23 | 24 | (defquery coldest-query 25 | [] 26 | [?t <- lowest-temp :from [#?(:clj Temperature :cljs tf/Temperature)]]) 27 | 28 | (defrule is-cold-and-windy 29 | "Rule to determine whether it is indeed cold and windy." 30 | 31 | (#?(:clj Temperature :cljs tf/Temperature) (< temperature 20) (== ?t temperature)) 32 | (#?(:clj WindSpeed :cljs tf/WindSpeed) (> windspeed 30) (== ?w windspeed)) 33 | => 34 | (insert! (tf/->ColdAndWindy ?t ?w))) 35 | 36 | (defquery find-cold-and-windy 37 | [] 38 | [?fact <- #?(:clj ColdAndWindy :cljs tf/ColdAndWindy)]) 39 | 40 | -------------------------------------------------------------------------------- /SECURITY.md: -------------------------------------------------------------------------------- 1 | # Reporting security vulnerabilities 2 | 3 | Oracle values the independent security research community and believes that 4 | responsible disclosure of security vulnerabilities helps us ensure the security 5 | and privacy of all our users. 6 | 7 | Please do NOT raise a GitHub Issue to report a security vulnerability. If you 8 | believe you have found a security vulnerability, please submit a report to 9 | [secalert_us@oracle.com][1] preferably with a proof of concept. Please review 10 | some additional information on [how to report security vulnerabilities to Oracle][2]. 11 | We encourage people who contact Oracle Security to use email encryption using 12 | [our encryption key][3]. 13 | 14 | We ask that you do not use other channels or contact the project maintainers 15 | directly. 16 | 17 | Non-vulnerability related security issues including ideas for new or improved 18 | security features are welcome on GitHub Issues. 19 | 20 | ## Security updates, alerts and bulletins 21 | 22 | Security updates will be released on a regular cadence. Many of our projects 23 | will typically release security fixes in conjunction with the 24 | Oracle Critical Patch Update program. Additional 25 | information, including past advisories, is available on our [security alerts][4] 26 | page. 27 | 28 | ## Security-related information 29 | 30 | We will provide security related information such as a threat model, considerations 31 | for secure use, or any known security issues in our documentation. Please note 32 | that labs and sample code are intended to demonstrate a concept and may not be 33 | sufficiently hardened for production use. 34 | 35 | [1]: mailto:secalert_us@oracle.com 36 | [2]: https://www.oracle.com/corporate/security-practices/assurance/vulnerability/reporting.html 37 | [3]: https://www.oracle.com/security-alerts/encryptionkey.html 38 | [4]: https://www.oracle.com/security-alerts/ 39 | -------------------------------------------------------------------------------- /src/main/clojure/clara/rules/java.clj: -------------------------------------------------------------------------------- 1 | (ns clara.rules.java 2 | "This namespace is for internal use and may move in the future. 3 | Java support. Users should use the Java API, or the clara.rules namespace from Clojure." 4 | (:require [clara.rules :as clara] 5 | [clara.rules.engine :as eng] 6 | [clara.rules.compiler :as com] 7 | [clara.rules.memory :as mem]) 8 | (:refer-clojure :exclude [==]) 9 | (:import [clara.rules.engine LocalTransport] 10 | [clara.rules WorkingMemory QueryResult])) 11 | 12 | (deftype JavaQueryResult [result] 13 | QueryResult 14 | (getResult [_ fieldName] 15 | (get result (keyword fieldName))) 16 | Object 17 | (toString [_] 18 | (.toString result))) 19 | 20 | (defn- run-query [session name args] 21 | (let [query-var (or (resolve (symbol name)) 22 | (throw (IllegalArgumentException. 23 | (str "Unable to resolve symbol to query: " name)))) 24 | 25 | ;; Keywordize string keys from Java. 26 | keyword-args (into {} 27 | (for [[k v] args] 28 | [(keyword k) v])) 29 | results (eng/query session (deref query-var) keyword-args)] 30 | (map #(JavaQueryResult. %) results))) 31 | 32 | (deftype JavaWorkingMemory [session] 33 | WorkingMemory 34 | 35 | (insert [this facts] 36 | (JavaWorkingMemory. (apply clara/insert session facts))) 37 | 38 | (retract [this facts] 39 | (JavaWorkingMemory. (apply clara/retract session facts))) 40 | 41 | (fireRules [this] 42 | (JavaWorkingMemory. (clara/fire-rules session))) 43 | 44 | (query [this name args] 45 | (run-query session name args)) 46 | 47 | (query [this name] 48 | (run-query session name {}))) 49 | 50 | (defn mk-java-session [rulesets] 51 | (JavaWorkingMemory. 52 | (com/mk-session (map symbol rulesets)))) 53 | -------------------------------------------------------------------------------- /src/main/clojure/clara/rules/test_rules_data.clj: -------------------------------------------------------------------------------- 1 | ;;; This namespace exists for testing purposes only, and is temporarily plac.d under src/main/clojure/clara 2 | ;;; due to issues with the CLJS test environment. Move te test/common/clara when this issue is resolved 3 | ;;; and tests can be compiled and run with this file in that location. 4 | ;;; See issue #288 for further info (https://github.com/cerner/clara-rules/issues/388). 5 | 6 | (ns clara.rules.test-rules-data 7 | (:require [clara.rules] 8 | [clara.rules.testfacts] 9 | [clara.rules.compiler :as com])) 10 | 11 | (def the-rules 12 | [{:doc "Rule to determine whether it is indeed cold and windy." 13 | :name "clara.rules.test-rules-data/is-cold-and-windy-data" 14 | :lhs [{:type (if (com/compiling-cljs?) 'clara.rules.testfacts/Temperature 'clara.rules.testfacts.Temperature) 15 | :constraints '[(< temperature 20) 16 | (== ?t temperature)]} 17 | {:type (if (com/compiling-cljs?) 'clara.rules.testfacts/WindSpeed 'clara.rules.testfacts.WindSpeed) 18 | :constraints '[(> windspeed 30) 19 | (== ?w windspeed)]}] 20 | :rhs '(clara.rules/insert! (clara.rules.testfacts/->ColdAndWindy ?t ?w))} 21 | 22 | {:name "clara.rules.test-rules-data/find-cold-and-windy-data" 23 | :lhs [{:fact-binding :?fact 24 | :type (if (com/compiling-cljs?) 'clara.rules.testfacts/ColdAndWindy 'clara.rules.testfacts.ColdAndWindy) 25 | :constraints []}] 26 | :params #{}}]) 27 | 28 | (defn weather-rules 29 | "Return some weather rules" 30 | [] 31 | the-rules) 32 | 33 | (def the-rules-with-keyword-names (mapv #(update % :name keyword) the-rules)) 34 | 35 | (defn weather-rules-with-keyword-names 36 | "Return some weather rules using keyword names" 37 | [] 38 | the-rules-with-keyword-names) -------------------------------------------------------------------------------- /src/test/common/clara/performance/test_rule_execution.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.performance.test-rule-execution 2 | (:require [clara.rules.accumulators :as acc] 3 | [clara.rules :as r] 4 | #?(:clj 5 | [clojure.test :refer :all] 6 | :cljs [cljs.test :refer-macros [is deftest]]) 7 | #?(:clj 8 | [clara.tools.testing-utils :refer [def-rules-test run-performance-test]] 9 | :cljs [clara.tools.testing-utils :refer [run-performance-test]])) 10 | #?(:cljs (:require-macros [clara.tools.testing-utils :refer [def-rules-test]]))) 11 | 12 | (defrecord AFact [id]) 13 | (defrecord BFact [id]) 14 | (defrecord ParentFact [a-id b-id]) 15 | 16 | (def counter (atom {:a-count 0 17 | :b-count 0})) 18 | 19 | (def number-of-facts #?(:clj 1500 :cljs 150)) 20 | 21 | (def-rules-test test-get-in-perf 22 | {:rules [rule [[[?parent <- ParentFact] 23 | [?as <- (acc/all) :from [AFact (= (:a-id ?parent) id)]] 24 | [?bs <- (acc/all) :from [BFact (= (:b-id ?parent) id)]]] 25 | '(do (swap! counter update :a-count inc))]] 26 | :sessions [session [rule] {}]} 27 | (let [parents (for [x (range number-of-facts)] 28 | (->ParentFact x (inc x))) 29 | a-facts (for [id (range number-of-facts)] 30 | (->AFact id)) 31 | b-facts (for [id (range number-of-facts)] 32 | (->BFact id)) 33 | 34 | facts (doall (concat parents 35 | a-facts 36 | b-facts))] 37 | (run-performance-test {:description "Slow get-in perf" 38 | :func #(-> session 39 | (r/insert-all facts) 40 | r/fire-rules) 41 | :iterations 5 42 | :mean-assertion (partial > 10000)}))) -------------------------------------------------------------------------------- /src/main/java/clara/rules/WorkingMemory.java: -------------------------------------------------------------------------------- 1 | package clara.rules; 2 | 3 | import java.util.List; 4 | import java.util.Map; 5 | 6 | /** 7 | * An immutable working memory of Clara rules. 8 | */ 9 | public interface WorkingMemory { 10 | 11 | /** 12 | * Returns a new working memory with the given facts inserted 13 | * @param facts facts to insert into the working memory 14 | * @return a new working memory with the facts inserted 15 | */ 16 | public WorkingMemory insert(Iterable facts); 17 | 18 | /** 19 | * Returns a new working memory with the given facs retracted 20 | * @param facts facts to retract from the working memory 21 | * @return a new working memory with the facts retracted 22 | */ 23 | public WorkingMemory retract(Iterable facts); 24 | 25 | /** 26 | * Fires any pending rules in the working memory, and returns a new 27 | * working memory with the rules in a fired state. 28 | * 29 | * @return a new working memory with the rules in a fired state. 30 | */ 31 | public WorkingMemory fireRules(); 32 | 33 | /** 34 | * Runs the query by the given name against the working memory and returns the matching 35 | * results. Query names are structured as "namespace/name" 36 | * 37 | * @param queryName the name of the query to perform, formatted as "namespace/name". 38 | * @param arguments query arguments 39 | * @return a list of query results 40 | */ 41 | public Iterable query(String queryName, Map arguments); 42 | 43 | /** 44 | * Runs the query by the given name against the working memory and returns the matching 45 | * results. Query names are structured as "namespace/name" 46 | * 47 | * @param queryName the name of the query to perform, formatted as "namespace/name". 48 | * @return a list of query results 49 | */ 50 | public Iterable query(String queryName); 51 | } 52 | -------------------------------------------------------------------------------- /src/test/clojure/clara/durability_rules.clj: -------------------------------------------------------------------------------- 1 | (ns clara.durability-rules 2 | (:require [clara.rules :refer :all] 3 | [clara.rules.accumulators :as acc] 4 | [clara.rules.testfacts :refer :all]) 5 | (:import [clara.rules.testfacts 6 | Temperature 7 | WindSpeed 8 | Cold 9 | Hot 10 | TemperatureHistory])) 11 | 12 | (defrecord Threshold [v]) 13 | (defrecord TempsUnderThreshold [ts]) 14 | 15 | (defrule find-cold 16 | "Rule with no joins" 17 | [Temperature (= ?t temperature) (< temperature 30)] 18 | => 19 | (insert! (->Cold ?t))) 20 | 21 | (defrule find-hot 22 | "Rule using NegationWithJoinFilterNode" 23 | [Temperature (= ?t temperature)] 24 | [:not [Cold (>= temperature ?t)]] 25 | => 26 | (insert! (->Hot ?t))) 27 | 28 | (defrecord UnpairedWindSpeed [ws]) 29 | 30 | (defrule find-wind-speeds-without-temp 31 | "Rule using NegationNode" 32 | [?w <- WindSpeed 33 | ;; Empty constraint and a constraint containing an empty list to test serializing an EmptyList, 34 | ;; see Issue 352 for more information 35 | () 36 | (not= this ()) 37 | (= ?loc location)] 38 | [:not [Temperature (= ?loc location)]] 39 | => 40 | (insert! (->UnpairedWindSpeed ?w))) 41 | 42 | (defrule find-temps 43 | "Rule using AccumulateNode and TestNode" 44 | [?ts <- (acc/all) :from [Temperature]] 45 | [:test (not-empty ?ts)] 46 | => 47 | (insert! (->TemperatureHistory (mapv :temperature ?ts)))) 48 | 49 | (defrule find-temps-under-threshold 50 | "Rule using AccumulateWithJoinFilterNode" 51 | [Threshold (= ?v v)] 52 | [?ts <- (acc/all) :from [Temperature (< temperature ?v)]] 53 | => 54 | (insert! (->TempsUnderThreshold ?ts))) 55 | 56 | (defquery unpaired-wind-speed [] 57 | [?ws <- UnpairedWindSpeed]) 58 | 59 | (defquery cold-temp [] 60 | [?c <- Cold]) 61 | 62 | (defquery hot-temp [] 63 | [?h <- Hot]) 64 | 65 | (defquery temp-his [] 66 | [?his <- TemperatureHistory]) 67 | 68 | (defquery temps-under-thresh [] 69 | [?tut <- TempsUnderThreshold]) 70 | -------------------------------------------------------------------------------- /src/test/common/clara/test_rules_require.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.test-rules-require 2 | (:require [clara.tools.testing-utils :as tu] 3 | [clara.rule-defs :as rd] 4 | [clara.rules.testfacts :as facts] 5 | #?(:clj [clojure.test :refer [is deftest run-tests testing use-fixtures]]) 6 | #?(:cljs [cljs.test :refer-macros [is deftest run-tests testing use-fixtures]]) 7 | #?(:clj [clara.rules :refer [insert fire-rules query defsession]]) 8 | #?(:cljs [clara.rules :refer [insert fire-rules query] :refer-macros [defsession]]))) 9 | 10 | ;; Tests the case where rules/facts are required from a different namespace where the session is defined, 11 | ;; without an explicit :refer. 12 | ;; See https://github.com/cerner/clara-rules/issues/359 13 | 14 | (use-fixtures :each tu/side-effect-holder-fixture) 15 | 16 | (defsession my-session 'clara.rule-defs) 17 | 18 | (deftest test-simple-defrule 19 | (let [session (insert my-session (facts/->Temperature 10 "MCI"))] 20 | (fire-rules session) 21 | (is (= @tu/side-effect-holder (facts/->Temperature 10 "MCI"))))) 22 | 23 | (deftest test-simple-query 24 | (let [session (-> my-session 25 | (insert (facts/->Temperature 15 "MCI")) 26 | (insert (facts/->Temperature 10 "MCI")) 27 | (insert (facts/->Temperature 80 "MCI")) 28 | fire-rules)] 29 | 30 | ;; The query should identify all items that were inserted and matched the 31 | ;; expected criteria. 32 | (is (= #{{:?t 15} {:?t 10}} 33 | (set (query session rd/cold-query)))))) 34 | 35 | (deftest test-simple-accumulator 36 | (let [session (-> my-session 37 | (insert (facts/->Temperature 15 "MCI")) 38 | (insert (facts/->Temperature 10 "MCI")) 39 | (insert (facts/->Temperature 80 "MCI")) 40 | fire-rules)] 41 | 42 | ;; Accumulator returns the lowest value. 43 | (is (= #{{:?t 10}} 44 | (set (query session rd/coldest-query)))))) 45 | 46 | (deftest test-simple-insert 47 | (let [session (-> my-session 48 | (insert (facts/->Temperature 15 "MCI")) 49 | (insert (facts/->WindSpeed 45 "MCI")) 50 | (fire-rules))] 51 | 52 | (is (= #{{:?fact (facts/->ColdAndWindy 15 45)}} 53 | (set 54 | (query session rd/find-cold-and-windy)))))) 55 | 56 | -------------------------------------------------------------------------------- /src/test/clojure/clara/test_java.clj: -------------------------------------------------------------------------------- 1 | (ns clara.test-java 2 | (:use clojure.test 3 | clara.rules.testfacts) 4 | (:require [clara.sample-ruleset :as sample] 5 | [clara.other-ruleset :as other]) 6 | (:import [clara.rules.testfacts Temperature WindSpeed Cold ColdAndWindy LousyWeather First Second Third Fourth] 7 | [clara.rules QueryResult RuleLoader WorkingMemory])) 8 | 9 | (defn- java-namespace-args 10 | "The java API expects an arra of strings containing namespace names, so create that." 11 | [] 12 | (doto (make-array String 2) 13 | (aset 0 "clara.sample-ruleset") 14 | (aset 1 "clara.other-ruleset"))) 15 | 16 | (deftest simple-rule 17 | 18 | (let [;; Simulate use of a typical Javaland object, the array list. 19 | ;; Normally we'd just use the Clojure shorthand, but this is testing Java interop specifically 20 | facts (doto (java.util.ArrayList.) 21 | (.add (->Temperature 15 "MCI")) 22 | (.add (->Temperature 10 "BOS")) 23 | (.add (->Temperature 50 "SFO")) 24 | (.add (->Temperature -10 "CHI"))) 25 | 26 | ;; Testing Java interop, so session is a clara.rules.WorkingMemory object. 27 | session (-> (RuleLoader/loadRules (java-namespace-args)) 28 | (.insert facts) 29 | (.fireRules)) 30 | 31 | subzero-locs (.query session "clara.other-ruleset/subzero-locations" {}) 32 | freezing-locs (.query session "clara.sample-ruleset/freezing-locations" {})] 33 | 34 | (is (= #{"CHI"} 35 | (set (map #(.getResult % "?loc") subzero-locs)))) 36 | 37 | (is (= #{"CHI" "BOS" "MCI"} 38 | (set (map #(.getResult % "?loc") freezing-locs)))))) 39 | 40 | (deftest query-with-args 41 | (let [session 42 | (-> (RuleLoader/loadRules (java-namespace-args)) 43 | (.insert [(->Temperature 15 "MCI") 44 | (->Temperature 10 "BOS") 45 | (->Temperature 50 "SFO") 46 | (->Temperature -10 "CHI")]) 47 | (.fireRules)) 48 | 49 | ;; Simulate invocation from Java by creating a hashmap of arguments. 50 | java-args (doto (java.util.HashMap.) 51 | (.put "?loc" "CHI")) 52 | 53 | chicago-temp (.query session "clara.other-ruleset/temp-by-location" java-args)] 54 | 55 | (is (= #{-10} 56 | (set (map #(.getResult % "?temp") chicago-temp)))))) 57 | -------------------------------------------------------------------------------- /src/test/clojure/clara/test_java_facts.clj: -------------------------------------------------------------------------------- 1 | (ns clara.test-java-facts 2 | (:require [clara.tools.testing-utils :as tu] 3 | [clara.rules :as rules] 4 | [clojure.test :refer [is deftest run-tests testing use-fixtures]] 5 | [clara.rules.compiler :as com]) 6 | (:import [clara.test.facts 7 | BeanTestFact])) 8 | 9 | ;; A test to demonstrate that a Pojo with indexed property accessors can be used as an alpha root in a session, 10 | ;; see https://github.com/cerner/clara-rules/issues/446 11 | (tu/def-rules-test test-basic-rule 12 | {:rules [kansas-rule [[[BeanTestFact 13 | (= ?locs locations) 14 | (some #(= "Kansas" %) ?locs)]] 15 | (rules/insert! "Kansas Exists")]] 16 | :queries [string-query [[] [[?s <- String]]]] 17 | 18 | :sessions [empty-session [kansas-rule string-query] {}]} 19 | 20 | (let [locs (doto (make-array String 2) 21 | (aset 0 "Florida") 22 | (aset 1 "Kansas"))] 23 | (let [session-strings (map :?s 24 | (-> empty-session 25 | (rules/insert (BeanTestFact. locs)) 26 | (rules/fire-rules) 27 | (rules/query string-query)))] 28 | (is (= ["Kansas Exists"] session-strings))))) 29 | 30 | ;; Using an indexed property accessor that doesn't have a standard accessor will throw exception as clara cannot resolve 31 | ;; the usage of the accessor. See https://github.com/cerner/clara-rules/issues/446 32 | (deftest test-indexed-property-accessor 33 | (let [rule-using-unsupported-accessor {:ns-name (ns-name *ns*) 34 | :lhs [{:type BeanTestFact :constraints [`(contains? ~'roadConditions "Slippery")]}] 35 | :rhs `(rules/insert! "doesn't matter") 36 | :name "rule-using-unsupported-accessor"}] 37 | (try 38 | (com/mk-session [[rule-using-unsupported-accessor]]) 39 | (is false "An exception should be thrown") 40 | (catch Exception e 41 | (loop [exc e] 42 | (cond 43 | (re-find #"Failed compiling alpha node" (.getMessage exc)) 44 | :success 45 | 46 | (.getCause exc) 47 | (recur (.getCause exc)) 48 | 49 | :else 50 | (is false "Exception didn't contain a message containing alpha node failure"))))))) -------------------------------------------------------------------------------- /src/test/clojurescript/clara/test.cljs: -------------------------------------------------------------------------------- 1 | (ns clara.test 2 | (:require-macros [cljs.test :as test]) 3 | (:require [clara.test-rules] 4 | [clara.test-rules-require] 5 | [cljs.test] 6 | [clara.test-salience] 7 | [clara.test-complex-negation] 8 | [clara.test-common] 9 | [clara.test-testing-utils] 10 | [clara.test-accumulators] 11 | [clara.test-exists] 12 | [clara.tools.test-tracing] 13 | [clara.tools.test-fact-graph] 14 | [clara.tools.test-inspect] 15 | [clara.test-truth-maintenance] 16 | [clara.test-dsl] 17 | [clara.test-accumulation] 18 | [clara.test-memory] 19 | [clara.test-simple-rules] 20 | [clara.test-rhs-retract] 21 | [clara.test-bindings] 22 | [clara.test-clear-ns-productions] 23 | [clara.test-negation] 24 | [clara.performance.test-rule-execution] 25 | [clara.test-node-sharing] 26 | [clara.test-queries])) 27 | 28 | (enable-console-print!) 29 | 30 | (def ^:dynamic *successful?* nil) 31 | 32 | (defmethod cljs.test/report [:cljs.test/default :end-run-tests] [m] 33 | (if (cljs.test/successful? m) 34 | (do 35 | (println "Success!") 36 | (reset! *successful?* true)) 37 | (do 38 | (println "FAIL") 39 | (reset! *successful?* false)))) 40 | 41 | (defn ^:export run [] 42 | (binding [*successful?* (atom nil)] 43 | (test/run-tests 'clara.test-rules 44 | 'clara.test-rules-require 45 | 'clara.test-common 46 | 'clara.test-salience 47 | 'clara.test-testing-utils 48 | 'clara.test-complex-negation 49 | 'clara.test-accumulators 50 | 'clara.test-exists 51 | 'clara.tools.test-tracing 52 | 'clara.tools.test-fact-graph 53 | 'clara.tools.test-inspect 54 | 'clara.test-truth-maintenance 55 | 'clara.test-dsl 56 | 'clara.test-accumulation 57 | 'clara.test-memory 58 | 'clara.test-simple-rules 59 | 'clara.test-rhs-retract 60 | 'clara.test-bindings 61 | 'clara.test-clear-ns-productions 62 | 'clara.test-negation 63 | 'clara.performance.test-rule-execution 64 | 'clara.test-node-sharing 65 | 'clara.test-queries) 66 | @*successful?*)) 67 | -------------------------------------------------------------------------------- /src/test/common/clara/test_rhs_retract.cljc: -------------------------------------------------------------------------------- 1 | #?(:clj 2 | (ns clara.test-rhs-retract 3 | (:require [clara.tools.testing-utils :refer [def-rules-test] :as tu] 4 | [clara.rules :refer [fire-rules 5 | insert 6 | insert-all 7 | insert! 8 | retract 9 | query 10 | retract!]] 11 | 12 | [clara.rules.testfacts :refer [->Temperature ->Cold]] 13 | [clojure.test :refer [is deftest run-tests testing use-fixtures]] 14 | [clara.rules.accumulators] 15 | [schema.test :as st]) 16 | (:import [clara.rules.testfacts 17 | Temperature 18 | Cold])) 19 | 20 | :cljs 21 | (ns clara.test-rhs-retract 22 | (:require [clara.rules :refer [fire-rules 23 | insert 24 | insert! 25 | insert-all 26 | retract 27 | query 28 | retract!]] 29 | [clara.rules.testfacts :refer [->Temperature Temperature 30 | ->Cold Cold]] 31 | [clara.rules.accumulators] 32 | [cljs.test] 33 | [schema.test :as st]) 34 | (:require-macros [clara.tools.testing-utils :refer [def-rules-test]] 35 | [cljs.test :refer [is deftest run-tests testing use-fixtures]]))) 36 | 37 | (use-fixtures :once st/validate-schemas #?(:clj tu/opts-fixture)) 38 | 39 | (def-rules-test test-retract! 40 | 41 | {:rules [not-cold-rule [[[Temperature (> temperature 50)]] 42 | (retract! (->Cold 20))]] 43 | 44 | :queries [cold-query [[] 45 | [[Cold (= ?t temperature)]]]] 46 | 47 | :sessions [empty-session [not-cold-rule cold-query] {}]} 48 | 49 | (let [session (-> empty-session 50 | (insert (->Cold 20)) 51 | (fire-rules))] 52 | 53 | ;; The session should contain our initial cold reading. 54 | (is (= #{{:?t 20}} 55 | (set (query session cold-query)))) 56 | 57 | ;; Insert a higher temperature and ensure the cold fact was retracted. 58 | (is (= #{} 59 | (set (query (-> session 60 | (insert (->Temperature 80 "MCI")) 61 | (fire-rules)) 62 | cold-query)))))) 63 | -------------------------------------------------------------------------------- /src/test/common/clara/test_queries.cljc: -------------------------------------------------------------------------------- 1 | #?(:clj 2 | (ns clara.test-queries 3 | (:require [clara.tools.testing-utils :refer [def-rules-test 4 | side-effect-holder] :as tu] 5 | [clara.rules :refer [fire-rules 6 | insert 7 | query]] 8 | 9 | [clara.rules.testfacts :refer [->Temperature]] 10 | [clojure.test :refer [is deftest run-tests testing use-fixtures]] 11 | [schema.test :as st]) 12 | (:import [clara.rules.testfacts 13 | Temperature])) 14 | 15 | :cljs 16 | (ns clara.test-queries 17 | (:require [clara.rules :refer [fire-rules 18 | insert 19 | query]] 20 | [clara.rules.testfacts :refer [->Temperature Temperature]] 21 | [cljs.test] 22 | [schema.test :as st]) 23 | (:require-macros [clara.tools.testing-utils :refer [def-rules-test]] 24 | [cljs.test :refer [is deftest run-tests testing use-fixtures]]))) 25 | 26 | (use-fixtures :once st/validate-schemas #?(:clj tu/opts-fixture)) 27 | 28 | (def-rules-test test-simple-query 29 | 30 | {:queries [cold-query [[] 31 | [[Temperature (< temperature 20) (= ?t temperature)]]]] 32 | 33 | :sessions [empty-session [cold-query] {}]} 34 | 35 | (let [session (-> empty-session 36 | (insert (->Temperature 15 "MCI")) 37 | (insert (->Temperature 10 "MCI")) 38 | (insert (->Temperature 80 "MCI")) 39 | fire-rules)] 40 | 41 | ;; The query should identify all items that were inserted and matchd the 42 | ;; expected criteria. 43 | (is (= #{{:?t 15} {:?t 10}} 44 | (set (query session cold-query)))))) 45 | 46 | (def-rules-test test-param-query 47 | 48 | {:queries [cold-query [[:?l] 49 | [[Temperature (< temperature 50) 50 | (= ?t temperature) 51 | (= ?l location)]]]] 52 | 53 | :sessions [empty-session [cold-query] {}]} 54 | 55 | (let [session (-> empty-session 56 | (insert (->Temperature 15 "MCI")) 57 | (insert (->Temperature 20 "MCI")) ; Test multiple items in result. 58 | (insert (->Temperature 10 "ORD")) 59 | (insert (->Temperature 35 "BOS")) 60 | (insert (->Temperature 80 "BOS")) 61 | fire-rules)] 62 | 63 | ;; Query by location. 64 | (is (= #{{:?l "BOS" :?t 35}} 65 | (set (query session cold-query :?l "BOS")))) 66 | 67 | (is (= #{{:?l "MCI" :?t 15} {:?l "MCI" :?t 20}} 68 | (set (query session cold-query :?l "MCI")))) 69 | 70 | (is (= #{{:?l "ORD" :?t 10}} 71 | (set (query session cold-query :?l "ORD")))))) 72 | 73 | 74 | -------------------------------------------------------------------------------- /src/test/common/clara/test_performance_optimizations.cljc: -------------------------------------------------------------------------------- 1 | ;; These tests validate that operations that the rules engine should optimize 2 | ;; away are in fact optimized away. The target here is not the actual execution time, 3 | ;; which will vary per system, but verification that the action operations in question are not performed. 4 | #?(:clj 5 | (ns clara.test-performance-optimizations 6 | (:require [clara.tools.testing-utils :refer [def-rules-test 7 | side-effect-holder] :as tu] 8 | [clara.rules :refer [fire-rules 9 | insert 10 | insert! 11 | query]] 12 | 13 | [clara.rules.testfacts :refer [->Cold ->ColdAndWindy]] 14 | [clojure.test :refer [is deftest run-tests testing use-fixtures]] 15 | [clara.rules.accumulators] 16 | [schema.test :as st]) 17 | (:import [clara.rules.testfacts 18 | Cold 19 | ColdAndWindy])) 20 | 21 | :cljs 22 | (ns clara.test-performance-optimizations 23 | (:require [clara.rules :refer [fire-rules 24 | insert 25 | insert! 26 | query]] 27 | [clara.rules.testfacts :refer [->Cold Cold 28 | ->ColdAndWindy ColdAndWindy]] 29 | [clara.rules.accumulators] 30 | [cljs.test] 31 | [schema.test :as st] 32 | [clara.tools.testing-utils :refer [side-effect-holder] :as tu]) 33 | (:require-macros [clara.tools.testing-utils :refer [def-rules-test]] 34 | [cljs.test :refer [is deftest run-tests testing use-fixtures]]))) 35 | 36 | (use-fixtures :once st/validate-schemas #?(:clj tu/opts-fixture)) 37 | (use-fixtures :each tu/side-effect-holder-fixture) 38 | 39 | #?(:clj 40 | (defmacro true-if-binding-absent 41 | [] 42 | (not (contains? &env '?unused-binding)))) 43 | 44 | ;; See issue https://github.com/cerner/clara-rules/issues/383 45 | ;; This validates that we don't create let bindings for binding 46 | ;; variables that aren't used. Doing so both imposes runtime costs 47 | ;; and increases the size of the generated code that must be evaluated. 48 | (def-rules-test test-unused-rhs-binding-not-bound 49 | 50 | {:rules [cold-windy-rule [[[ColdAndWindy (= ?used-binding temperature) (= ?unused-binding windspeed)]] 51 | (when (true-if-binding-absent) 52 | (insert! (->Cold ?used-binding)))]] 53 | 54 | :queries [cold-query [[] [[Cold (= ?c temperature)]]]] 55 | 56 | :sessions [empty-session [cold-windy-rule cold-query] {}]} 57 | 58 | (is (= [{:?c 0}] 59 | (-> empty-session 60 | (insert (->ColdAndWindy 0 0)) 61 | fire-rules 62 | (query cold-query))))) 63 | -------------------------------------------------------------------------------- /src/test/common/clara/test_testing_utils.cljc: -------------------------------------------------------------------------------- 1 | #?(:clj 2 | (ns clara.test-testing-utils 3 | (:require [clara.tools.testing-utils :refer [def-rules-test 4 | run-performance-test]] 5 | [clara.rules :as r] 6 | 7 | [clara.rules.testfacts :refer [->Temperature ->Cold]] 8 | [clojure.test :refer [is deftest run-tests] :as t]) 9 | (:import [clara.rules.testfacts 10 | Temperature 11 | Cold])) 12 | 13 | :cljs 14 | (ns clara.test-testing-utils 15 | (:require [clara.rules :as r] 16 | [clara.rules.testfacts :refer [->Temperature Temperature 17 | ->Cold Cold]] 18 | [cljs.test :as t] 19 | [clara.tools.testing-utils :refer [run-performance-test]]) 20 | (:require-macros [clara.tools.testing-utils :refer [def-rules-test]] 21 | [cljs.test :refer (is deftest run-tests)]))) 22 | 23 | (def test-ran-atom (atom false)) 24 | 25 | ;; This test fixture validates that def-rules-test actually executed the test bodies it 26 | ;; is provided. If the test bodies were not executed test-ran-atom would have a value of false 27 | ;; after test execution. 28 | (t/use-fixtures :once (fn [t] 29 | (reset! test-ran-atom false) 30 | (t) 31 | (is (true? @test-ran-atom)))) 32 | 33 | (def-rules-test basic-tests 34 | {:rules [rule1 [[[?t <- Temperature (< temperature 0)]] 35 | (r/insert! (->Cold (:temperature ?t)))]] 36 | 37 | :queries [query1 [[] 38 | [[Cold (= ?t temperature)]]]] 39 | 40 | :sessions [session1 [rule1 query1] {} 41 | session2 [rule1 query1] {:fact-type-fn (fn [fact] :bogus)}]} 42 | 43 | (reset! test-ran-atom true) 44 | (is (= [{:?t -50}] 45 | (-> session1 46 | (r/insert (->Temperature -50 "MCI")) 47 | r/fire-rules 48 | (r/query query1)))) 49 | 50 | ;; Since we validate later (outside the scope of this test) that the state 51 | ;; change occurred put it in the middle so that it would fail if we took either 52 | ;; the first or last test form, rather than all test forms. 53 | (reset! test-ran-atom true) 54 | 55 | (is (empty? (-> session2 56 | (r/insert (->Temperature -50 "MCI")) 57 | r/fire-rules 58 | (r/query query1))))) 59 | 60 | (def fire-rules-counter (atom 0)) 61 | 62 | (def-rules-test test-performance-test 63 | {:rules [rule1 [[[?t <- Temperature (< temperature 0)]] 64 | (swap! fire-rules-counter inc)]] 65 | :queries [] 66 | :sessions [session1 [rule1] {}]} 67 | (run-performance-test {:description "Simple fire-rules demonstration" 68 | :func #(-> session1 69 | (r/insert (->Temperature -50 "MCI")) 70 | r/fire-rules) 71 | :iterations 5 72 | :mean-assertion (partial > 500)}) 73 | (is (= @fire-rules-counter 5))) 74 | -------------------------------------------------------------------------------- /src/main/clojure/clara/tools/internal/inspect.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.tools.internal.inspect 2 | "Internal implementation details of session inspection. Nothing in this namespace 3 | should be directly referenced by callers outside of the clara-rules project." 4 | (:require [clara.rules.listener :as l] 5 | [clara.rules.engine :as eng])) 6 | 7 | (declare to-persistent-listener) 8 | 9 | (deftype TransientActivationListener [activations] 10 | l/ITransientEventListener 11 | (fire-activation! [listener activation resulting-operations] 12 | (swap! (.-activations listener) conj {:activation activation 13 | :resulting-operations resulting-operations}) 14 | listener) 15 | (to-persistent! [listener] 16 | (to-persistent-listener @(.-activations listener))) 17 | 18 | ;; The methods below don't do anything; they aren't needed for this functionality. 19 | (left-activate! [listener node tokens] 20 | listener) 21 | (left-retract! [listener node tokens] 22 | listener) 23 | (right-activate! [listener node elements] 24 | listener) 25 | (right-retract! [listener node elements] 26 | listener) 27 | (insert-facts! [listener node token facts] 28 | listener) 29 | (alpha-activate! [listener node facts] 30 | listener) 31 | (insert-facts-logical! [listener node token facts] 32 | listener) 33 | (retract-facts! [listener node token facts] 34 | listener) 35 | (alpha-retract! [listener node facts] 36 | listener) 37 | (retract-facts-logical! [listener node token facts] 38 | listener) 39 | (add-accum-reduced! [listener node join-bindings result fact-bindings] 40 | listener) 41 | (remove-accum-reduced! [listener node join-bindings fact-bindings] 42 | listener) 43 | (add-activations! [listener node activations] 44 | listener) 45 | (remove-activations! [listener node activations] 46 | listener) 47 | (activation-group-transition! [listener previous-group new-group] 48 | listener) 49 | (fire-rules! [listener node] 50 | listener)) 51 | 52 | (deftype PersistentActivationListener [activations] 53 | l/IPersistentEventListener 54 | (to-transient [listener] 55 | (TransientActivationListener. (atom activations)))) 56 | 57 | (defn to-persistent-listener 58 | [activations] 59 | (PersistentActivationListener. activations)) 60 | 61 | (defn with-activation-listening 62 | [session] 63 | (if (empty? (eng/find-listeners session (partial instance? PersistentActivationListener))) 64 | (eng/with-listener session (PersistentActivationListener. [])) 65 | session)) 66 | 67 | (defn without-activation-listening 68 | [session] 69 | (eng/remove-listeners session (partial instance? PersistentActivationListener))) 70 | 71 | (defn get-activation-info 72 | [session] 73 | (let [matching-listeners (eng/find-listeners session (partial instance? PersistentActivationListener))] 74 | (condp = (count matching-listeners) 75 | 0 nil 76 | 1 (-> matching-listeners ^PersistentActivationListener (first) .-activations) 77 | (throw (ex-info "Found more than one PersistentActivationListener on session" 78 | {:session session}))))) 79 | 80 | 81 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing to this repository 2 | 3 | Help us to make this project better by contributing. Whether it's new features, bug fixes, or simply improving documentation, your contributions are welcome. Please start with logging a [github issue][1] or submit a pull request. 4 | 5 | Before you contribute, please review these guidelines to help ensure a smooth process for everyone. 6 | 7 | Thanks. 8 | 9 | ## Opening issues 10 | 11 | For bugs or enhancement requests, please file a GitHub issue unless it's 12 | security related. When filing a bug remember that the better written the bug is, 13 | the more likely it is to be fixed. If you think you've found a security 14 | vulnerability, do not raise a GitHub issue and follow the instructions in our 15 | [security policy](./SECURITY.md). 16 | 17 | * Please browse our [existing issues][1] before logging new issues. 18 | * Check that the issue has not already been fixed in the `main` branch. 19 | * Open an issue with a descriptive title and a summary. 20 | * Please be as clear and explicit as you can in your description of the problem. 21 | * Please state the version of Clojure and Clara you are using in the description. 22 | * Include any relevant code in the issue summary. 23 | 24 | ## Contributing code 25 | 26 | We welcome your code contributions. Before submitting code via a pull request, 27 | you will need to have signed the [Oracle Contributor Agreement][OCA] (OCA) and 28 | your commits need to include the following line using the name and e-mail 29 | address you used to sign the OCA: 30 | 31 | ```text 32 | Signed-off-by: Your Name 33 | ``` 34 | 35 | This can be automatically added to pull requests by committing with `--sign-off` 36 | or `-s`, e.g. 37 | 38 | ```text 39 | git commit --signoff 40 | ``` 41 | 42 | Only pull requests from committers that can be verified as having signed the OCA 43 | can be accepted. 44 | 45 | ## Pull request process 46 | 47 | * Read [how to properly contribute to open source projects on Github][2]. 48 | * Fork the project. 49 | * Use a feature branch. 50 | * Write [good commit messages][3]. 51 | * Use the same coding conventions as the rest of the project. 52 | * Commit locally and push to your fork until you are happy with your contribution. 53 | * Make sure to add tests and verify all the tests are passing when merging upstream. 54 | * Add an entry to the [Changelog][4] accordingly. 55 | * Please add your name to the CONTRIBUTORS.md file. Adding your name to the CONTRIBUTORS.md file signifies agreement to all rights and reservations provided by the [License][5]. 56 | * [Squash related commits together][6]. 57 | * Open a [pull request][7]. 58 | * The pull request will be reviewed by the community and merged by the project committers. 59 | 60 | ## Code of conduct 61 | 62 | Follow the [Golden Rule](https://en.wikipedia.org/wiki/Golden_Rule). If you'd 63 | like more specific guidelines, see the [Contributor Covenant Code of Conduct][COC]. 64 | 65 | [1]: https://github.com/cerner/clara-rules/issues 66 | [2]: http://gun.io/blog/how-to-github-fork-branch-and-pull-request 67 | [3]: http://tbaggery.com/2008/04/19/a-note-about-git-commit-messages.html 68 | [4]: ./CHANGELOG.md 69 | [5]: ./LICENSE 70 | [6]: http://gitready.com/advanced/2009/02/10/squashing-commits-with-rebase.html 71 | [7]: https://help.github.com/articles/using-pull-requests 72 | [OCA]: https://oca.opensource.oracle.com 73 | [COC]: https://www.contributor-covenant.org/version/1/4/code-of-conduct/ 74 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://github.com/cerner/clara-rules/actions/workflows/clojure.yml/badge.svg)](https://github.com/cerner/clara-rules/actions/workflows/clojure.yml) 2 | 3 | # Project name 4 | 5 | clara-rules - it's a forward-chaining rules in Clojure(Script) 6 | 7 | ## _About_ 8 | 9 | Clara is a forward-chaining rules engine written in Clojure(Script) with Java interoperability. It aims to simplify code with a developer-centric approach to expert systems. See [clara-rules.org](http://www.clara-rules.org) for more. 10 | 11 | ## _Usage_ 12 | 13 | Here's a simple example. Complete documentation is at [clara-rules.org](http://www.clara-rules.org/docs/firststeps/). 14 | 15 | ```clj 16 | (ns clara.support-example 17 | (:require [clara.rules :refer :all])) 18 | 19 | (defrecord SupportRequest [client level]) 20 | 21 | (defrecord ClientRepresentative [name client]) 22 | 23 | (defrule is-important 24 | "Find important support requests." 25 | [SupportRequest (= :high level)] 26 | => 27 | (println "High support requested!")) 28 | 29 | (defrule notify-client-rep 30 | "Find the client representative and send a notification of a support request." 31 | [SupportRequest (= ?client client)] 32 | [ClientRepresentative (= ?client client) (= ?name name)] ; Join via the ?client binding. 33 | => 34 | (println "Notify" ?name "that" ?client "has a new support request!")) 35 | 36 | ;; Run the rules! We can just use Clojure's threading macro to wire things up. 37 | (-> (mk-session) 38 | (insert (->ClientRepresentative "Alice" "Acme") 39 | (->SupportRequest "Acme" :high)) 40 | (fire-rules)) 41 | 42 | ;;;; Prints this: 43 | 44 | ;; High support requested! 45 | ;; Notify Alice that Acme has a new support request! 46 | ``` 47 | 48 | ## _Building_ 49 | 50 | Clara is built, tested, and deployed using [Leiningen](http://leiningen.org). 51 | ClojureScript tests are executed via [puppeteer](https://pptr.dev/). 52 | ``` 53 | npm install -g puppeteer 54 | npx puppeteer browsers install chrome 55 | ``` 56 | 57 | ## _Availability_ 58 | 59 | Clara releases are on [Clojars](https://clojars.org/). Simply add the following to your project: 60 | 61 | [![Clojars Project](http://clojars.org/com.cerner/clara-rules/latest-version.svg)](http://clojars.org/com.cerner/clara-rules) 62 | 63 | ## _Communication_ 64 | 65 | Questions can be posted to the [Clara Rules Google Group](https://groups.google.com/forum/?hl=en#!forum/clara-rules) or the [Slack channel](https://clojurians.slack.com/messages/clara/). 66 | 67 | ## Contributing 68 | 69 | This project welcomes contributions from the community. Before submitting a pull request, please [review our contribution guide](./CONTRIBUTING.md) 70 | 71 | ## Security 72 | 73 | Please consult the [security guide](./SECURITY.md) for our responsible security vulnerability disclosure process 74 | 75 | ## License 76 | 77 | Copyright (c) 2018, 2025 Oracle and/or its affiliates. 78 | 79 | Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at 80 | 81 |     http://www.apache.org/licenses/LICENSE-2.0 82 | 83 | Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. 84 | 85 | 86 | -------------------------------------------------------------------------------- /src/test/clojurescript/clara/test_complex_negation.cljs: -------------------------------------------------------------------------------- 1 | (ns clara.test-complex-negation 2 | "Tests that validate that we wrap the fact-type-fn and ancestors-fn so that Clara's internal 3 | facts, for example NegationResult facts (added to fix issue 149) are not provided to user-provided 4 | custom fact-type-fn or ancestors-fn functions." 5 | (:require [clara.rules 6 | :refer-macros [defquery 7 | defsession] 8 | :refer [query 9 | insert 10 | fire-rules]] 11 | [clara.rules.testfacts :refer [Temperature ->Temperature 12 | WindSpeed ->WindSpeed 13 | Cold ->Cold]] 14 | [cljs.test :as t] 15 | [cljs.test :refer-macros [run-tests 16 | deftest 17 | is] 18 | :include-macros true])) 19 | 20 | (defquery negation-inside-negation-query 21 | [] 22 | [:windspeed (= ?l (:location this))] 23 | [:not [:and 24 | [?t <- :temperature (= ?l (:location this))] 25 | [:not [:cold (= (:temperature this) (:temperature ?t))]]]]) 26 | 27 | ;; Use ancestors of the fact types to ensure that the custom ancestors-fn 28 | ;; is used and that its arguments are the types from the custom fact-type-fn 29 | (defquery negation-inside-negation-ancestors-query 30 | [] 31 | [:windspeed-ancestor (= ?l (:location this))] 32 | [:not [:and 33 | [?t <- :temperature-ancestor (= ?l (:location this))] 34 | [:not [:cold-ancestor (= (:temperature this) (:temperature ?t))]]]]) 35 | 36 | (defn type->keyword 37 | [fact] 38 | (cond 39 | (instance? WindSpeed fact) :windspeed 40 | (instance? Temperature fact) :temperature 41 | (instance? Cold fact) :cold 42 | ;; If we reach the :else case then we are probably calling the user-provided :fact-type-fn 43 | ;; on an internal NegationResult fact which we should not do; see issue 241. 44 | :else (throw (ex-info "A fact that is not a WindSpeed, Temperature, or Cold was provided." 45 | {:fact fact})))) 46 | 47 | (defn keyword->ancestors 48 | [type-key] 49 | (condp = type-key 50 | :windspeed #{:windspeed-ancestor} 51 | :temperature #{:temperature-ancestor} 52 | :cold #{:cold-ancestor} 53 | 54 | (throw (ex-info "A type that is not :windspeed, :temperature, or :cold was provided" 55 | {:type type})))) 56 | 57 | (defsession test-session 'clara.test-complex-negation 58 | :fact-type-fn type->keyword 59 | :ancestors-fn keyword->ancestors) 60 | 61 | (deftest test-complex-negation 62 | (let [different-temps (-> test-session 63 | (insert (->WindSpeed 10 "MCI") 64 | (->Temperature 10 "MCI") 65 | (->Cold 20)) 66 | (fire-rules)) 67 | 68 | same-temps (-> test-session 69 | (insert (->WindSpeed 10 "MCI") 70 | (->Temperature 10 "MCI") 71 | (->Cold 10)) 72 | (fire-rules))] 73 | (is (empty? 74 | (query different-temps negation-inside-negation-query))) 75 | (is (empty? 76 | (query different-temps negation-inside-negation-ancestors-query))) 77 | 78 | (is (= [{:?l "MCI"}] 79 | (query same-temps negation-inside-negation-query) 80 | (query same-temps negation-inside-negation-ancestors-query))))) 81 | -------------------------------------------------------------------------------- /src/test/clojure/clara/test_compiler.clj: -------------------------------------------------------------------------------- 1 | (ns clara.test-compiler 2 | (:require [clojure.test :refer :all] 3 | [clara.tools.testing-utils :as tu] 4 | [clara.rules :as r] 5 | [clara.rules.engine :as eng] 6 | [clojure.string :as str] 7 | [clara.rules.accumulators :as acc] 8 | [clojure.main :as m]) 9 | (:import [clara.rules.engine 10 | AlphaNode 11 | TestNode 12 | AccumulateNode 13 | AccumulateWithJoinFilterNode 14 | ProductionNode 15 | NegationWithJoinFilterNode 16 | ExpressionJoinNode 17 | RootJoinNode] 18 | [clojure.lang ExceptionInfo])) 19 | 20 | ;; See https://github.com/cerner/clara-rules/pull/451 for more info 21 | (tu/def-rules-test test-nodes-have-named-fns 22 | {:rules [;; covers AlphaNode, ExpressionJoinNode and ProductionNode 23 | expression-node-rule [[[::a [{:keys [some-field]}] (= ?some-field some-field)] 24 | [::b [{:keys [another-field]}] (contains? another-field ?some-field)]] 25 | (r/insert! {:fact-type ::c})] 26 | ;; covers AccumulateNode, TestNode 27 | accum-test-rule [[[?cs <- (acc/all) :from [::c]] 28 | [:test (seq ?cs)]] 29 | (r/insert! {:fact-type ::d :vals ?cs})] 30 | ;; covers AccumulateWithJoinFilterNode 31 | accum-join-filter [[[::a [{:keys [some-field]}] (= ?some-field some-field)] 32 | [?ds <- (acc/all) :from [::d [{:keys [another-field]}] (contains? another-field ?some-field)]]] 33 | (r/insert! {:fact-type ::e :vals ?ds})] 34 | ;; covers NegationWithJoinFilter 35 | negation-join-filter [[[::e [{:keys [some-field]}] (= ?some-field some-field)] 36 | [:not [::d [{:keys [another-field]}] (contains? another-field ?some-field)]]] 37 | (r/insert! {:fact-type ::f})]] 38 | :queries [] 39 | :sessions [base-session [expression-node-rule 40 | accum-test-rule 41 | accum-join-filter 42 | negation-join-filter] {:fact-type-fn :fact-type}]} 43 | (let [get-node-fns (fn [node] 44 | (condp instance? node 45 | AlphaNode [(:activation node)] 46 | TestNode [(:test node)] 47 | AccumulateNode [] 48 | AccumulateWithJoinFilterNode [(:join-filter-fn node)] 49 | ProductionNode [(:rhs node)] 50 | NegationWithJoinFilterNode [(:join-filter-fn node)] 51 | ExpressionJoinNode [(:join-filter-fn node)] 52 | RootJoinNode []))] 53 | (doseq [node (-> base-session eng/components :rulebase :id-to-node vals) 54 | node-fn (get-node-fns node)] 55 | (is (seq (re-find (re-pattern (str (get eng/node-type->abbreviated-type (.getSimpleName (class node))) 56 | "-" 57 | (:id node))) 58 | (-> node-fn str m/demunge (str/split #"/") last))) 59 | (str "For node: " node " and node-fn: " node-fn))))) 60 | 61 | ;; See https://github.com/cerner/clara-rules/issues/454 for more info 62 | (deftest test-query-node-requires-bindings-exist 63 | (let [;; (defquery a-query 64 | ;; [:?b] 65 | ;; [?c <- ::a-fact-type]) 66 | query {:lhs [{:type ::a-fact-type 67 | :constraints [] 68 | :args [] 69 | :fact-binding :?c}] 70 | :params #{:?b} 71 | :name "a-query"}] 72 | (tu/assert-ex-data {:expected-bindings #{:?b} 73 | :available-bindings #{:?c} 74 | :query "a-query"} 75 | (r/mk-session [query])))) 76 | -------------------------------------------------------------------------------- /src/test/common/clara/test_clear_ns_productions.cljc: -------------------------------------------------------------------------------- 1 | ;;; Tests that clear-ns-productions! correction clears all vars marked as productions from the namespace. 2 | #?(:clj 3 | (ns clara.test-clear-ns-productions 4 | (:require [clara.tools.testing-utils :as tu] 5 | [clara.rules :refer [fire-rules 6 | insert 7 | insert! 8 | query 9 | defrule 10 | defquery 11 | defsession 12 | clear-ns-productions!]] 13 | [clojure.test :refer [is deftest run-tests testing use-fixtures]])) 14 | :cljs 15 | (ns clara.test-clear-ns-productions 16 | (:require [clara.rules :refer [fire-rules 17 | insert 18 | insert! 19 | query]] 20 | [cljs.test] 21 | [clara.tools.testing-utils :as tu]) 22 | (:require-macros [clara.rules :refer [defrule defquery defsession clear-ns-productions!]] 23 | [cljs.test :refer [is deftest run-tests testing use-fixtures]]))) 24 | 25 | (use-fixtures :each tu/side-effect-holder-fixture) 26 | 27 | (defrule rule-to-be-cleared 28 | [:a] 29 | => 30 | (reset! tu/side-effect-holder :before-clearing) 31 | (insert! :before-clearing)) 32 | 33 | (defquery query-to-be-cleared [] [?f <- :before-clearing]) 34 | 35 | #?(:clj 36 | (def ^:production-seq ns-production-seq-to-be-cleared 37 | [{:doc "Before clearing" 38 | :name "clara.test-clear-ns-productions/production-seq-to-be-cleared" 39 | :lhs '[{:type :a 40 | :constraints []}] 41 | :rhs '(clara.rules/insert! :before-clearing-seq)}])) 42 | 43 | (defsession uncleared-session 'clara.test-clear-ns-productions :fact-type-fn identity) 44 | 45 | (clear-ns-productions!) 46 | 47 | (defrule rule-after-clearing 48 | [:a] 49 | => 50 | (insert! :after-clearing)) 51 | 52 | (defquery query-before-clearing [] [?f <- :before-clearing]) 53 | (defquery query-after-clearing [] [?f <- :after-clearing]) 54 | (defquery query-before-clearing-seq [] [?f <- :before-clearing-seq]) 55 | (defquery query-after-clearing-seq [] [?f <- :after-clearing-seq]) 56 | #?(:clj 57 | (def ^:production-seq production-seq-after-clearing 58 | [{:doc "After clearing" 59 | :name "clara.test-clear-ns-productions/production-seq-after-clearing" 60 | :lhs '[{:type :a 61 | :constraints []}] 62 | :rhs '(clara.rules/insert! :after-clearing-seq)}])) 63 | 64 | (defsession cleared-session 'clara.test-clear-ns-productions :fact-type-fn identity) 65 | 66 | ;;; Then tests validating what productions the respective sessions have. 67 | (deftest cleared? 68 | (let [uncleared (-> uncleared-session (insert :a) (fire-rules))] 69 | (is (= :before-clearing @tu/side-effect-holder)) 70 | (reset! tu/side-effect-holder nil)) 71 | (let [cleared (-> cleared-session (insert :a) (fire-rules))] 72 | (testing "cleared-session should not contain any productions before (clear-ns-productions!)" 73 | (is (= nil @tu/side-effect-holder)) 74 | (is (empty? (query cleared query-before-clearing))) 75 | #?(:clj (is (not-empty (query cleared query-after-clearing))))) 76 | (is (empty? (query cleared query-before-clearing-seq))) 77 | #?(:clj (is (not-empty (query cleared query-after-clearing-seq)))))) 78 | 79 | (deftest query-cleared? 80 | (let [uncleared (-> uncleared-session (insert :a) (fire-rules)) 81 | cleared (-> cleared-session (insert :a) (fire-rules))] 82 | (is (not-empty (query uncleared "clara.test-clear-ns-productions/query-to-be-cleared"))) 83 | (is (thrown-with-msg? #?(:clj IllegalArgumentException :cljs js/Error) #"clara.test-clear-ns-productions/query-to-be-cleared" 84 | (query cleared "clara.test-clear-ns-productions/query-to-be-cleared"))))) -------------------------------------------------------------------------------- /src/main/clojure/clara/tools/loop_detector.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.tools.loop-detector 2 | (:require [clara.rules.listener :as l] 3 | [clara.rules.engine :as eng] 4 | [clara.tools.tracing :as trace])) 5 | 6 | ;; Although we use a single type here note that the cycles-count and the on-limit-delay fields 7 | ;; will be nil during the persistent state of the listener. 8 | (deftype CyclicalRuleListener [cycles-count max-cycles on-limit-fn on-limit-delay] 9 | l/ITransientEventListener 10 | (left-activate! [listener node tokens] 11 | listener) 12 | (left-retract! [listener node tokens] 13 | listener) 14 | (right-activate! [listener node elements] 15 | listener) 16 | (right-retract! [listener node elements] 17 | listener) 18 | (insert-facts! [listener node token facts] 19 | listener) 20 | (alpha-activate! [listener node facts] 21 | listener) 22 | (insert-facts-logical! [listener node token facts] 23 | listener) 24 | (retract-facts! [listener node token facts] 25 | listener) 26 | (alpha-retract! [listener node facts] 27 | listener) 28 | (retract-facts-logical! [listener node token facts] 29 | listener) 30 | (add-accum-reduced! [listener node join-bindings result fact-bindings] 31 | listener) 32 | (remove-accum-reduced! [listener node join-bindings fact-bindings] 33 | listener) 34 | (add-activations! [listener node activations] 35 | listener) 36 | (remove-activations! [listener node activations] 37 | listener) 38 | (fire-activation! [listener activation resulting-operations] 39 | listener) 40 | (fire-rules! [listener node] 41 | listener) 42 | (activation-group-transition! [listener original-group new-group] 43 | (when (>= @cycles-count max-cycles) 44 | @on-limit-delay) 45 | (swap! cycles-count inc)) 46 | (to-persistent! [listener] 47 | (CyclicalRuleListener. nil max-cycles on-limit-fn nil)) 48 | 49 | l/IPersistentEventListener 50 | (to-transient [listener] 51 | ;; To-transient will be called when a call to fire-rules begins, and to-persistent! will be called when it ends. 52 | ;; The resetting of the cycles-count atom prevents cycles from one call of fire-rules from leaking into the count 53 | ;; for another. Similarly the on-limit-fn should be invoked 1 or 0 times per fire-rules call. We only call 54 | ;; it once, rather than each time the limit is breached, since it may not cause the call to terminate but rather log 55 | ;; something etc., in which case we don't want to spam the user's logs. 56 | (CyclicalRuleListener. (atom 0) max-cycles on-limit-fn (delay (on-limit-fn))))) 57 | 58 | (defn throw-exception-on-max-cycles 59 | [] 60 | (let [trace (trace/listener->trace (l/to-persistent! (:listener eng/*current-session*)))] 61 | (throw (ex-info "Reached maximum activation group transitions threshhold; an infinite loop is suspected" 62 | (cond-> {:clara-rules/infinite-loop-suspected true} 63 | trace (assoc :trace trace)))))) 64 | 65 | (defn ->standard-out-warning 66 | [] 67 | (println "Reached maximum activation group transitions threshhold; an infinite loop is suspected")) 68 | 69 | (defn on-limit-fn-lookup 70 | [fn-or-keyword] 71 | (cond 72 | (= fn-or-keyword :throw-exception) throw-exception-on-max-cycles 73 | (= fn-or-keyword :standard-out-warning) ->standard-out-warning 74 | (ifn? fn-or-keyword) fn-or-keyword 75 | :else (throw (ex-info "The :on-error-fn must be a non-nil function value" {:clara-rules/max-cycles-exceeded-fn fn-or-keyword})))) 76 | 77 | 78 | (defn with-loop-detection 79 | "Detect suspected infinite loops in the session. 80 | 81 | Max-cycles is the maximum 82 | number of transitions permitted between different activation groups (salience levels) 83 | plus the number of times all rules are evaluated and their facts inserted, thus leading 84 | to another cycle of rules activations in the same activation group. 85 | 86 | on-limit-fn is a 0-arg function that is invoked exactly once when this limit is exceeded. It can either be 87 | a user-provided function or a keyword that indicates a built-in function to use. Currently supported keywords are: 88 | 89 | :throw-exception - This throws an exception when the limit is reached. If tracing is enabled, the exception will include 90 | the trace. 91 | 92 | :standard-out-warning - This prints a warning to standard out." 93 | 94 | [session max-cycles on-limit-fn] 95 | 96 | (let [on-limit-fn-normalized (on-limit-fn-lookup on-limit-fn)] 97 | (eng/with-listener 98 | session 99 | (CyclicalRuleListener. 100 | nil 101 | max-cycles 102 | on-limit-fn-normalized 103 | nil)))) 104 | -------------------------------------------------------------------------------- /src/test/clojurescript/clara/test_salience.cljs: -------------------------------------------------------------------------------- 1 | (ns clara.test-salience 2 | (:require-macros [cljs.test :refer (is deftest run-tests testing)] 3 | [clara.rules.test-rules-data]) 4 | (:require [cljs.test :as t] 5 | [clara.rules.engine :as eng] 6 | [clara.rules.accumulators :as acc] 7 | [clara.rules :refer [insert retract fire-rules query insert!] 8 | :refer-macros [defrule defsession defquery]] 9 | [clara.rules.testfacts :refer [->Temperature Temperature 10 | ->WindSpeed WindSpeed 11 | ->ColdAndWindy ColdAndWindy]])) 12 | 13 | (def salience-rule-output (atom [])) 14 | 15 | (defrule salience-rule1 16 | {:salience 100} 17 | [Temperature] 18 | => 19 | (swap! salience-rule-output conj 100)) 20 | 21 | (defrule salience-rule2 22 | {:salience 50} 23 | [Temperature] 24 | => 25 | (swap! salience-rule-output conj 50)) 26 | 27 | (defrule salience-rule3 28 | {:salience 0} 29 | [Temperature] 30 | => 31 | (swap! salience-rule-output conj 0)) 32 | 33 | (defrule salience-rule4 34 | {:salience -50} 35 | [Temperature] 36 | => 37 | (swap! salience-rule-output conj -50)) 38 | 39 | 40 | (deftest test-salience 41 | (doseq [[sort-fn 42 | group-fn 43 | expected-order] 44 | 45 | [[:default-sort :default-group :forward-order] 46 | [:default-sort :salience-group :forward-order] 47 | [:default-sort :neg-salience-group :backward-order] 48 | 49 | [:numeric-greatest-sort :default-group :forward-order] 50 | [:numeric-greatest-sort :salience-group :forward-order] 51 | [:numeric-greatest-sort :neg-salience-group :backward-order] 52 | 53 | 54 | [:boolean-greatest-sort :default-group :forward-order] 55 | [:boolean-greatest-sort :salience-group :forward-order] 56 | [:boolean-greatest-sort :neg-salience-group :backward-order] 57 | 58 | 59 | [:numeric-least-sort :default-group :backward-order] 60 | [:numeric-least-sort :salience-group :backward-order] 61 | [:numeric-least-sort :neg-salience-group :forward-order] 62 | 63 | [:boolean-least-sort :default-group :backward-order] 64 | [:boolean-least-sort :salience-group :backward-order] 65 | [:boolean-least-sort :neg-salience-group :forward-order]]] 66 | 67 | (let [numeric-greatest-sort (fn [x y] 68 | (cond 69 | (= x y) 0 70 | (> x y) -1 71 | :else 1)) 72 | 73 | numeric-least-sort (fn [x y] 74 | (numeric-greatest-sort y x)) 75 | 76 | salience-group-fn (fn [production] 77 | (or (some-> production :props :salience) 78 | 0)) 79 | 80 | neg-salience-group-fn (fn [p] 81 | (- (salience-group-fn p)))] 82 | 83 | ;; A CLJS macro that behaves like mk-session (creates a session but does not intern a Var) 84 | ;; has been proposed in #292. Internally, this would facilitate session generation for CLJS 85 | ;; tests such as this one, and may be useful if exposed publicly. 86 | 87 | (defsession test-salience-session 'clara.test-salience 88 | :cache false 89 | :activation-group-sort-fn (condp = sort-fn 90 | :default-sort nil 91 | :numeric-greatest-sort numeric-greatest-sort 92 | :numeric-least-sort numeric-least-sort 93 | :boolean-greatest-sort > 94 | :boolean-least-sort <) 95 | :activation-group-fn (condp = group-fn 96 | :default-group nil 97 | :salience-group salience-group-fn 98 | :neg-salience-group neg-salience-group-fn)) 99 | 100 | (reset! salience-rule-output []) 101 | 102 | (-> test-salience-session 103 | (insert (->Temperature 10 "MCI")) 104 | (fire-rules)) 105 | 106 | (let [test-fail-str 107 | (str "Failure with sort-fn: " sort-fn ", group-fn: " group-fn ", and expected order: " expected-order)] 108 | (condp = expected-order 109 | :forward-order 110 | (is (= [100 50 0 -50] @salience-rule-output) 111 | test-fail-str) 112 | 113 | :backward-order 114 | (is (= [-50 0 50 100] @salience-rule-output) 115 | test-fail-str)))))) 116 | -------------------------------------------------------------------------------- /src/test/clojure/clara/test_fressian.clj: -------------------------------------------------------------------------------- 1 | (ns clara.test-fressian 2 | (:require [clara.rules.durability :as d] 3 | [clara.rules.durability.fressian :as df] 4 | [clojure.data.fressian :as fres] 5 | [clara.rules.platform :as pform] 6 | [clojure.test :refer :all]) 7 | (:import [org.fressian 8 | FressianWriter 9 | FressianReader])) 10 | 11 | (defn custom-comparator [x y] 12 | (> y x)) 13 | 14 | (defrecord Tester [x]) 15 | 16 | (defn serde1 [x] 17 | (with-open [os (java.io.ByteArrayOutputStream.) 18 | ^FressianWriter wtr (fres/create-writer os :handlers df/write-handler-lookup)] 19 | ;; Write 20 | (pform/thread-local-binding [d/node-id->node-cache (volatile! {}) 21 | d/clj-struct-holder (java.util.IdentityHashMap.)] 22 | (fres/write-object wtr x)) 23 | ;; Read 24 | (let [data (.toByteArray os)] 25 | (pform/thread-local-binding [d/clj-struct-holder (java.util.ArrayList.)] 26 | (with-open [is (java.io.ByteArrayInputStream. data) 27 | ^FressianReader rdr (fres/create-reader is :handlers df/read-handler-lookup)] 28 | (fres/read-object rdr)))))) 29 | 30 | (defn serde [x] 31 | ;; Tests all serialization cases in a way that SerDe's 2 times to show that the serialization to 32 | ;; deserialization process does not lose important details for the next time serializing it. 33 | (-> x serde1 serde1)) 34 | 35 | (defn test-serde [expected x] 36 | (is (= expected (serde x)))) 37 | 38 | (defn test-serde-with-meta [expected x] 39 | (let [no-meta (serde x) 40 | test-meta {:test :meta} 41 | x-with-meta (vary-meta x merge test-meta) 42 | ;; In case x already has metadata it needs to be added to the expectation 43 | ;; along with the test metadata added in case it has none to test already. 44 | expected-meta (meta x-with-meta) 45 | has-meta (serde x-with-meta)] 46 | 47 | (is (= expected 48 | no-meta 49 | has-meta)) 50 | (is (= expected-meta 51 | (meta has-meta))))) 52 | 53 | (deftest test-handlers 54 | 55 | (testing "class" 56 | (test-serde String String)) 57 | 58 | (testing "set" 59 | (test-serde-with-meta #{:x :y} #{:x :y})) 60 | 61 | (testing "vec" 62 | (test-serde-with-meta [1 2 3] [1 2 3])) 63 | 64 | (testing "list" 65 | (test-serde-with-meta (list "a" "b") (list "a" "b"))) 66 | 67 | (testing "aseq" 68 | (test-serde-with-meta ['a 'b] (seq ['a 'b]))) 69 | 70 | (testing "lazy seq" 71 | (test-serde-with-meta [2 3 4] (map inc [1 2 3]))) 72 | 73 | (testing "map" 74 | (test-serde-with-meta {:x 1 :y 2} {:x 1 :y 2})) 75 | 76 | (testing "map entry" 77 | (let [e (first {:x 1})] 78 | (test-serde [:x 1] e) 79 | (is (instance? clojure.lang.MapEntry (serde e)) 80 | "preserves map entry type to be sure to still work with `key` and `val`"))) 81 | 82 | (testing "sym" 83 | (test-serde-with-meta 't 't)) 84 | 85 | (testing "record" 86 | (test-serde-with-meta (->Tester 10) (->Tester 10))) 87 | 88 | (testing "sorted collections" 89 | (let [ss (sorted-set 1 10) 90 | ss-custom (with-meta (sorted-set-by custom-comparator 1 10) 91 | {:clara.rules.durability/comparator-name `custom-comparator}) 92 | 93 | sm (sorted-map 1 :x 10 :y) 94 | sm-custom (with-meta (sorted-map-by custom-comparator 1 :x 10 :y) 95 | {:clara.rules.durability/comparator-name `custom-comparator})] 96 | 97 | (testing "set" 98 | (test-serde-with-meta ss ss) 99 | (test-serde-with-meta ss-custom ss-custom) 100 | (is (thrown? Exception 101 | (serde (with-meta ss-custom {}))) 102 | "cannot serialized custom sort comparators without name given in metadata")) 103 | 104 | (testing "map" 105 | (test-serde-with-meta sm sm) 106 | (test-serde-with-meta sm-custom sm-custom) 107 | (is (thrown? Exception 108 | (serde (with-meta sm-custom {}))) 109 | "cannot serialized custom sort comparators without name given in metadata"))))) 110 | 111 | (deftest test-handler-identity 112 | (let [v [1 2 3] 113 | l (list 4 5 6) 114 | ls (map inc [1 2 3]) 115 | m {:a 1 :b 2} 116 | s #{:a :b :c} 117 | sym 'a 118 | os (sorted-set "a" "c" "b") 119 | om (sorted-map "a" 1 "c" 3 "b" 2) 120 | r (serde (->Tester [v v l l ls ls m m s s sym sym os os om om]))] 121 | (doseq [[x y] (partition 2 (:x r))] 122 | (testing (str "Serde preserves identity for " (type x)) 123 | (is (identical? x y) 124 | "preserving object references"))))) 125 | 126 | -------------------------------------------------------------------------------- /src/main/clojure/clara/tools/fact_graph.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.tools.fact-graph 2 | (:require [clara.tools.inspect :as i] 3 | [schema.core :as sc])) 4 | 5 | ;; This node will have either facts or results of accumulations as its parents. 6 | ;; Its children will be facts that the rule inserted. 7 | (sc/defrecord RuleActivationNode [rule-name :- sc/Str 8 | id :- sc/Int]) 9 | 10 | ;; The parents of this node are facts over which an accumulation was run. 11 | ;; It will have a single child, the result of the accumulation. So, for example, 12 | ;; with the condition [?t <- (acc/min :temperature) :from [Temperature]], if we have 13 | ;; (->Temperature 50 "MCI") and (->Temperature 30 "MCI") the child of this node will be 14 | ;; an AccumulationResult with the :result 30 and the parents will be the two Temperature facts. 15 | (sc/defrecord AccumulationNode [id :- sc/Int]) 16 | 17 | ;; As alluded to above, this node represents the result of an accumulation. Its child will be a 18 | ;; RuleActivationNode. Note that there will be an AccumulationResult for each distinct rules firing. 19 | (sc/defrecord AccumulationResultNode [id :- sc/Int 20 | result :- sc/Any]) 21 | 22 | (def ^:private empty-fact-graph {:forward-edges {} 23 | :backward-edges {}}) 24 | 25 | (defn ^:private add-edge [graph from to] 26 | (-> graph 27 | (update-in [:forward-edges from] (fnil conj #{}) to) 28 | (update-in [:backward-edges to] (fnil conj #{}) from))) 29 | 30 | (defn ^:private add-insertion-to-graph 31 | [original-graph id-counter fact-inserted {:keys [rule-name explanation]}] 32 | (let [facts-direct (sequence 33 | (comp (remove :facts-accumulated) 34 | (map :fact)) 35 | (:matches explanation)) 36 | 37 | activation-node (map->RuleActivationNode {:rule-name rule-name 38 | :id (swap! id-counter inc)}) 39 | 40 | accum-matches (filter :facts-accumulated (:matches explanation))] 41 | 42 | (as-> original-graph graph 43 | (if (seq accum-matches) 44 | (reduce (fn [reduce-graph accum-match] 45 | (let [accum-node (->AccumulationNode (swap! id-counter inc)) 46 | accum-result (->AccumulationResultNode (swap! id-counter inc) (:fact accum-match))] 47 | (as-> reduce-graph g 48 | ;; Add edges from individual facts to an AccumulationResultNode. 49 | (reduce (fn [g accum-element] 50 | (add-edge g accum-element accum-node)) 51 | g (:facts-accumulated accum-match)) 52 | (add-edge g accum-node accum-result) 53 | (add-edge g accum-result activation-node)))) 54 | graph 55 | accum-matches) 56 | graph) 57 | ;; Add edges to the rule activation node from the facts that contributed 58 | ;; to the rule firing that were not in accumulator condition. 59 | (reduce (fn [g f] 60 | (add-edge g f activation-node)) 61 | graph 62 | facts-direct) 63 | (add-edge graph activation-node fact-inserted)))) 64 | 65 | (defn session->fact-graph 66 | "Given a session, return a graph structure connecting all facts to the facts 67 | that they caused to be logically inserted. Note that such connections will not 68 | be made for unconditionally inserted facts." 69 | [session] 70 | (let [id-counter (atom 0) 71 | ;; Use a counter, whose value will be added to internal nodes, to the ensure that 72 | ;; these nodes are not equal to each other. This ensures that the number of the internal 73 | ;; nodes accurately reflects the cardinality of each fact in the session. 74 | 75 | ;; This function generates one of the entries in the map returned by clara.tools.inspect/inspect. 76 | ;; The function is private since it would be confusing for only one of the entries in clara.tools.inspect/inspect 77 | ;; to be accessible without generating the entire session inspection map. However, we want to reuse the functionality 78 | ;; here without the performance penalty of generating all of the inspection data for the session. Therefore, for now 79 | ;; we break the privacy of the function here. Once issue 286 is completed we should remove this private Var access. 80 | fact->explanations (@#'i/gen-fact->explanations session) 81 | 82 | ;; Produce tuples of the form [inserted-fact {:rule rule :explanation clara.tools.inspect.Explanation}] 83 | insertion-tuples (into [] 84 | (comp 85 | (map (fn [[fact v]] 86 | (map (fn [{:keys [rule explanation]}] 87 | [fact {:rule-name (:name rule) 88 | :explanation explanation}]) 89 | v))) 90 | cat) 91 | fact->explanations)] 92 | 93 | (reduce (fn [graph tuple] 94 | (apply add-insertion-to-graph graph id-counter tuple)) 95 | empty-fact-graph 96 | insertion-tuples))) 97 | -------------------------------------------------------------------------------- /src/test/clojure/clara/generative/generators.clj: -------------------------------------------------------------------------------- 1 | (ns clara.generative.generators 2 | (:require [clojure.math.combinatorics :as combo] 3 | [clara.rules :refer :all] 4 | [schema.core :as s])) 5 | 6 | (s/defschema FactSessionOperation {:type (s/enum :insert :retract) 7 | :facts [s/Any]}) 8 | 9 | (s/defschema FireSessionOperation {:type (s/enum :fire)}) 10 | 11 | (s/defschema SessionOperation (s/conditional 12 | #(= (:type %) :fire) FireSessionOperation 13 | :else FactSessionOperation)) 14 | 15 | (defn session-run-ops 16 | "Run the provided sequence of operations on the provide session and return the final session." 17 | [session ops] 18 | (let [final-session (reduce (fn [session op] 19 | (let [new-session (condp = (:type op) 20 | :insert (insert-all session (:facts op)) 21 | :retract (apply retract session (:facts op)) 22 | :fire (fire-rules session))] 23 | new-session)) 24 | session ops)] 25 | final-session)) 26 | 27 | (defn ^:private retract-before-insertion? 28 | "Given a sequence of operations, determine if the number of retractions of any fact exceeds the number 29 | of times has been inserted at any time." 30 | [ops] 31 | (let [alter-fact-count (fn [alter-fn] 32 | (fn [fc facts] 33 | (reduce (fn [updated-fc f] 34 | (update fc f alter-fn)) 35 | fc facts))) 36 | inc-fact-count (alter-fact-count (fnil inc 0)) 37 | dec-fact-count (alter-fact-count (fnil dec 0)) 38 | 39 | any-count-negative? (fn [fc] 40 | (boolean (some neg? (vals fc))))] 41 | 42 | (= ::premature-retract (reduce (fn [fact-count op] 43 | (let [new-count (condp = (:type op) 44 | :insert (inc-fact-count fact-count (:facts op)) 45 | :retract (dec-fact-count fact-count (:facts op)) 46 | fact-count)] 47 | (if (any-count-negative? new-count) 48 | (reduced ::premature-retract) 49 | new-count))) 50 | {} 51 | ops)))) 52 | 53 | (defn ^:private ops->add-insert-retract 54 | "Takes an operations sequence and returns a sequence of sequences of operations 55 | where every possible combination of inserting and retracting each fact inserted 56 | in the parent sequence up to the number of times set by dup-level. Note that one 57 | of the possibilities returned will be the original operations sequence. This is not 58 | special-cased, but a reflection of the fact that every combination of adding insert/retract pairs 59 | from 0 to dup-level is in the possibilities returned. The number of possibilities returned 60 | will explode rapidly for large dup-level values." 61 | [ops dup-level] 62 | (let [ops->extra (fn [ops] 63 | (map (fn [op] 64 | (when (= (:type op) 65 | :insert) 66 | [{:type :insert 67 | :facts (:facts op)} 68 | {:type :retract 69 | :facts (:facts op)}])) 70 | ops)) 71 | extras-with-dups (apply concat (repeat dup-level 72 | (ops->extra ops))) 73 | 74 | extra-subsets (combo/subsets extras-with-dups)] 75 | 76 | (map (fn [extras] 77 | (into ops cat extras)) 78 | extra-subsets))) 79 | 80 | (s/defn ops->permutations :- [[SessionOperation]] 81 | "Given a sequence of operations, return all permutations of the operations for 82 | which no retraction of a fact that has not yet been inserted occurs. By default 83 | permutations where extra insertions and retractions in equal number of inserted facts 84 | are added will be present. The default number of such pairs allowed to be added per insertion 85 | is 1." 86 | [ops :- [SessionOperation] 87 | {:keys [dup-level] :or {dup-level 0}}] 88 | (let [dup-ops-seqs (ops->add-insert-retract ops dup-level) 89 | permutations (mapcat combo/permutations dup-ops-seqs)] 90 | 91 | ;; The permutation creation allows for a retraction to occur before insertion, which 92 | ;; effectively removes the retraction from the seq of operations since retractions of facts 93 | ;; that are not present do not cause alteration of the session state. The idea of these helpers 94 | ;; is to produce orders of operations that should all have the same outcomes. 95 | ;; The following would have an A when done: 96 | ;; retract A, insert A 97 | ;; while this would not: 98 | ;; insert A, retract A 99 | ;; 100 | ;; For now, we can just find all permutations and remove the ones with invalid ordering. 101 | ;; This is inefficient and there may be a more efficient algorithm or implementation. 102 | (remove retract-before-insertion? permutations))) 103 | -------------------------------------------------------------------------------- /src/main/clojure/clara/rules/platform.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.rules.platform 2 | "This namespace is for internal use and may move in the future. 3 | Platform unified code Clojure/ClojureScript.") 4 | 5 | (defn throw-error 6 | "Throw an error with the given description string." 7 | [^String description] 8 | (throw #?(:clj (IllegalArgumentException. description) :cljs (js/Error. description)))) 9 | 10 | (defn query-param 11 | "Coerces a query param to a parameter keyword such as :?param, if an unsupported type is 12 | supplied then an exception will be thrown" 13 | [p] 14 | (cond 15 | (keyword? p) p 16 | (symbol? p) (keyword p) 17 | :else 18 | (throw-error (str "Query bindings must be specified as a keyword or symbol: " p)))) 19 | 20 | ;; This class wraps Clojure objects to ensure Clojure's equality and hash 21 | ;; semantics are visible to Java code. This allows these Clojure objects 22 | ;; to be safely used in things like Java Sets or Maps. 23 | ;; This class also accepts and stores the hash code, since it almost always 24 | ;; will be used once and generally more than once. 25 | #?(:clj 26 | (deftype JavaEqualityWrapper [wrapped ^int hash-code] 27 | 28 | Object 29 | (equals [this other] 30 | (and (instance? JavaEqualityWrapper other) 31 | (= wrapped (.wrapped ^JavaEqualityWrapper other)))) 32 | 33 | (hashCode [this] 34 | hash-code))) 35 | 36 | #?(:clj 37 | (defn group-by-seq 38 | "Groups the items of the given coll by f to each item. Returns a seq of tuples of the form 39 | [f-val xs] where xs are items from the coll and f-val is the result of applying f to any of 40 | those xs. Each x in xs has the same value (f x). xs will be in the same order as they were 41 | found in coll. 42 | The behavior is similar to calling `(seq (group-by f coll))` However, the returned seq will 43 | always have consistent ordering from process to process. The ordering is insertion order 44 | as new (f x) values are found traversing the given coll collection in its seq order. The 45 | returned order is made consistent to ensure that relevant places within the rules engine that 46 | use this grouping logic have deterministic behavior across different processes." 47 | [f coll] 48 | (let [^java.util.Map m (reduce (fn [^java.util.Map m x] 49 | (let [k (f x) 50 | ;; Use Java's hashcode for performance reasons as 51 | ;; discussed at https://github.com/cerner/clara-rules/issues/393 52 | wrapper (JavaEqualityWrapper. k 53 | (if (nil? k) 54 | (int 0) 55 | (int (.hashCode ^Object k)))) 56 | xs (or (.get m wrapper) 57 | (transient []))] 58 | (.put m wrapper (conj! xs x))) 59 | m) 60 | (java.util.LinkedHashMap.) 61 | coll) 62 | it (.iterator (.entrySet m))] 63 | ;; Explicitly iterate over a Java iterator in order to avoid running into issues as 64 | ;; discussed in http://dev.clojure.org/jira/browse/CLJ-1738 65 | (loop [coll (transient [])] 66 | (if (.hasNext it) 67 | (let [^java.util.Map$Entry e (.next it)] 68 | (recur (conj! coll [(.wrapped ^JavaEqualityWrapper (.getKey e)) (persistent! (.getValue e))]))) 69 | (persistent! coll))))) 70 | :cljs 71 | (def group-by-seq (comp seq clojure.core/group-by))) 72 | 73 | #?(:clj 74 | (defn tuned-group-by 75 | "Equivalent of the built-in group-by, but tuned for when there are many values per key." 76 | [f coll] 77 | (->> coll 78 | (reduce (fn [map value] 79 | (let [k (f value) 80 | items (or (.get ^java.util.HashMap map k) 81 | (transient []))] 82 | (.put ^java.util.HashMap map k (conj! items value))) 83 | map) 84 | (java.util.HashMap.)) 85 | (reduce (fn [map [key value]] 86 | (assoc! map key (persistent! value))) 87 | (transient {})) 88 | (persistent!))) 89 | :cljs 90 | (def tuned-group-by clojure.core/group-by)) 91 | 92 | #?(:clj 93 | (defmacro thread-local-binding 94 | "Wraps given body in a try block, where it sets each given ThreadLocal binding 95 | and removes it in finally block." 96 | [bindings & body] 97 | (when-not (vector? bindings) 98 | (throw (ex-info "Binding needs to be a vector." 99 | {:bindings bindings}))) 100 | (when-not (even? (count bindings)) 101 | (throw (ex-info "Needs an even number of forms in binding vector" 102 | {:bindings bindings}))) 103 | (let [binding-pairs (partition 2 bindings)] 104 | `(try 105 | ~@(for [[tl v] binding-pairs] 106 | `(.set ~tl ~v)) 107 | ~@body 108 | (finally 109 | ~@(for [[tl] binding-pairs] 110 | `(.remove ~tl))))))) 111 | 112 | (defmacro eager-for 113 | "A for wrapped with a doall to force realisation. Usage is the same as regular for." 114 | [& body] 115 | `(doall (for ~@body))) 116 | -------------------------------------------------------------------------------- /src/test/clojure/clara/performance/test_compilation.clj: -------------------------------------------------------------------------------- 1 | (ns clara.performance.test-compilation 2 | (:require [clojure.test :refer :all] 3 | [clara.rules.compiler :as com] 4 | [clara.rules :as r] 5 | [clara.rules.durability :as dura] 6 | [clara.rules.durability.fressian :as fres] 7 | [clara.rules.accumulators :as acc] 8 | [clara.tools.testing-utils :as utils]) 9 | (:import [java.io ByteArrayOutputStream ByteArrayInputStream])) 10 | 11 | (defn filter-fn 12 | [seed-keyword] 13 | (= seed-keyword (keyword (gensym)))) 14 | 15 | (def base-production 16 | {:ns-name (symbol (str *ns*))}) 17 | 18 | (defn generate-filter-productions 19 | [seed-syms] 20 | (into {} 21 | (for [seed-sym seed-syms 22 | :let [next-fact (symbol (str seed-sym "prime")) 23 | production (assoc base-production 24 | :lhs [{:type (keyword seed-sym) 25 | :constraints [`(= ~'this ~'?binding) `(filter-fn ~'this)]}] 26 | :rhs `(r/insert! (with-meta ~(set (repeatedly 10 #(rand-nth (range 100)))) 27 | {:type ~(keyword next-fact) 28 | :val ~'?binding})))]] 29 | [next-fact production]))) 30 | 31 | (defn generate-compose-productions 32 | [seed-syms] 33 | (let [template (fn template 34 | ([l] (template l l)) 35 | ([l r] (let [next-fact (symbol (str l r "prime")) 36 | production (assoc base-production 37 | :lhs [{:type (keyword l) 38 | :constraints [`(= ~'this ~'?binding-l)]} 39 | {:type (keyword r) 40 | :constraints [`(= ~'?binding-l ~'this)]}] 41 | :rhs `(r/insert! (with-meta ~(set (repeatedly 10 #(rand-nth (range 100)))) 42 | {:type ~(keyword next-fact)})))] 43 | [next-fact production])))] 44 | (into {} 45 | (for [combo (partition-all 2 (shuffle seed-syms))] 46 | (apply template combo))))) 47 | 48 | (defn generate-collection-productions 49 | [seed-syms] 50 | (into {} 51 | (for [seed-sym seed-syms 52 | :let [next-fact (symbol (str seed-sym "prime")) 53 | production (assoc base-production 54 | :lhs [{:accumulator `(acc/all) 55 | :from {:type (keyword seed-sym), 56 | :constraints [`(filter-fn ~'this)]} 57 | :result-binding :?binding}] 58 | :rhs `(r/insert! (with-meta ~'?binding 59 | {:type ~(keyword next-fact)})))]] 60 | [next-fact production]))) 61 | 62 | (defn generate-queries 63 | [seed-syms] 64 | (into {} 65 | (for [seed-sym seed-syms 66 | :let [production (assoc base-production 67 | :lhs [{:type (keyword seed-sym) 68 | :constraints [] 69 | :fact-binding :?binding}] 70 | :params #{})]] 71 | [seed-sym production]))) 72 | 73 | (defn generate-rules-and-opts 74 | [num-starter-facts] 75 | (let [starter-seeds (repeatedly num-starter-facts gensym)] 76 | (-> (reduce (fn [[seeds prods] next-fn] 77 | (let [new-productions-and-facts (next-fn seeds)] 78 | [(keys new-productions-and-facts) 79 | (concat prods 80 | (vals new-productions-and-facts))])) 81 | [starter-seeds []] 82 | [generate-filter-productions 83 | generate-compose-productions 84 | generate-collection-productions 85 | generate-queries]) 86 | second 87 | vector 88 | (conj :cache false)))) 89 | 90 | (deftest compilation-performance-test 91 | (let [rules (generate-rules-and-opts 500)] 92 | (testing "Session creation performance" 93 | (utils/run-performance-test 94 | {:description "Generated Session Compilation" 95 | :func #(com/mk-session rules) 96 | :iterations 50 97 | :mean-assertion (partial > 5000)})) 98 | 99 | (let [session (com/mk-session rules) 100 | os (ByteArrayOutputStream.)] 101 | (testing "Session rulebase serialization performance" 102 | (utils/run-performance-test 103 | {:description "Session rulebase serialization" 104 | :func #(dura/serialize-rulebase 105 | session 106 | (fres/create-session-serializer (ByteArrayOutputStream.))) 107 | :iterations 50 108 | :mean-assertion (partial > 1000)})) 109 | 110 | (testing "Session rulebase deserialization performance" 111 | (dura/serialize-rulebase 112 | session 113 | (fres/create-session-serializer os)) 114 | 115 | (let [session-bytes (.toByteArray os)] 116 | (utils/run-performance-test 117 | {:description "Session rulebase deserialization" 118 | :func #(dura/deserialize-rulebase 119 | (fres/create-session-serializer (ByteArrayInputStream. session-bytes))) 120 | :iterations 50 121 | :mean-assertion (partial > 5000)})))))) 122 | -------------------------------------------------------------------------------- /src/test/common/clara/test_common.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.test-common 2 | "Common tests for Clara in Clojure and ClojureScript." 3 | (:require #?(:clj [clojure.test :refer :all] 4 | :cljs [cljs.test :refer-macros [is deftest testing]]) 5 | 6 | #?(:clj [clara.rules :refer [defrule defsession defquery 7 | insert fire-rules query]] 8 | :cljs [clara.rules :refer [insert fire-rules query] 9 | :refer-macros [defrule defsession defquery]]) 10 | 11 | [clara.rules.accumulators :as acc] 12 | 13 | [clara.rules.platform :as platform])) 14 | 15 | (defn- has-fact? [token fact] 16 | (some #{fact} (map first (:matches token)))) 17 | 18 | (def simple-defrule-side-effect (atom nil)) 19 | (def other-defrule-side-effect (atom nil)) 20 | 21 | (defrule test-rule 22 | [:temperature [{temperature :temperature}] (< temperature 20)] 23 | => 24 | (reset! other-defrule-side-effect ?__token__) 25 | (reset! simple-defrule-side-effect ?__token__)) 26 | 27 | (defquery cold-query 28 | [] 29 | [:temperature [{temperature :temperature}] (< temperature 20) (= ?t temperature)]) 30 | 31 | (defsession my-session [test-rule cold-query] :fact-type-fn :type) 32 | 33 | (deftest test-simple-defrule 34 | (let [t {:type :temperature 35 | :temperature 10 36 | :location "MCI"} 37 | session (insert my-session t)] 38 | 39 | (fire-rules session) 40 | 41 | (is (has-fact? @simple-defrule-side-effect t)) 42 | (is (has-fact? @other-defrule-side-effect t)))) 43 | 44 | (deftest test-simple-query 45 | (let [session (-> my-session 46 | (insert {:type :temperature 47 | :temperature 15 48 | :location "MCI"}) 49 | (insert {:type :temperature 50 | :temperature 10 51 | :location "MCI"}) 52 | (insert {:type :temperature 53 | :temperature 80 54 | :location "MCI"}) 55 | fire-rules)] 56 | 57 | ;; The query should identify all items that were inserted and matched the 58 | ;; expected criteria. 59 | (is (= #{{:?t 15} {:?t 10}} 60 | (set (query session cold-query)))))) 61 | 62 | 63 | (defquery temps-below-threshold 64 | [] 65 | [:threshold [{value :value}] (= ?threshold value)] 66 | [?low-temps <- (acc/all) :from [:temperature [{value :value}] (< value ?threshold)]]) 67 | 68 | (defsession accum-with-filter-session [temps-below-threshold] :fact-type-fn :type) 69 | 70 | (deftest test-accum-with-filter 71 | 72 | (is (= [{:?threshold 0, :?low-temps []}] 73 | (-> accum-with-filter-session 74 | (insert {:type :temperature :value 20}) 75 | (insert {:type :threshold :value 0}) 76 | (insert {:type :temperature :value 10}) 77 | fire-rules 78 | (query temps-below-threshold)))) 79 | 80 | (let [results (-> accum-with-filter-session 81 | (insert {:type :temperature :value 20}) 82 | (insert {:type :threshold :value 40}) 83 | (insert {:type :temperature :value 10}) 84 | (insert {:type :temperature :value 60}) 85 | fire-rules 86 | (query temps-below-threshold)) 87 | 88 | [{threshold :?threshold low-temps :?low-temps }] results] 89 | 90 | (is (= 1 (count results))) 91 | 92 | (is (= 40 threshold)) 93 | 94 | (is (= #{{:type :temperature :value 10} {:type :temperature :value 20}} 95 | (set low-temps))))) 96 | 97 | (defquery none-below-threshold 98 | [] 99 | [:threshold [{value :value}] (= ?threshold value)] 100 | [:not [:temperature [{value :value}] (< value ?threshold)]]) 101 | 102 | (defquery temperature-below-value-using-symbol-arg 103 | [?value] 104 | [:temperature [{value :value}] (< value ?value)]) 105 | 106 | (defquery temperature-below-value-using-keyword-arg 107 | [:?value] 108 | [:temperature [{value :value}] (< value ?value)]) 109 | 110 | (deftest test-query-definition-bindings-args 111 | (testing "can define queries using symbol or keyword arguments" 112 | (is (= (dissoc temperature-below-value-using-symbol-arg :name) (dissoc temperature-below-value-using-keyword-arg :name))))) 113 | 114 | (deftest test-query-param-args 115 | (testing "noop query-params using keyword arguments" 116 | (is (= (platform/query-param :?value) :?value))) 117 | (testing "coerce query-params using symbol arguments" 118 | (is (= (platform/query-param '?value) :?value))) 119 | (testing "can not coerce query-params using string arguments" 120 | (try 121 | (platform/query-param "?value") 122 | (is false "Running the rules in this test should cause an exception.") 123 | (catch #?(:clj java.lang.IllegalArgumentException 124 | :cljs js/Error) e 125 | (is (= "Query bindings must be specified as a keyword or symbol: ?value" 126 | #?(:clj (.getMessage e) 127 | :cljs (.-message e)))))))) 128 | 129 | (defsession negation-with-filter-session [none-below-threshold] :fact-type-fn :type) 130 | 131 | (deftest test-negation-with-filter 132 | 133 | (is (= [{:?threshold 0}] 134 | (-> negation-with-filter-session 135 | (insert {:type :temperature :value 20}) 136 | (insert {:type :threshold :value 0}) 137 | (insert {:type :temperature :value 10}) 138 | fire-rules 139 | (query none-below-threshold)))) 140 | 141 | ;; Values below the threshold exist, so we should not match. 142 | (is (empty? 143 | (-> negation-with-filter-session 144 | (insert {:type :temperature :value 20}) 145 | (insert {:type :threshold :value 40}) 146 | (insert {:type :temperature :value 10}) 147 | (insert {:type :temperature :value 60}) 148 | fire-rules 149 | (query none-below-threshold))))) 150 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject com.cerner/clara-rules "0.24.1-SNAPSHOT" 2 | :description "Clara Rules Engine" 3 | :url "https://github.com/cerner/clara-rules" 4 | :license {:name "Apache License Version 2.0" 5 | :url "https://www.apache.org/licenses/LICENSE-2.0"} 6 | :dependencies [[org.clojure/clojure "1.11.2"] 7 | [prismatic/schema "1.1.6"]] 8 | :profiles {:dev {:dependencies [[org.clojure/math.combinatorics "0.1.3"] 9 | [org.clojure/data.fressian "0.2.1"] 10 | [clj-kondo/clj-kondo "2023.04.14"]] 11 | :java-source-paths ["src/test/java"] 12 | :global-vars {*warn-on-reflection* true}} 13 | :provided {:dependencies [[org.clojure/clojurescript "1.11.132"]]} 14 | :recent-clj {:dependencies [^:replace [org.clojure/clojure "1.11.2"] 15 | ^:replace [org.clojure/clojurescript "1.11.132"]]} 16 | :java9 {:jvm-opts ["--add-modules=java.xml.bind"]}} 17 | :plugins [[lein-codox "0.10.3" :exclusions [org.clojure/clojure 18 | org.clojure/clojurescript]] 19 | [lein-javadoc "0.3.0" :exclusions [org.clojure/clojure 20 | org.clojure/clojurescript]] 21 | [lein-cljsbuild "1.1.8" :exclusions [org.clojure/clojure 22 | org.clojure/clojurescript]] 23 | [lein-figwheel "0.5.14" :exclusions [org.clojure/clojure 24 | org.clojure/clojurescript]] 25 | [com.github.clj-kondo/lein-clj-kondo "0.2.4" :exclusions [org.clojure/clojure 26 | org.clojure/clojurescript]]] 27 | :aliases {"clj-kondo-deps" ["clj-kondo" "--copy-configs" "--dependencies" "--parallel" "--lint" "$classpath"] 28 | "clj-kondo-lint" ["do" ["clj-kondo-deps"] ["clj-kondo" "--lint" "src/main:src/test" "--fail-level" "error"]]} 29 | :codox {:namespaces [clara.rules clara.rules.dsl clara.rules.accumulators 30 | clara.rules.listener clara.rules.durability 31 | clara.tools.inspect clara.tools.tracing 32 | clara.tools.fact-graph] 33 | :metadata {:doc/format :markdown}} 34 | :javadoc-opts {:package-names "clara.rules"} 35 | :source-paths ["src/main/clojure"] 36 | :resource-paths ["clj-kondo"] 37 | :test-paths ["src/test/clojure" "src/test/common"] 38 | :java-source-paths ["src/main/java"] 39 | :javac-options ["-target" "1.8" "-source" "1.8"] 40 | :clean-targets ^{:protect false} ["resources/public/js" "target"] 41 | :hooks [leiningen.cljsbuild] 42 | :cljsbuild {:builds [;; Simple mode compilation for tests. 43 | {:id "figwheel" 44 | :source-paths ["src/test/clojurescript" "src/test/common"] 45 | :figwheel true 46 | :compiler {:main "clara.test" 47 | :output-to "resources/public/js/simple.js" 48 | :output-dir "resources/public/js/out" 49 | :asset-path "js/out" 50 | :optimizations :none}} 51 | 52 | {:id "simple" 53 | :source-paths ["src/test/clojurescript" "src/test/common"] 54 | :compiler {:output-to "target/js/simple.js" 55 | :optimizations :whitespace}} 56 | 57 | ;; Advanced mode compilation for tests. 58 | {:id "advanced" 59 | :source-paths ["src/test/clojurescript" "src/test/common"] 60 | :compiler {:output-to "target/js/advanced.js" 61 | :anon-fn-naming-policy :mapped 62 | :optimizations :advanced}}] 63 | 64 | :test-commands {"puppeteer-simple" ["node" 65 | "src/test/js/runner.js" 66 | "src/test/html/simple.html"] 67 | 68 | "puppeteer-advanced" ["node" 69 | "src/test/js/runner.js" 70 | "src/test/html/advanced.html"]}} 71 | 72 | :repl-options {;; The large number of ClojureScript tests is causing long compilation times 73 | ;; to start the REPL. 74 | :timeout 180000} 75 | 76 | ;; Factoring out the duplication of this test selector function causes an error, 77 | ;; perhaps because Leiningen is using this as uneval'ed code. 78 | ;; For now just duplicate the line. 79 | :test-selectors {:default (complement (fn [x] 80 | (let [blacklisted-packages #{"generative" "performance"} 81 | patterns (into [] 82 | (comp 83 | (map #(str "^clara\\." % ".*")) 84 | (interpose "|")) 85 | blacklisted-packages)] 86 | (some->> x :ns ns-name str (re-matches (re-pattern (apply str patterns))))))) 87 | :generative (fn [x] (some->> x :ns ns-name str (re-matches #"^clara\.generative.*"))) 88 | :performance (fn [x] (some->> x :ns ns-name str (re-matches #"^clara\.performance.*")))} 89 | 90 | :scm {:name "git" 91 | :url "https://github.com/cerner/clara-rules"} 92 | :pom-addition [:developers [:developer 93 | [:id "rbrush"] 94 | [:name "Ryan Brush"] 95 | [:url "http://www.clara-rules.org"]]] 96 | :deploy-repositories [["snapshots" {:url "https://oss.sonatype.org/content/repositories/snapshots/" 97 | :creds :gpg}] 98 | ["releases" {:url "https://repo.clojars.org" 99 | :creds :gpg 100 | :sign-releases false}]]) 101 | -------------------------------------------------------------------------------- /src/main/clojure/clara/rules/listener.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.rules.listener 2 | "Event listeners for analyzing the flow through Clara. This is for primarily for use by 3 | tooling, but advanced users may use this to analyze sessions.") 4 | 5 | (defprotocol IPersistentEventListener 6 | (to-transient [listener])) 7 | 8 | ;; TODO: Handle add-accum-reduced 9 | (defprotocol ITransientEventListener 10 | (left-activate! [listener node tokens]) 11 | (left-retract! [listener node tokens]) 12 | (right-activate! [listener node elements]) 13 | (right-retract! [listener node elements]) 14 | (insert-facts! [listener node token facts]) 15 | (alpha-activate! [listener node facts]) 16 | (insert-facts-logical! [listener node token facts]) 17 | (retract-facts! [listener node token facts]) 18 | (alpha-retract! [listener node facts]) 19 | (retract-facts-logical! [listener node token facts]) 20 | (add-accum-reduced! [listener node join-bindings result fact-bindings]) 21 | (remove-accum-reduced! [listener node join-bindings fact-bindings]) 22 | (add-activations! [listener node activations]) 23 | (remove-activations! [listener node activations]) 24 | (fire-activation! [listener activation resulting-operations]) 25 | (fire-rules! [listener node]) 26 | (activation-group-transition! [listener original-group new-group]) 27 | (to-persistent! [listener])) 28 | 29 | ;; A listener that does nothing. 30 | (deftype NullListener [] 31 | ITransientEventListener 32 | (left-activate! [listener node tokens] 33 | listener) 34 | (left-retract! [listener node tokens] 35 | listener) 36 | (right-activate! [listener node elements] 37 | listener) 38 | (right-retract! [listener node elements] 39 | listener) 40 | (insert-facts! [listener node token facts] 41 | listener) 42 | (alpha-activate! [listener node facts] 43 | listener) 44 | (insert-facts-logical! [listener node token facts] 45 | listener) 46 | (retract-facts! [listener node token facts] 47 | listener) 48 | (alpha-retract! [listener node facts] 49 | listener) 50 | (retract-facts-logical! [listener node token facts] 51 | listener) 52 | (add-accum-reduced! [listener node join-bindings result fact-bindings] 53 | listener) 54 | (remove-accum-reduced! [listener node join-bindings fact-bindings] 55 | listener) 56 | (add-activations! [listener node activations] 57 | listener) 58 | (remove-activations! [listener node activations] 59 | listener) 60 | (fire-activation! [listener activation resulting-operations] 61 | listener) 62 | (fire-rules! [listener node] 63 | listener) 64 | (activation-group-transition! [listener original-group new-group] 65 | listener) 66 | (to-persistent! [listener] 67 | listener) 68 | 69 | IPersistentEventListener 70 | (to-transient [listener] 71 | listener)) 72 | 73 | (declare delegating-listener) 74 | 75 | ;; A listener that simply delegates to others 76 | (deftype DelegatingListener [children] 77 | ITransientEventListener 78 | (left-activate! [listener node tokens] 79 | (doseq [child children] 80 | (left-activate! child node tokens))) 81 | 82 | (left-retract! [listener node tokens] 83 | (doseq [child children] 84 | (left-retract! child node tokens))) 85 | 86 | (right-activate! [listener node elements] 87 | (doseq [child children] 88 | (right-activate! child node elements))) 89 | 90 | (right-retract! [listener node elements] 91 | (doseq [child children] 92 | (right-retract! child node elements))) 93 | 94 | (insert-facts! [listener node token facts] 95 | (doseq [child children] 96 | (insert-facts! child node token facts))) 97 | 98 | (alpha-activate! [listener node facts] 99 | (doseq [child children] 100 | (alpha-activate! child node facts))) 101 | 102 | (insert-facts-logical! [listener node token facts] 103 | (doseq [child children] 104 | (insert-facts-logical! child node token facts))) 105 | 106 | (retract-facts! [listener node token facts] 107 | (doseq [child children] 108 | (retract-facts! child node token facts))) 109 | 110 | (alpha-retract! [listener node facts] 111 | (doseq [child children] 112 | (alpha-retract! child node facts))) 113 | 114 | (retract-facts-logical! [listener node token facts] 115 | (doseq [child children] 116 | (retract-facts-logical! child node token facts))) 117 | 118 | (add-accum-reduced! [listener node join-bindings result fact-bindings] 119 | (doseq [child children] 120 | (add-accum-reduced! child node join-bindings result fact-bindings))) 121 | 122 | (remove-accum-reduced! [listener node join-bindings fact-bindings] 123 | (doseq [child children] 124 | (remove-accum-reduced! child node join-bindings fact-bindings))) 125 | 126 | (add-activations! [listener node activations] 127 | (doseq [child children] 128 | (add-activations! child node activations))) 129 | 130 | (remove-activations! [listener node activations] 131 | (doseq [child children] 132 | (remove-activations! child node activations))) 133 | 134 | (fire-activation! [listener activation resulting-operations] 135 | (doseq [child children] 136 | (fire-activation! child activation resulting-operations))) 137 | 138 | (fire-rules! [listener node] 139 | (doseq [child children] 140 | (fire-rules! child node))) 141 | 142 | (activation-group-transition! [listener original-group new-group] 143 | (doseq [child children] 144 | (activation-group-transition! child original-group new-group))) 145 | 146 | (to-persistent! [listener] 147 | (delegating-listener (map to-persistent! children)))) 148 | 149 | (deftype PersistentDelegatingListener [children] 150 | IPersistentEventListener 151 | (to-transient [listener] 152 | (DelegatingListener. (map to-transient children)))) 153 | 154 | (defn delegating-listener 155 | "Returns a listener that delegates to its children." 156 | [children] 157 | (PersistentDelegatingListener. children)) 158 | 159 | (defn null-listener? 160 | "Returns true if the given listener is the null listener, false otherwise." 161 | [listener] 162 | (instance? NullListener listener)) 163 | 164 | (defn get-children 165 | "Returns the children of a delegating listener." 166 | [^PersistentDelegatingListener listener] 167 | (.-children listener)) 168 | 169 | ;; Default listener. 170 | (def default-listener (NullListener.)) 171 | 172 | (defn ^:internal ^:no-doc flatten-listener 173 | [listener] 174 | (if (null-listener? listener) 175 | [] 176 | (get-children listener))) 177 | -------------------------------------------------------------------------------- /src/main/clojure/clara/rules/update_cache/cancelling.clj: -------------------------------------------------------------------------------- 1 | (ns clara.rules.update-cache.cancelling 2 | (:require [clara.rules.update-cache.core :as uc]) 3 | (:import [java.util 4 | List 5 | Map 6 | LinkedList 7 | LinkedHashMap 8 | Collections])) 9 | 10 | ;;; We need a wrapper to use Clojure equality semantics inside 11 | ;;; a Java collection. Furthermore, since we know we will need to do 12 | ;;; a hash operation for each such wrapper created anyway we can ensure 13 | ;;; that if the hashes of two facts are not equal that the equals implementation 14 | ;;; here will quickly return false. 15 | (deftype FactWrapper [fact ^int fact-hash] 16 | 17 | Object 18 | (equals [this other] 19 | 20 | (cond 21 | 22 | ;; There are some cases where the inserted and retracted facts could be identical, particularly 23 | ;; if user code in the RHS has caches, so we go ahead and check for identity as a first-pass check, 24 | ;; but there are probably aren't enough cases where the facts are identical to make doing a full sweep 25 | ;; on identity first worthwhile, particularly since in practice the hash check will make the vast majority 26 | ;; of .equals calls that return false quite fast. 27 | (identical? fact (.fact ^FactWrapper other)) 28 | true 29 | 30 | (not (== fact-hash (.fact_hash ^FactWrapper other))) 31 | false 32 | 33 | :else (= fact (.fact ^FactWrapper other)))) 34 | 35 | (hashCode [this] fact-hash)) 36 | 37 | 38 | ;;; These functions essentially allow us to use a Java map to create a set that stores 39 | ;;; the frequency of its items. Note that when multiple instances of a fact are added 40 | ;;; we keep both instances as distinct objects. We don't strictly speaking need to do this 41 | ;;; but we expect it to perform better. The memory will retain both distinct references 42 | ;;; and future updates are expected to be faster if these references are maintained since 43 | ;;; memory operations look for matches on identity first in tokens before falling back to matching 44 | ;;; on equality. 45 | (defn inc-fact-count! [^Map m fact] 46 | (let [wrapper (FactWrapper. fact (hash fact)) 47 | ^List current-val (.get m wrapper)] 48 | (if current-val 49 | (.add current-val fact) 50 | (.put m wrapper (LinkedList. [fact]))))) 51 | 52 | (defn dec-fact-count! [^Map m fact] 53 | (let [wrapper (FactWrapper. fact (hash fact)) 54 | ;; Note that we specifically use a LinkedList type hint here since we 55 | ;; use methods from multiple interfaces here, namely List and Deque. 56 | ^LinkedList current-val (.get m wrapper)] 57 | (if current-val 58 | (do 59 | (if (= (.size current-val) 1) 60 | (.remove m wrapper) 61 | ;;; Since as noted above, the facts are equal, we don't actually care which one we remove. 62 | ;;; We remove the first here to avoid any work checking equality and since this is a constant-time 63 | ;;; operation on LinkedList. Since the insertions will be newly inserted facts we probably won't 64 | ;;; have many identical retractions, so doing a sweep for identical facts first probably wouldn't 65 | ;;; have enough hits to be worth the cost. 66 | (.removeFirst current-val)) 67 | true) 68 | false))) 69 | 70 | (defn map->vals-concated 71 | [^Map m] 72 | (let [val-list (java.util.LinkedList.) 73 | it (.iterator (.entrySet m))] 74 | (loop [] 75 | (when (.hasNext it) 76 | (do (let [^java.util.Map$Entry e (.next it) 77 | fact (.fact ^FactWrapper (.getKey e)) 78 | ^Iterable facts-in-val (.getValue e) 79 | fact-iter (.iterator facts-in-val)] 80 | (loop [] 81 | (when (.hasNext fact-iter) 82 | (do 83 | (.add val-list (.next fact-iter)) 84 | (recur))))) 85 | (recur)))) 86 | ;; This list will never be exposed to the user; it is simply iterated over 87 | ;; by the engine and then discarded. This being the case there is no 88 | ;; need to return a persistent data structure rather than an unmodifiable one. 89 | (Collections/unmodifiableList val-list))) 90 | 91 | ;;; This is a pending updates cache that allows 92 | ;; retractions and insertions of equal facts 93 | ;;; to cancel each other out. 94 | ;;; More formally, for i insertions and r retractions 95 | ;;; of a fact f, it will: 96 | ;;; - If i = r, no operations will be performed. 97 | ;;; - If i > r, f will be returned for insertion i - r times. 98 | ;;; - If r > i, f will be returned for retraction r - i times. 99 | (deftype CancellingUpdateCache [^Map ^:unsynchronized-mutable insertions 100 | ^Map ^:unsynchronized-mutable retractions] 101 | 102 | uc/UpdateCache 103 | 104 | (add-insertions! [this facts] 105 | (let [fact-iter (.iterator ^Iterable facts)] 106 | (loop [] 107 | (when (.hasNext fact-iter) 108 | (let [fact (.next fact-iter)] 109 | (when-not (dec-fact-count! retractions fact) 110 | (inc-fact-count! insertions fact)) 111 | (recur)))))) 112 | 113 | (add-retractions! [this facts] 114 | (let [fact-iter (.iterator ^Iterable facts)] 115 | (loop [] 116 | (when (.hasNext fact-iter) 117 | (let [fact (.next fact-iter)] 118 | (when-not (dec-fact-count! insertions fact) 119 | (inc-fact-count! retractions fact)) 120 | (recur)))))) 121 | 122 | (get-updates-and-reset! [this] 123 | (let [retractions-update (when (-> retractions .size pos?) 124 | (uc/->PendingUpdate :retract (map->vals-concated retractions))) 125 | insertions-update (when (-> insertions .size pos?) 126 | (uc/->PendingUpdate :insert (map->vals-concated insertions)))] 127 | (set! insertions (LinkedHashMap.)) 128 | (set! retractions (LinkedHashMap.)) 129 | 130 | (cond 131 | 132 | (and insertions-update retractions-update) 133 | ;; This could be ordered to have insertions before retractions if we ever 134 | ;; found that that performs better on average. Either ordering should 135 | ;; be functionally correct. 136 | [[retractions-update] [insertions-update]] 137 | 138 | insertions-update 139 | [[insertions-update]] 140 | 141 | retractions-update 142 | [[retractions-update]])))) 143 | 144 | ;; We use LinkedHashMap so that the ordering of the pending updates will be deterministic. 145 | (defn get-cancelling-update-cache 146 | [] 147 | (CancellingUpdateCache. (LinkedHashMap.) (LinkedHashMap.))) 148 | -------------------------------------------------------------------------------- /src/test/common/clara/tools/test_fact_graph.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.tools.test-fact-graph 2 | (:require [clara.tools.testing-utils :as tu] 3 | [clara.tools.fact-graph :as g] 4 | [clara.rules :as cr] 5 | [clara.rules.accumulators :as acc] 6 | [schema.test :as st] 7 | #?(:clj [clojure.test :refer [is deftest run-tests testing use-fixtures]] 8 | :cljs [cljs.test :refer-macros [is deftest run-tests testing use-fixtures]]) 9 | #?(:clj [clara.rules.testfacts :as tf] 10 | :cljs [clara.rules.testfacts :refer [Cold WindSpeed ColdAndWindy] :as tf])) 11 | #?(:clj 12 | (:import [clara.rules.testfacts Cold WindSpeed ColdAndWindy]))) 13 | 14 | (use-fixtures :once st/validate-schemas) 15 | 16 | (tu/def-rules-test test-basic-fact-graph 17 | {:rules [cold-windy-rule [[[Cold (= ?t temperature) (< ?t 0)] 18 | [WindSpeed (= ?w windspeed) (> ?w 30)]] 19 | (cr/insert! (tf/->ColdAndWindy ?t ?w))]] 20 | :sessions [empty-session [cold-windy-rule] {:cache false}]} 21 | (let [actual-graph (-> empty-session 22 | (cr/insert (tf/->Cold -10) 23 | (tf/->WindSpeed 50 "MCI")) 24 | cr/fire-rules 25 | g/session->fact-graph) 26 | 27 | expected-graph (let [act-node (g/map->RuleActivationNode {:rule-name "cold-windy-rule" 28 | :id 1})] 29 | {:forward-edges 30 | {(tf/->Cold -10) #{act-node} 31 | (tf/->WindSpeed 50 "MCI") #{act-node} 32 | act-node #{(tf/->ColdAndWindy -10 50)}} 33 | :backward-edges 34 | {act-node #{(tf/->Cold -10) 35 | (tf/->WindSpeed 50 "MCI")} 36 | (tf/->ColdAndWindy -10 50) #{act-node}}})] 37 | 38 | (is (= expected-graph actual-graph)))) 39 | 40 | (tu/def-rules-test test-accum-rule-fact-graph 41 | {:rules [cold-windy-rule [[[?t <- (acc/min :temperature) :from [Cold]] 42 | [WindSpeed (= ?w windspeed) (> ?w 30)]] 43 | (cr/insert! (tf/->ColdAndWindy ?t ?w))]] 44 | :sessions [empty-session [cold-windy-rule] {:cache false}]} 45 | (let [actual-graph (-> empty-session 46 | (cr/insert (tf/->Cold -10) 47 | (tf/->Cold 10) 48 | (tf/->WindSpeed 50 "MCI")) 49 | cr/fire-rules 50 | g/session->fact-graph) 51 | 52 | expected-graph (let [act-node (g/map->RuleActivationNode {:rule-name "cold-windy-rule" 53 | :id 1}) 54 | accum-node (g/map->AccumulationNode {:id 2}) 55 | accum-result-node (g/map->AccumulationResultNode {:id 3 56 | :result -10})] 57 | {:forward-edges 58 | {(tf/->Cold -10) #{accum-node} 59 | (tf/->Cold 10) #{accum-node} 60 | accum-node #{accum-result-node} 61 | accum-result-node #{act-node} 62 | (tf/->WindSpeed 50 "MCI") #{act-node} 63 | act-node #{(tf/->ColdAndWindy -10 50)}} 64 | :backward-edges 65 | {accum-node #{(tf/->Cold -10) (tf/->Cold 10)} 66 | accum-result-node #{accum-node} 67 | act-node #{(tf/->WindSpeed 50 "MCI") 68 | accum-result-node} 69 | (tf/->ColdAndWindy -10 50) #{act-node}}})] 70 | 71 | (is (= expected-graph actual-graph)))) 72 | 73 | (tu/def-rules-test test-fact-duplicates 74 | {:rules [b-rule [[[?a <- "a"]] 75 | (cr/insert! "b")] 76 | c-rule [[[?b <- "b"]] 77 | (cr/insert! "c")]] 78 | :sessions [empty-session [b-rule c-rule] {:cache false :fact-type-fn identity}]} 79 | (let [actual-graph (-> empty-session 80 | (cr/insert "a" "a") 81 | cr/fire-rules 82 | g/session->fact-graph) 83 | 84 | expected-graph (let [rule1-node1 (g/map->RuleActivationNode {:rule-name "b-rule" 85 | :id 1}) 86 | rule1-node2 (g/map->RuleActivationNode {:rule-name "b-rule" 87 | :id 2}) 88 | rule2-node1 (g/map->RuleActivationNode {:rule-name "c-rule" 89 | :id 3}) 90 | rule2-node2 (g/map->RuleActivationNode {:rule-name "c-rule" 91 | :id 4})] 92 | {:forward-edges {"a" #{rule1-node1 rule1-node2} 93 | rule1-node1 #{"b"} 94 | rule1-node2 #{"b"} 95 | "b" #{rule2-node1 rule2-node2} 96 | rule2-node1 #{"c"} 97 | rule2-node2 #{"c"}} 98 | :backward-edges {rule1-node1 #{"a"} 99 | rule1-node2 #{"a"} 100 | "b" #{rule1-node1 rule1-node2} 101 | rule2-node1 #{"b"} 102 | rule2-node2 #{"b"} 103 | "c" #{rule2-node1 rule2-node2}}})] 104 | 105 | (is (= actual-graph expected-graph)))) 106 | 107 | (tu/def-rules-test test-duplicate-fact-from-different-rules 108 | {:rules [a-rule [[[?a <- "a"]] 109 | (cr/insert! "c") 110 | {:salience 1}] 111 | b-rule [[[?b <- "b"]] 112 | (cr/insert! "c")]] 113 | :sessions [empty-session [a-rule b-rule] {:cache false :fact-type-fn identity}]} 114 | (let [actual-graph (-> empty-session 115 | (cr/insert "a" "b") 116 | cr/fire-rules 117 | g/session->fact-graph) 118 | 119 | expected-graph (let [rule1-node (g/map->RuleActivationNode {:rule-name "a-rule" 120 | :id 1}) 121 | rule2-node (g/map->RuleActivationNode {:rule-name "b-rule" 122 | :id 2})] 123 | 124 | {:forward-edges {"a" #{rule1-node} 125 | "b" #{rule2-node} 126 | rule1-node #{"c"} 127 | rule2-node #{"c"}} 128 | :backward-edges {rule1-node #{"a"} 129 | rule2-node #{"b"} 130 | "c" #{rule1-node rule2-node}}})] 131 | 132 | (is (= expected-graph actual-graph)))) 133 | -------------------------------------------------------------------------------- /src/test/clojure/clara/generative/test_accum.clj: -------------------------------------------------------------------------------- 1 | (ns clara.generative.test-accum 2 | (:require [clara.rules :refer :all] 3 | [clojure.test :refer :all] 4 | [clara.rules.testfacts :refer :all] 5 | [clara.rules.accumulators :as acc] 6 | [clara.rules.dsl :as dsl] 7 | [schema.test] 8 | [clara.generative.generators :as gen]) 9 | (:import [clara.rules.testfacts 10 | Temperature 11 | WindSpeed 12 | Cold 13 | TemperatureHistory 14 | ColdAndWindy])) 15 | 16 | (use-fixtures :once schema.test/validate-schemas) 17 | 18 | (deftest test-simple-all-condition-binding-groups 19 | (let [r (dsl/parse-rule [[?ts <- (acc/all) :from [Temperature (= ?loc location)]]] 20 | ;; The all accumulator can return facts in different orders, so we sort 21 | ;; the temperatures to make asserting on the output easier. 22 | (insert! (->TemperatureHistory [?loc (sort (map :temperature ?ts))]))) 23 | 24 | q (dsl/parse-query [] [[?history <- TemperatureHistory]]) 25 | 26 | empty-session (mk-session [r q] :cache false)] 27 | 28 | (let [operations [{:type :insert 29 | :facts [(->Temperature 11 "MCI")]} 30 | {:type :insert 31 | :facts [(->Temperature 19 "MCI")]} 32 | {:type :insert 33 | :facts [(->Temperature 1 "ORD")]} 34 | {:type :insert 35 | :facts [(->Temperature 22 "LAX")]} 36 | {:type :retract 37 | :facts [(->Temperature 22 "LAX")]} 38 | ;; Note that a :fire operation is added to the end later. If this is at the end, 39 | ;; then it should be functionally the same as if we only had one at the end. 40 | ;; On the other hand, a fire operation in the middle of the operations could potentially 41 | ;; reveal bugs. 42 | {:type :fire}] 43 | 44 | operation-permutations (gen/ops->permutations operations {}) 45 | 46 | expected-output? (fn [session permutation] 47 | (let [actual-temp-hist (-> session 48 | (query q) 49 | frequencies) 50 | expected-temp-hist (frequencies [{:?history (->TemperatureHistory ["MCI" [11 19]])} 51 | {:?history (->TemperatureHistory ["ORD" [1]])}])] 52 | (= actual-temp-hist expected-temp-hist)))] 53 | 54 | (doseq [permutation (map #(concat % [{:type :fire}]) operation-permutations) 55 | :let [session (gen/session-run-ops empty-session permutation)]] 56 | (is (expected-output? session permutation) 57 | (str "Failure for operation permutation: " 58 | \newline 59 | ;; Put into a vector so that the str implementation shows the elements of the collection, 60 | ;; not just LazySeq. 61 | (into [] permutation) 62 | \newline 63 | "Output was: " 64 | \newline 65 | (into [] (query session q)))))) 66 | 67 | (let [operations (mapcat (fn [fact] 68 | [{:type :insert 69 | :facts [fact]} 70 | {:type :retract 71 | :facts [fact]}]) 72 | [(->Temperature 10 "MCI") 73 | (->Temperature 20 "MCI") 74 | (->Temperature 15 "LGA") 75 | (->Temperature 25 "LGA")]) 76 | 77 | operation-permutations (gen/ops->permutations operations {})] 78 | 79 | (doseq [permutation (map #(concat % [{:type :fire}]) operation-permutations) 80 | :let [session (gen/session-run-ops empty-session permutation) 81 | output (query session q)]] 82 | (is (empty? output) 83 | (str "Non-empty result for operation permutation: " 84 | \newline 85 | (into [] permutation) 86 | "Output was: " 87 | (into [] output))))))) 88 | 89 | (deftest test-min-accum-with-binding-groups 90 | (let [coldest-rule (dsl/parse-rule [[?coldest-temp <- (acc/min :temperature :returns-fact true) 91 | :from [ColdAndWindy (= ?w windspeed)]]] 92 | (insert! (->Cold (:temperature ?coldest-temp)))) 93 | cold-query (dsl/parse-query [] [[?c <- Cold]]) 94 | 95 | empty-session (mk-session [coldest-rule cold-query] :cache false) 96 | 97 | operations [{:type :insert 98 | :facts [(->ColdAndWindy 10 20)]} 99 | {:type :insert 100 | :facts [(->ColdAndWindy 5 20)]} 101 | {:type :retract 102 | :facts [(->ColdAndWindy 5 20)]} 103 | {:type :insert 104 | :facts [(->ColdAndWindy 20 20)]} 105 | {:type :insert 106 | :facts [(->ColdAndWindy 0 30)]} 107 | {:type :fire}] 108 | 109 | operation-permutations (gen/ops->permutations operations {})] 110 | 111 | (doseq [permutation (map #(concat % [{:type :fire}]) operation-permutations) 112 | :let [session (gen/session-run-ops empty-session permutation) 113 | output (query session cold-query)]] 114 | (is (= (frequencies output) 115 | {{:?c (->Cold 0)} 1 116 | {:?c (->Cold 10)} 1}) 117 | (str "The minimum cold temperatures per windspeed are not correct for permutation: " 118 | \newline 119 | (into [] permutation) 120 | \newline 121 | "The output was: " 122 | (into [] output)))))) 123 | 124 | (deftest test-min-accum-without-binding-groups 125 | (let [coldest-rule (dsl/parse-rule [[?coldest <- (acc/min :temperature) :from [Cold]]] 126 | (insert! (->Temperature ?coldest "MCI"))) 127 | temp-query (dsl/parse-query [] [[Temperature (= ?t temperature)]]) 128 | 129 | empty-session (mk-session [coldest-rule temp-query] :cache false)] 130 | 131 | (doseq [temp-1 (range 5) 132 | temp-2 (range 5) 133 | temp-3 (range 5) 134 | 135 | :let [operations [{:type :insert 136 | :facts [(->Cold temp-1)]} 137 | {:type :insert 138 | :facts [(->Cold temp-2)]} 139 | {:type :insert 140 | :facts [(->Cold temp-3)]} 141 | {:type :retract 142 | :facts [(->Cold temp-3)]} 143 | {:type :fire}]] 144 | 145 | permutation (map #(concat % [{:type :fire}]) 146 | (gen/ops->permutations operations {})) 147 | 148 | :let [session (gen/session-run-ops empty-session permutation) 149 | output (query session temp-query)]] 150 | 151 | (is (= output 152 | [{:?t (min temp-1 temp-2)}]) 153 | (str "Did not find the correct minimum temperature for permutation: " 154 | \newline 155 | (into [] permutation) 156 | \newline 157 | "Output was: " 158 | \newline 159 | (into [] output)))))) 160 | -------------------------------------------------------------------------------- /src/test/common/clara/test_exists.cljc: -------------------------------------------------------------------------------- 1 | #?(:clj 2 | (ns clara.test-exists 3 | (:require [clara.tools.testing-utils :refer [def-rules-test] :as tu] 4 | [clara.rules :refer [fire-rules 5 | insert 6 | insert-all 7 | insert-unconditional! 8 | insert! 9 | retract 10 | query]] 11 | 12 | [clara.rules.testfacts :refer [->Temperature ->Cold ->WindSpeed 13 | ->ColdAndWindy]] 14 | [clojure.test :refer [is deftest run-tests testing use-fixtures]] 15 | [clara.rules.accumulators] 16 | [schema.test :as st]) 17 | (:import [clara.rules.testfacts 18 | Temperature 19 | Cold 20 | WindSpeed 21 | ColdAndWindy])) 22 | 23 | :cljs 24 | (ns clara.test-exists 25 | (:require [clara.rules :refer [fire-rules 26 | insert 27 | insert! 28 | insert-all 29 | insert-unconditional! 30 | retract 31 | query]] 32 | [clara.rules.testfacts :refer [->Temperature Temperature 33 | ->Cold Cold 34 | ->WindSpeed WindSpeed 35 | ->ColdAndWindy ColdAndWindy]] 36 | [clara.rules.accumulators] 37 | [cljs.test] 38 | [schema.test :as st]) 39 | (:require-macros [clara.tools.testing-utils :refer [def-rules-test]] 40 | [cljs.test :refer [is deftest run-tests testing use-fixtures]]))) 41 | 42 | (use-fixtures :once st/validate-schemas #?(:clj tu/opts-fixture)) 43 | 44 | (def-rules-test test-simple-exists 45 | {:queries [has-windspeed [[] [[:exists [WindSpeed (= ?location location)]]]]] 46 | 47 | :sessions [empty-session [has-windspeed] {}]} 48 | 49 | ;; An empty session should produce no results. 50 | (is (empty? (query empty-session has-windspeed))) 51 | 52 | ;; Should only match one windspeed despite multiple inserts. 53 | (is (= [{:?location "MCI"}] 54 | (-> empty-session 55 | (insert (->WindSpeed 50 "MCI")) 56 | (insert (->WindSpeed 60 "MCI")) 57 | fire-rules 58 | (query has-windspeed)))) 59 | 60 | ;; Retraction should remove exists check. 61 | (is (empty? 62 | (-> empty-session 63 | (insert (->WindSpeed 50 "MCI")) 64 | (insert (->WindSpeed 60 "MCI")) 65 | (retract (->WindSpeed 50 "MCI")) 66 | (retract (->WindSpeed 60 "MCI")) 67 | fire-rules 68 | (query has-windspeed)))) 69 | 70 | ;; There should be one location for each distinct binding. 71 | (is (= #{{:?location "MCI"} {:?location "SFO"} {:?location "ORD"}} 72 | (-> empty-session 73 | (insert (->WindSpeed 50 "MCI")) 74 | (insert (->WindSpeed 60 "MCI")) 75 | (insert (->WindSpeed 60 "SFO")) 76 | (insert (->WindSpeed 80 "SFO")) 77 | (insert (->WindSpeed 80 "ORD")) 78 | (insert (->WindSpeed 90 "ORD")) 79 | fire-rules 80 | (query has-windspeed) 81 | (set))))) 82 | 83 | (def-rules-test test-exists-with-conjunction 84 | {:queries [wind-and-temp [[] [[:exists [Temperature (= ?location location)]] 85 | [:exists [WindSpeed (= ?location location)]]]]] 86 | 87 | :sessions [empty-session [wind-and-temp] {}]} 88 | 89 | ;; An empty session should produce no results. 90 | (is (empty? (query empty-session wind-and-temp))) 91 | 92 | ;; A match of one exist but not the other should yield nothing. 93 | (is (empty? 94 | (-> empty-session 95 | (insert (->WindSpeed 50 "MCI")) 96 | (insert (->WindSpeed 60 "MCI")) 97 | fire-rules 98 | (query wind-and-temp)))) 99 | 100 | ;; Differing locations should not yield a match. 101 | (is (empty? 102 | (-> empty-session 103 | (insert (->WindSpeed 50 "MCI")) 104 | (insert (->Temperature 60 "ORD")) 105 | fire-rules 106 | (query wind-and-temp)))) 107 | 108 | ;; Simple match for both exists. 109 | (is (= [{:?location "MCI"}] 110 | (-> empty-session 111 | (insert (->WindSpeed 50 "MCI")) 112 | (insert (->WindSpeed 60 "MCI")) 113 | (insert (->Temperature 60 "MCI")) 114 | (insert (->Temperature 70 "MCI")) 115 | fire-rules 116 | (query wind-and-temp)))) 117 | 118 | ;; There should be a match for each distinct city. 119 | (is (= #{{:?location "MCI"} {:?location "ORD"}} 120 | (-> empty-session 121 | (insert (->WindSpeed 50 "MCI")) 122 | (insert (->WindSpeed 60 "ORD")) 123 | (insert (->Temperature 60 "MCI")) 124 | (insert (->Temperature 70 "ORD")) 125 | fire-rules 126 | (query wind-and-temp) 127 | (set))))) 128 | 129 | (def-rules-test test-exists-inside-boolean-conjunction-and-disjunction 130 | 131 | {:rules [or-rule [[[:or 132 | [:exists [ColdAndWindy]] 133 | [:exists [Temperature (< temperature 20)]]]] 134 | (insert! (->Cold nil))] 135 | 136 | and-rule [[[:and 137 | [:exists [ColdAndWindy]] 138 | [:exists [Temperature (< temperature 20)]]]] 139 | (insert! (->Cold nil))]] 140 | 141 | :queries [cold-query [[] [[Cold (= ?t temperature)]]]] 142 | 143 | :sessions [or-session [or-rule cold-query] {} 144 | and-session [and-rule cold-query] {}]} 145 | 146 | (is (empty? (-> or-session 147 | fire-rules 148 | (query cold-query))) 149 | "Verify that :exists under an :or does not fire if nothing meeting the :exists is present") 150 | 151 | (is (= (-> or-session 152 | (insert (->ColdAndWindy 10 10)) 153 | fire-rules 154 | (query cold-query)) 155 | [{:?t nil}]) 156 | "Validate that :exists can match under a boolean :or condition.") 157 | 158 | (is (empty? (-> and-session 159 | (insert (->ColdAndWindy 10 10)) 160 | fire-rules 161 | (query cold-query))) 162 | "Validate that :exists under an :and condition without both conditions does not cause the rule to fire.") 163 | 164 | (is (= (-> and-session 165 | (insert (->ColdAndWindy 10 10) (->Temperature 10 "MCI")) 166 | fire-rules 167 | (query cold-query)) 168 | [{:?t nil}]) 169 | "Validate that :exists can match under a boolean :and condition.")) 170 | 171 | ;; Test of the performance optimization in https://github.com/cerner/clara-rules/issues/298 172 | ;; The idea is that if inserting additional items beyond the first causes a retraction and then 173 | ;; rebuilding of the Rete network an unconditional insertion will happen twice. 174 | (def-rules-test test-additional-item-noop 175 | 176 | {:rules [exists-rule [[[:exists [Temperature (< temperature 0)]]] 177 | (insert-unconditional! (->Cold :freezing))]] 178 | 179 | :queries [cold-query [[] [[Cold (= ?t temperature)]]]] 180 | 181 | :sessions [empty-session [exists-rule cold-query] {}]} 182 | 183 | (is (= [{:?t :freezing}] 184 | (-> empty-session 185 | (insert (->Temperature -10 "INV")) 186 | (fire-rules) 187 | (insert (->Temperature -10 "INV")) 188 | fire-rules 189 | (query cold-query))))) 190 | -------------------------------------------------------------------------------- /src/main/clojure/clara/tools/tracing.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.tools.tracing 2 | "Support for tracing state changes in a Clara session." 3 | (:require [clara.rules.listener :as l] 4 | [clara.rules.engine :as eng])) 5 | 6 | (declare to-tracing-listener) 7 | 8 | (deftype PersistentTracingListener [trace] 9 | l/IPersistentEventListener 10 | (to-transient [listener] 11 | (to-tracing-listener listener))) 12 | 13 | (declare append-trace) 14 | 15 | (deftype TracingListener [trace] 16 | l/ITransientEventListener 17 | (left-activate! [listener node tokens] 18 | (append-trace listener {:type :left-activate :node-id (:id node) :tokens tokens})) 19 | 20 | (left-retract! [listener node tokens] 21 | (append-trace listener {:type :left-retract :node-id (:id node) :tokens tokens})) 22 | 23 | (right-activate! [listener node elements] 24 | (append-trace listener {:type :right-activate :node-id (:id node) :elements elements})) 25 | 26 | (right-retract! [listener node elements] 27 | (append-trace listener {:type :right-retract :node-id (:id node) :elements elements})) 28 | 29 | (insert-facts! [listener node token facts] 30 | (append-trace listener {:type :add-facts :node node :token token :facts facts})) 31 | 32 | (alpha-activate! [listener node facts] 33 | (append-trace listener {:type :alpha-activate :facts facts})) 34 | 35 | (insert-facts-logical! [listener node token facts] 36 | (append-trace listener {:type :add-facts-logical :node node :token token :facts facts})) 37 | 38 | (retract-facts! [listener node token facts] 39 | (append-trace listener {:type :retract-facts :node node :token token :facts facts})) 40 | 41 | (alpha-retract! [listener node facts] 42 | (append-trace listener {:type :alpha-retract :facts facts})) 43 | 44 | (retract-facts-logical! [listener node token facts] 45 | (append-trace listener {:type :retract-facts-logical :node node :token token :facts facts})) 46 | 47 | (add-accum-reduced! [listener node join-bindings result fact-bindings] 48 | (append-trace listener {:type :accum-reduced 49 | :node-id (:id node) 50 | :join-bindings join-bindings 51 | :result result 52 | :fact-bindings fact-bindings})) 53 | 54 | (remove-accum-reduced! [listener node join-bindings fact-bindings] 55 | (append-trace listener {:type :remove-accum-reduced 56 | :node-id (:id node) 57 | :join-bindings join-bindings 58 | :fact-bindings fact-bindings})) 59 | 60 | (add-activations! [listener node activations] 61 | (append-trace listener {:type :add-activations :node-id (:id node) :tokens (map :token activations)})) 62 | 63 | (remove-activations! [listener node activations] 64 | (append-trace listener {:type :remove-activations :node-id (:id node) :activations activations})) 65 | 66 | (fire-activation! [listener activation resulting-operations] 67 | (append-trace listener {:type :fire-activation :activation activation :resulting-operations resulting-operations})) 68 | 69 | (fire-rules! [listener node] 70 | (append-trace listener {:type :fire-rules :node-id (:id node)})) 71 | 72 | (activation-group-transition! [listener previous-group new-group] 73 | (append-trace listener {:type :activation-group-transition :new-group new-group :previous-group previous-group})) 74 | 75 | (to-persistent! [listener] 76 | (PersistentTracingListener. @trace))) 77 | 78 | (defn- to-tracing-listener [^PersistentTracingListener listener] 79 | (TracingListener. (atom (.-trace listener)))) 80 | 81 | (defn- append-trace 82 | "Appends a trace event and returns a new listener with it." 83 | [^TracingListener listener event] 84 | (reset! (.-trace listener) (conj @(.-trace listener) event))) 85 | 86 | (defn tracing-listener 87 | "Creates a persistent tracing event listener" 88 | [] 89 | (PersistentTracingListener. [])) 90 | 91 | (defn is-tracing? 92 | "Returns true if the given session has tracing enabled, false otherwise." 93 | [session] 94 | (let [{:keys [listeners]} (eng/components session)] 95 | (boolean (some #(instance? PersistentTracingListener %) listeners)))) 96 | 97 | (defn with-tracing 98 | "Returns a new session identical to the given one, but with tracing enabled. 99 | The given session is returned unmodified if tracing is already enabled." 100 | [session] 101 | (if (is-tracing? session) 102 | session 103 | (eng/with-listener session (PersistentTracingListener. [])))) 104 | 105 | (defn without-tracing 106 | "Returns a new session identical to the given one, but with tracing disabled 107 | The given session is returned unmodified if tracing is already disabled." 108 | [session] 109 | (eng/remove-listeners session (partial instance? PersistentTracingListener))) 110 | 111 | (defn get-trace 112 | "Returns the trace from the given session." 113 | [session] 114 | (if-let [listener (->> (eng/components session) 115 | :listeners 116 | (filter #(instance? PersistentTracingListener %)) 117 | (first))] 118 | (.-trace ^PersistentTracingListener listener) 119 | (throw (ex-info "No tracing listener attached to session." {:session session})))) 120 | 121 | (defn listener->trace 122 | [listener] 123 | (let [tracing-listener (cond 124 | (instance? PersistentTracingListener listener) 125 | listener 126 | 127 | (some (partial instance? PersistentTracingListener) (l/flatten-listener listener)) 128 | (first (filter (partial instance? PersistentTracingListener) (l/flatten-listener listener))))] 129 | (when tracing-listener 130 | (.-trace ^PersistentTracingListener tracing-listener)))) 131 | 132 | 133 | (defn ^:private node-id->productions 134 | "Given a session and a node ID return a list of the rule and query names associated 135 | with the node." 136 | [session id] 137 | (let [node (-> session eng/components :rulebase :id-to-node (get id))] 138 | (into [] 139 | (comp 140 | (map second) 141 | cat 142 | (map second)) 143 | (eng/get-conditions-and-rule-names node)))) 144 | 145 | (defn ranked-productions 146 | "Given a session with tracing enabled, return a map of rule and query names 147 | to a numerical index that represents an approximation of the proportional 148 | amount of times Clara performed processing related to this rule. This 149 | is not intended to have a precise meaning, and is intended solely as a means 150 | to provide a rough guide to which rules and queries should be considered 151 | the first suspects when diagnosing performance problems in rules sessions. 152 | It is possible for a relatively small number of interactions to take a long 153 | time if those interactions are particularly costly. It is expected that 154 | the results may change between different versions when Clara's internals change, 155 | for example to optimize the rules network. Nevertheless, it is anticipated 156 | that this will provide useful information for a first pass at rules 157 | performance problem debugging. This should not be used to drive user logic. 158 | 159 | This currently returns a Clojure array map in order to conveniently have the rules 160 | with the most interactions printed first in the string representation of the map." 161 | [session] 162 | (let [node-ids (->> session 163 | get-trace 164 | (map :node-id)) 165 | 166 | production-names (into [] 167 | (comp 168 | (map (partial node-id->productions session)) 169 | cat) 170 | node-ids) 171 | 172 | production-name->interactions (frequencies production-names) 173 | 174 | ranked-tuples (reverse (sort-by second production-name->interactions))] 175 | 176 | (apply array-map (into [] cat ranked-tuples)))) 177 | -------------------------------------------------------------------------------- /src/main/clojure/clara/rules/schema.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.rules.schema 2 | "Schema definition of Clara data structures using Prismatic's Schema library. This includes structures for rules and queries, as well as the schema 3 | for the underlying Rete network itself. This can be used by tools or other libraries working with rules." 4 | (:require [schema.core :as s])) 5 | 6 | 7 | (s/defn condition-type :- (s/enum :or :not :and :exists :fact :accumulator :test) 8 | "Returns the type of node in a LHS condition expression." 9 | [condition] 10 | (if (map? condition) ; Leaf nodes are maps, per the schema 11 | 12 | (cond 13 | (:type condition) :fact 14 | (:accumulator condition) :accumulator 15 | :else :test) 16 | 17 | ;; Otherwise the node must a sequential that starts with the boolean operator. 18 | (first condition))) 19 | 20 | 21 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 22 | ;; Rule and query structure schema. 23 | 24 | (def SExpr 25 | (s/pred seq? "s-expression")) 26 | 27 | (def FactCondition 28 | {:type s/Any ;(s/either s/Keyword (s/pred symbol?)) 29 | :constraints [SExpr] 30 | ;; Original constraints preserved for tooling in case a transformation was applied to the condition. 31 | (s/optional-key :original-constraints) [SExpr] 32 | (s/optional-key :fact-binding) s/Keyword 33 | (s/optional-key :args) s/Any 34 | }) 35 | 36 | (def AccumulatorCondition 37 | {:accumulator s/Any 38 | :from FactCondition 39 | (s/optional-key :result-binding) s/Keyword}) 40 | 41 | (def TestCondition 42 | {:constraints [SExpr]}) 43 | 44 | (def LeafCondition 45 | (s/conditional 46 | :type FactCondition 47 | :accumulator AccumulatorCondition 48 | :else TestCondition)) 49 | 50 | (declare Condition) 51 | 52 | (def BooleanCondition 53 | [(s/one (s/enum :or :not :and :exists) "operator") 54 | (s/recursive #'Condition)]) 55 | 56 | (def Condition 57 | (s/conditional 58 | sequential? BooleanCondition 59 | map? LeafCondition)) 60 | 61 | (def Rule 62 | {;; :ns-name is currently used to eval the :rhs form of a rule in the same 63 | ;; context that it was originally defined in. It is optional and only used 64 | ;; when given. It may be used for other purposes in the future. 65 | (s/optional-key :ns-name) s/Symbol 66 | (s/optional-key :name) (s/cond-pre s/Str s/Keyword) 67 | (s/optional-key :doc) s/Str 68 | (s/optional-key :props) {s/Keyword s/Any} 69 | (s/optional-key :env) {s/Keyword s/Any} 70 | :lhs [Condition] 71 | :rhs s/Any}) 72 | 73 | (def Query 74 | {(s/optional-key :name) (s/cond-pre s/Str s/Keyword) 75 | (s/optional-key :doc) s/Str 76 | (s/optional-key :props) {s/Keyword s/Any} 77 | (s/optional-key :env) {s/Keyword s/Any} 78 | :lhs [Condition] 79 | :params #{s/Keyword}}) 80 | 81 | (def Production 82 | (s/conditional 83 | :rhs Rule 84 | :else Query)) 85 | 86 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 87 | ;; Schema for the Rete network itself. 88 | 89 | (def ConditionNode 90 | {:node-type (s/enum :join :negation :test :accumulator) 91 | :condition LeafCondition 92 | 93 | ;; Captured environment in which the condition was defined, like closed variables. 94 | ;; Most rules (such as those defined by defrule) have no surrounding 95 | ;; environment, but user generated rules might. 96 | (s/optional-key :env) {s/Keyword s/Any} 97 | 98 | ;; Variables used to join to other expressions in the network. 99 | (s/optional-key :join-bindings) #{s/Keyword} 100 | 101 | ;; Variable bindings used by expressions in this node. 102 | :used-bindings #{s/Keyword} 103 | 104 | ;; Variable bindings used in the constraints that are not present in the ancestors of this node. 105 | :new-bindings #{s/Keyword} 106 | 107 | ;; An expression used to filter joined data. 108 | (s/optional-key :join-filter-expressions) LeafCondition 109 | 110 | ;; Bindings used to perform non-hash joins in the join filter expression. 111 | ;; this is a subset of :used-bindings. 112 | (s/optional-key :join-filter-join-bindings) #{s/Keyword} 113 | 114 | ;; The expression to create the accumulator. 115 | (s/optional-key :accumulator) s/Any 116 | 117 | ;; The optional fact or accumulator result binding. 118 | (s/optional-key :result-binding) s/Keyword}) 119 | 120 | (def ProductionNode 121 | {:node-type (s/enum :production :query) 122 | 123 | ;; Rule for rule nodes. 124 | (s/optional-key :production) Rule 125 | 126 | ;; Query for query nodes. 127 | (s/optional-key :query) Query 128 | 129 | ;; Bindings used in the rule right-hand side. 130 | (s/optional-key :bindings) #{s/Keyword}}) 131 | 132 | ;; Alpha network schema. 133 | (def AlphaNode 134 | {:id s/Int 135 | :condition FactCondition 136 | ;; Opional environment for the alpha node. 137 | (s/optional-key :env) {s/Keyword s/Any} 138 | ;; IDs of the beta nodes that are the children. 139 | :beta-children [s/Num]}) 140 | 141 | ;; A graph representing the beta side of the rete network. 142 | (def BetaGraph 143 | {;; Edges from parent to child nodes. 144 | :forward-edges {s/Int #{s/Int}} 145 | 146 | ;; Edges from child to parent nodes. 147 | :backward-edges {s/Int #{s/Int}} 148 | 149 | ;; Map of identifier to condition nodes. 150 | :id-to-condition-node {s/Int (s/cond-pre (s/eq :clara.rules.compiler/root-condition) 151 | ConditionNode)} 152 | 153 | ;; Map of identifier to query or rule nodes. 154 | :id-to-production-node {s/Int ProductionNode} 155 | 156 | ;; Map of identifier to new bindings created by the corresponding node. 157 | :id-to-new-bindings {s/Int #{s/Keyword}}}) 158 | 159 | (defn tuple 160 | "Given `items`, a list of schemas, will generate a schema to validate that a vector contains and is in the order provided 161 | by `items`." 162 | [& items] 163 | (s/constrained [s/Any] 164 | (fn [tuple-vals] 165 | (and (= (count tuple-vals) 166 | (count items)) 167 | (every? nil? (map s/check items tuple-vals)))) 168 | "tuple")) 169 | 170 | (def NodeCompilationValue 171 | (s/constrained {s/Keyword s/Any} 172 | (fn [compilation] 173 | (let [expr-keys #{:alpha-expr :action-expr :join-filter-expr :test-expr :accum-expr}] 174 | (some expr-keys (keys compilation)))) 175 | "node-compilation-value")) 176 | 177 | (def NodeCompilationContext 178 | (s/constrained NodeCompilationValue 179 | (fn [compilation] 180 | (let [xor #(and (or %1 %2) 181 | (not (and %1 %2)))] 182 | (and (contains? compilation :compile-ctx) 183 | (contains? (:compile-ctx compilation) :msg) 184 | (xor (contains? (:compile-ctx compilation) :condition) 185 | (contains? (:compile-ctx compilation) :production))))) 186 | "node-compilation-context")) 187 | 188 | ;; A map of [ ] to SExpression, used in compilation of the rulebase. 189 | (def NodeExprLookup 190 | ;; schema should be NodeCompilationContext in standard compilation, 191 | ;; but during serde it might be either as :compile-ctx is only used for compilation failures 192 | ;; and can be disabled post compilation. 193 | {(tuple s/Int s/Keyword) (tuple SExpr (s/conditional :compile-ctx NodeCompilationContext 194 | :else NodeCompilationValue))}) 195 | 196 | ;; An evaluated version of the schema mentioned above. 197 | (def NodeFnLookup 198 | ;; This schema uses a relaxed version of NodeCompilationContext as once the expressions 199 | ;; have been eval'd there is technically no need for compile-ctx to be maintained except for 200 | ;; deserialization. In such events the compile-ctx would only be valuable when the environment 201 | ;; where the Session is being deserialized doesn't match that of the serialization, ie functions 202 | ;; and symbols cannot be resolved on the deserialization side. 203 | {(tuple s/Int s/Keyword) (tuple (s/pred ifn? "ifn?") NodeCompilationValue)}) -------------------------------------------------------------------------------- /src/test/clojurescript/clara/test_rules.cljs: -------------------------------------------------------------------------------- 1 | (ns clara.test-rules 2 | (:require-macros [cljs.test :refer (is deftest run-tests testing)] 3 | [clara.rules.test-rules-data]) 4 | (:require [cljs.test :as t] 5 | [clara.rules.engine :as eng] 6 | [clara.rules.accumulators :as acc] 7 | [clara.rules :refer [insert retract fire-rules query insert!] 8 | :refer-macros [defrule defsession defquery]] 9 | [clara.rules.testfacts :refer [->Temperature Temperature 10 | ->WindSpeed WindSpeed 11 | ->ColdAndWindy ColdAndWindy]])) 12 | 13 | (comment 14 | ;; Launch browser repl. 15 | (cemerick.piggieback/cljs-repl :repl-env (cemerick.austin/exec-env)) 16 | ) 17 | 18 | (defn- has-fact? [token fact] 19 | (some #{fact} (map first (:matches token)))) 20 | 21 | (def simple-defrule-side-effect (atom nil)) 22 | (def other-defrule-side-effect (atom nil)) 23 | 24 | (defrule test-rule 25 | [Temperature (< temperature 20)] 26 | => 27 | (reset! other-defrule-side-effect ?__token__) 28 | (reset! simple-defrule-side-effect ?__token__)) 29 | 30 | (defquery cold-query 31 | [] 32 | [Temperature (< temperature 20) (== ?t temperature)]) 33 | 34 | ;; Accumulator for getting the lowest temperature. 35 | (def lowest-temp (acc/min :temperature)) 36 | 37 | (defquery coldest-query 38 | [] 39 | [?t <- lowest-temp :from [Temperature]]) 40 | 41 | (defrule is-cold-and-windy 42 | "Rule to determine whether it is indeed cold and windy." 43 | 44 | (Temperature (< temperature 20) (== ?t temperature)) 45 | (WindSpeed (> windspeed 30) (== ?w windspeed)) 46 | => 47 | (insert! (->ColdAndWindy ?t ?w))) 48 | 49 | (defrule is-cold-and-windy-map 50 | "A rule which uses a custom type on a map, to determine whether it 51 | is indeed cold and windy" 52 | 53 | [:temp [{degrees :degrees}] (< degrees 20) (== ?t degrees)] 54 | [:wind [{mph :mph}] (> mph 30) (== ?w mph)] 55 | => 56 | (insert! {:type :cold-and-windy 57 | :temp ?t 58 | :wind ?w})) 59 | 60 | (defrule throw-on-bad-temp 61 | "Rule to test exception flow." 62 | [Temperature (> temperature 10000) (= ?t temperature)] 63 | => 64 | (throw (ex-info "Bad temperature!" {:temp ?t}))) 65 | 66 | (defquery find-cold-and-windy 67 | [] 68 | [?fact <- ColdAndWindy]) 69 | 70 | (defquery find-cold-and-windy-map 71 | [] 72 | [?fact <- :cold-and-windy]) 73 | 74 | (defquery wind-without-temperature 75 | [] 76 | [WindSpeed (== ?w windspeed)] 77 | [:not [Temperature]]) 78 | 79 | (defquery wind-with-temperature 80 | [] 81 | [WindSpeed (== ?w windspeed) (== ?loc location)] 82 | [Temperature (== ?t temperature) (== ?loc location)]) 83 | 84 | ;; The idea here is that Number will resolve to java.lang.Number in a Clojure environment, 85 | ;; so this validates that we correctly handle symbols in a ClojureScript rule that happen 86 | ;; to resolve to something in a Clojure environment. Since ClojureScript's compiler 87 | ;; is in Clojure failing to handle this correctly can cause us to attempt to embed 88 | ;; Java objects in ClojureScript code, which won't work. See issue 300. 89 | (defrecord Number [value]) 90 | 91 | (defquery num-query 92 | [] 93 | [?n <- Number]) 94 | 95 | (defsession my-session 'clara.test-rules) 96 | (defsession my-session-map 'clara.test-rules :fact-type-fn :type) 97 | (defsession my-session-data (clara.rules.test-rules-data/weather-rules)) 98 | 99 | (deftest test-number-query 100 | (is (= (-> my-session 101 | (insert (->Number 5)) 102 | fire-rules 103 | (query num-query)) 104 | [{:?n (->Number 5)}]))) 105 | 106 | (deftest test-simple-defrule 107 | (let [session (insert my-session (->Temperature 10 "MCI"))] 108 | 109 | (fire-rules session) 110 | 111 | (is (has-fact? @simple-defrule-side-effect (->Temperature 10 "MCI"))) 112 | (is (has-fact? @other-defrule-side-effect (->Temperature 10 "MCI"))))) 113 | 114 | (deftest test-simple-query 115 | (let [session (-> my-session 116 | (insert (->Temperature 15 "MCI")) 117 | (insert (->Temperature 10 "MCI")) 118 | (insert (->Temperature 80 "MCI")) 119 | fire-rules)] 120 | 121 | ;; The query should identify all items that wer einserted and matchd the 122 | ;; expected criteria. 123 | (is (= #{{:?t 15} {:?t 10}} 124 | (set (query session cold-query)))))) 125 | 126 | (deftest test-simple-accumulator 127 | (let [session (-> my-session 128 | (insert (->Temperature 15 "MCI")) 129 | (insert (->Temperature 10 "MCI")) 130 | (insert (->Temperature 80 "MCI")) 131 | fire-rules)] 132 | 133 | ;; Accumulator returns the lowest value. 134 | (is (= #{{:?t 10}} 135 | (set (query session coldest-query)))))) 136 | 137 | (deftest test-simple-insert 138 | (let [session (-> my-session 139 | (insert (->Temperature 15 "MCI")) 140 | (insert (->WindSpeed 45 "MCI")) 141 | (fire-rules))] 142 | 143 | (is (= #{{:?fact (->ColdAndWindy 15 45)}} 144 | (set 145 | (query session find-cold-and-windy)))))) 146 | 147 | (deftest test-simple-insert-map 148 | 149 | (let [session (-> my-session-map 150 | (insert {:type :temp :degrees 15}) 151 | (insert {:type :wind :mph 45}) 152 | (fire-rules))] 153 | (is (= #{{:?fact {:type :cold-and-windy :temp 15 :wind 45}}} 154 | (set 155 | (query session find-cold-and-windy-map)))))) 156 | 157 | (deftest test-simple-insert-data 158 | 159 | (let [session (-> my-session-data 160 | (insert (->Temperature 15 "MCI")) 161 | (insert (->WindSpeed 45 "MCI")) 162 | (fire-rules))] 163 | (is (= #{{:?fact (->ColdAndWindy 15 45)}} 164 | (set 165 | (query session "clara.rules.test-rules-data/find-cold-and-windy-data")))))) 166 | 167 | (deftest test-no-temperature 168 | 169 | ;; Test that a temperature cancels the match. 170 | (let [session (-> my-session 171 | (insert (->Temperature 15 "MCI")) 172 | (insert (->WindSpeed 45 "MCI")) 173 | (fire-rules))] 174 | 175 | (is (= #{} 176 | (set 177 | (query session wind-without-temperature))))) 178 | 179 | ;; Now test the no temperature scenario. 180 | (let [session (-> my-session 181 | (insert (->WindSpeed 45 "MCI")) 182 | (fire-rules))] 183 | 184 | (is (= #{{:?w 45}} 185 | (set 186 | (query session wind-without-temperature)))))) 187 | 188 | 189 | (deftest test-simple-join 190 | 191 | (let [session (-> my-session 192 | (insert (->Temperature 15 "MCI")) 193 | (insert (->WindSpeed 45 "MCI")) 194 | (fire-rules))] 195 | 196 | (is (= #{{:?w 45 :?t 15 :?loc "MCI"}} 197 | (set 198 | (query session wind-with-temperature)))))) 199 | 200 | (deftest test-throw-rhs 201 | 202 | (try 203 | (-> my-session 204 | (insert (->Temperature 999999 "MCI")) 205 | (fire-rules)) 206 | (catch :default e 207 | 208 | (is (= {:?t 999999} 209 | (:bindings (ex-data e)))) 210 | (is (= "clara.test-rules/throw-on-bad-temp" 211 | (:name (ex-data e))))))) 212 | 213 | (deftest test-remove-pending-rule-activation 214 | (let [no-activations-session (-> my-session 215 | (insert (->Temperature -10 "ORD") 216 | (->WindSpeed 50 "ORD")) 217 | (retract (->WindSpeed 50 "ORD")) 218 | fire-rules) 219 | 220 | one-activation-session (-> my-session 221 | (insert (->Temperature -10 "ORD") 222 | (->WindSpeed 50 "ORD") 223 | (->WindSpeed 50 "ORD")) 224 | (retract (->WindSpeed 50 "ORD")) 225 | fire-rules)] 226 | 227 | (is (= (query no-activations-session find-cold-and-windy) [])) 228 | (is (= (query one-activation-session find-cold-and-windy) 229 | [{:?fact (->ColdAndWindy -10 50)}])))) 230 | 231 | ;;; Basic test of keyword names 232 | (defsession my-session-data-with-keyword-names (clara.rules.test-rules-data/weather-rules-with-keyword-names)) 233 | (deftest test-simple-insert-data-with-keyword-names 234 | 235 | (let [session (-> my-session-data-with-keyword-names 236 | (insert (->Temperature 15 "MCI")) 237 | (insert (->WindSpeed 45 "MCI")) 238 | (fire-rules))] 239 | (is (= [{:?fact (->ColdAndWindy 15 45)}] 240 | (query session :clara.rules.test-rules-data/find-cold-and-windy-data))))) -------------------------------------------------------------------------------- /src/main/clojure/clara/rules/accumulators.cljc: -------------------------------------------------------------------------------- 1 | (ns clara.rules.accumulators 2 | "A set of common accumulators usable in Clara rules." 3 | (:require [clara.rules.engine :as eng] 4 | [clojure.set :as set] 5 | [schema.core :as s]) 6 | (:refer-clojure :exclude [min max distinct count])) 7 | 8 | (defn accum 9 | "Creates a new accumulator. Users are encouraged to use a pre-defined 10 | accumulator in this namespace if one fits their needs. (See min, max, all, 11 | distinct, and others in this namespace.) This function 12 | exists for cases where a custom accumulator is necessary. 13 | 14 | The following properties are accepted. 15 | 16 | * An initial-value to be used with the reduced operations. 17 | * A reduce-fn that can be used with the Clojure Reducers library to reduce items. 18 | * An optional combine-fn that can be used with the Clojure Reducers library to combine reduced items. 19 | * An optional retract-fn that can remove a retracted fact from a previously reduced computation. 20 | * An optional convert-return-fn that converts the reduced data into something useful to the caller. 21 | Simply uses identity by default. 22 | " 23 | [{:keys [initial-value reduce-fn combine-fn retract-fn convert-return-fn] :as accum-map}] 24 | 25 | ;; Validate expected arguments are present. 26 | (s/validate {(s/optional-key :initial-value) s/Any 27 | (s/optional-key :combine-fn) s/Any 28 | (s/optional-key :convert-return-fn) s/Any 29 | :reduce-fn s/Any 30 | (s/optional-key :retract-fn) s/Any} 31 | accum-map) 32 | 33 | (eng/map->Accumulator 34 | (merge {;; Default conversion does nothing, so use identity. 35 | :convert-return-fn identity} 36 | accum-map))) 37 | 38 | (defn- drop-one-of 39 | "Removes one instance of the given value from the sequence." 40 | [items value] 41 | (let [pred #(not= value %)] 42 | (into (empty items) 43 | cat 44 | [(take-while pred items) 45 | (rest (drop-while pred items))]))) 46 | 47 | (defn reduce-to-accum 48 | "Creates an accumulator using a given reduce function with optional initial value and 49 | conversion to the final result. 50 | 51 | For example, a a simple function that return a Temperature fact with the highest value: 52 | 53 | (acc/reduce-to-accum 54 | (fn [previous value] 55 | (if previous 56 | (if (> (:temperature value) (:temperature previous)) 57 | value 58 | previous) 59 | value))) 60 | 61 | Note that the above example produces the same result as 62 | (clara.rules.accumulators/max :temperature :returns-fact true), 63 | and users should prefer to use built-in accumulators when possible. This funciton exists to easily 64 | convert arbitrary reduce functions to an accumulator. 65 | 66 | Callers may optionally pass in an initial value (which defaults to nil), 67 | a function to transform the value returned by the reduce (which defaults to identity), 68 | and a function to combine two reduced results (which uses the reduce-fn to add new 69 | items to the same reduced value by default)." 70 | 71 | ([reduce-fn] 72 | (reduce-to-accum reduce-fn nil)) 73 | ([reduce-fn initial-value] 74 | (reduce-to-accum reduce-fn initial-value identity)) 75 | ([reduce-fn initial-value convert-return-fn] 76 | (reduce-to-accum reduce-fn initial-value convert-return-fn nil)) 77 | ([reduce-fn initial-value convert-return-fn combine-fn] 78 | (accum (cond-> {:initial-value initial-value 79 | :reduce-fn reduce-fn 80 | :convert-return-fn convert-return-fn} 81 | combine-fn (assoc :combine-fn combine-fn))))) 82 | 83 | (let [grouping-fn (fnil conj [])] 84 | (defn grouping-by 85 | "Return a generic grouping accumulator. Behaves like clojure.core/group-by. 86 | 87 | * `field` - required - The field of a fact to group by. 88 | * `convert-return-fn` - optional - Converts the resulting grouped 89 | data. Defaults to clojure.core/identity." 90 | ([field] 91 | (grouping-by field identity)) 92 | ([field convert-return-fn] 93 | {:pre [(ifn? convert-return-fn)]} 94 | (reduce-to-accum 95 | (fn [m x] 96 | (let [v (field x)] 97 | (update m v grouping-fn x))) 98 | {} 99 | convert-return-fn)))) 100 | 101 | (defn- comparison-based 102 | "Creates a comparison-based result such as min or max" 103 | [field comparator returns-fact] 104 | (let [reduce-fn (fn [previous value] 105 | (if previous 106 | (if (comparator (field previous) (field value)) 107 | previous 108 | value) 109 | value)) 110 | 111 | convert-return-fn (if returns-fact 112 | identity 113 | field)] 114 | (accum 115 | {:reduce-fn reduce-fn 116 | :convert-return-fn convert-return-fn}))) 117 | 118 | (defn min 119 | "Returns an accumulator that returns the minimum value of a given field. 120 | 121 | The caller may provide the following options: 122 | 123 | * :returns-fact Returns the fact rather than the field value if set to true. Defaults to false." 124 | [field & {:keys [returns-fact]}] 125 | (comparison-based field < returns-fact)) 126 | 127 | (defn max 128 | "Returns an accumulator that returns the maximum value of a given field. 129 | 130 | The caller may provide the following options: 131 | 132 | * :returns-fact Returns the fact rather than the field value if set to true. Defaults to false." 133 | [field & {:keys [returns-fact]}] 134 | (comparison-based field > returns-fact)) 135 | 136 | (defn average 137 | "Returns an accumulator that returns the average value of a given field." 138 | [field] 139 | (accum 140 | {:initial-value [0 0] 141 | :reduce-fn (fn [[value count] item] 142 | [(+ value (field item)) (inc count)]) 143 | :retract-fn (fn [[value count] retracted] 144 | [(- value (field retracted)) (dec count)]) 145 | :combine-fn (fn [[value1 count1] [value2 count2]] 146 | [(+ value1 value2) (+ count1 count2)]) 147 | :convert-return-fn (fn [[value count]] 148 | (if (= 0 count) 149 | nil 150 | (/ value count)))})) 151 | 152 | (defn sum 153 | "Returns an accumulator that returns the sum of values of a given field" 154 | [field] 155 | (accum 156 | {:initial-value 0 157 | :reduce-fn (fn [total item] 158 | (+ total (field item))) 159 | :retract-fn (fn [total item] 160 | (- total (field item))) 161 | :combine-fn +})) 162 | 163 | (defn count 164 | "Returns an accumulator that simply counts the number of matching facts" 165 | [] 166 | (accum 167 | {:initial-value 0 168 | :reduce-fn (fn [count value] (inc count)) 169 | :retract-fn (fn [count retracted] (dec count)) 170 | :combine-fn +})) 171 | 172 | (defn exists 173 | "Returns an accumulator that accumulates to true if at least one fact 174 | exists and nil otherwise, the latter causing the accumulator condition to not match." 175 | [] 176 | (assoc (count) :convert-return-fn (fn [v] 177 | ;; This specifically needs to return nil rather than false if the pos? predicate is false so that 178 | ;; the accumulator condition will fail to match; the accumulator will consider 179 | ;; boolean false a valid match. See https://github.com/cerner/clara-rules/issues/182#issuecomment-217142418 180 | ;; and the following comments for the original discussion around suppressing nil accumulator 181 | ;; return values but propagating boolean false. 182 | (when (pos? v) 183 | true)))) 184 | 185 | (defn distinct 186 | "Returns an accumulator producing a distinct set of facts. 187 | If given a field, returns a distinct set of values for that field." 188 | ([] (distinct identity)) 189 | ([field] 190 | (accum 191 | {:initial-value {} 192 | :reduce-fn (fn [freq-map value] (update freq-map (field value) (fnil inc 0))) 193 | :retract-fn (fn [freq-map retracted-item] 194 | (let [item-field (field retracted-item) 195 | current (get freq-map item-field)] 196 | (if (= 1 current) 197 | (dissoc freq-map item-field) 198 | (update freq-map item-field dec)))) 199 | :convert-return-fn (comp set keys)}))) 200 | 201 | (defn all 202 | "Returns an accumulator that preserves all accumulated items. 203 | If given a field, returns all values in that field." 204 | ([] 205 | (accum 206 | {:initial-value [] 207 | :reduce-fn (fn [items value] (conj items value)) 208 | :retract-fn (fn [items retracted] (drop-one-of items retracted))})) 209 | ([field] 210 | (accum 211 | {:initial-value [] 212 | :reduce-fn (fn [items value] (conj items (field value))) 213 | :retract-fn (fn [items retracted] (drop-one-of items (field retracted)))}))) 214 | -------------------------------------------------------------------------------- /src/test/common/clara/test_simple_rules.cljc: -------------------------------------------------------------------------------- 1 | ;; These are tests that validate elementary function of the rules engine like 2 | ;; inserting and retracting facts. They don't fit very well with specialized 3 | ;; test namespaces due to this simplicity. This functionality is transitively 4 | ;; tested by numerous other tests, but there is some value in having direct tests 5 | ;; in case the complexity of those tests obscured a simpler issue. 6 | #?(:clj 7 | (ns clara.test-simple-rules 8 | (:require [clara.tools.testing-utils :refer [def-rules-test 9 | side-effect-holder] :as tu] 10 | [clara.rules :refer [fire-rules 11 | insert 12 | insert-all 13 | insert-all! 14 | insert! 15 | retract 16 | query]] 17 | 18 | [clara.rules.testfacts :refer [->Temperature ->Cold ->WindSpeed 19 | ->ColdAndWindy ->LousyWeather]] 20 | [clojure.test :refer [is deftest run-tests testing use-fixtures]] 21 | [clara.rules.accumulators] 22 | [schema.test :as st]) 23 | (:import [clara.rules.testfacts 24 | Temperature 25 | Cold 26 | WindSpeed 27 | ColdAndWindy 28 | LousyWeather])) 29 | 30 | :cljs 31 | (ns clara.test-simple-rules 32 | (:require [clara.rules :refer [fire-rules 33 | insert 34 | insert! 35 | insert-all 36 | insert-all! 37 | retract 38 | query]] 39 | [clara.rules.testfacts :refer [->Temperature Temperature 40 | ->Cold Cold 41 | ->WindSpeed WindSpeed 42 | ->ColdAndWindy ColdAndWindy 43 | ->LousyWeather LousyWeather]] 44 | [clara.rules.accumulators] 45 | [cljs.test] 46 | [schema.test :as st] 47 | [clara.tools.testing-utils :refer [side-effect-holder] :as tu]) 48 | (:require-macros [clara.tools.testing-utils :refer [def-rules-test]] 49 | [cljs.test :refer [is deftest run-tests testing use-fixtures]]))) 50 | 51 | (use-fixtures :once st/validate-schemas #?(:clj tu/opts-fixture)) 52 | (use-fixtures :each tu/side-effect-holder-fixture) 53 | 54 | (defn- has-fact? [token fact] 55 | (some #{fact} (map first (:matches token)))) 56 | 57 | (def-rules-test test-simple-rule 58 | 59 | {:rules [cold-rule [[[Temperature (< temperature 20)]] 60 | (reset! side-effect-holder ?__token__)]] 61 | 62 | :sessions [empty-session [cold-rule] {}]} 63 | 64 | (-> empty-session 65 | (insert (->Temperature 10 "MCI")) 66 | (fire-rules)) 67 | 68 | (is (has-fact? @side-effect-holder (->Temperature 10 "MCI")))) 69 | 70 | (def-rules-test test-simple-insert 71 | 72 | {:rules [cold-rule [[[Temperature (< temperature 20) (= ?t temperature)]] 73 | (insert! (->Cold ?t))]] 74 | 75 | :queries [cold-query [[] [[Cold (= ?c temperature)]]]] 76 | 77 | :sessions [empty-session [cold-rule cold-query] {}]} 78 | 79 | (let [session (-> empty-session 80 | (insert (->Temperature 10 "MCI")) 81 | (fire-rules))] 82 | 83 | (is (= #{{:?c 10}} 84 | (set (query session cold-query)))))) 85 | 86 | (def-rules-test test-simple-insert-all 87 | 88 | {:rules [cold-lousy-rule [[[Temperature (< temperature 20) (= ?t temperature)]] 89 | (insert-all! [(->Cold ?t) (->LousyWeather)])]] 90 | 91 | :queries [cold-lousy-query [[] [[Cold (= ?c temperature)] 92 | [LousyWeather]]]] 93 | 94 | :sessions [empty-session [cold-lousy-rule cold-lousy-query] {}]} 95 | 96 | (let [session (-> empty-session 97 | (insert (->Temperature 10 "MCI")) 98 | (fire-rules))] 99 | 100 | (is (= #{{:?c 10}} 101 | (set (query session cold-lousy-query)))))) 102 | 103 | (def-rules-test test-multiple-condition-rule 104 | 105 | {:rules [cold-windy-rule [[[Temperature (< temperature 20)] 106 | [WindSpeed (> windspeed 25)]] 107 | (reset! side-effect-holder ?__token__)]] 108 | 109 | :sessions [empty-session [cold-windy-rule] {}]} 110 | 111 | (let [session (-> empty-session 112 | (insert (->WindSpeed 30 "MCI")) 113 | (insert (->Temperature 10 "MCI")) 114 | fire-rules)] 115 | 116 | (is (has-fact? @side-effect-holder (->WindSpeed 30 "MCI"))) 117 | (is (has-fact? @side-effect-holder (->Temperature 10 "MCI"))))) 118 | 119 | (def-rules-test test-simple-retraction 120 | 121 | {:queries [cold-query [[] [[Temperature (< temperature 20) (= ?t temperature)]]]] 122 | 123 | :sessions [empty-session [cold-query] {}]} 124 | 125 | (let [temp (->Temperature 10 "MCI") 126 | 127 | session (-> empty-session 128 | (insert temp) 129 | fire-rules) 130 | 131 | retracted-session (-> session 132 | (retract temp) 133 | fire-rules)] 134 | 135 | ;; Ensure the item is there as expected. 136 | (is (= #{{:?t 10}} 137 | (set (query session cold-query)))) 138 | 139 | ;; Ensure the item is retracted as expected. 140 | (is (= #{} 141 | (set (query retracted-session cold-query)))))) 142 | 143 | (def-rules-test test-noop-retraction 144 | 145 | {:queries [cold-query [[] [[Temperature (< temperature 20) (= ?t temperature)]]]] 146 | 147 | :sessions [empty-session [cold-query] {}]} 148 | 149 | (let [session (-> empty-session 150 | (insert (->Temperature 10 "MCI")) 151 | ;; Ensure retracting a nonexistent item has no ill effects. 152 | (retract (->Temperature 15 "MCI")) 153 | fire-rules)] 154 | 155 | (is (= #{{:?t 10}} 156 | (set (query session cold-query)))))) 157 | 158 | (def-rules-test test-multiple-simple-rules 159 | 160 | {:rules [cold-rule [[[Temperature (< temperature 20)]] 161 | (swap! side-effect-holder assoc :cold ?__token__)] 162 | 163 | windy-rule [[[WindSpeed (> windspeed 25)]] 164 | (swap! side-effect-holder assoc :windy ?__token__)]] 165 | 166 | :sessions [empty-session [cold-rule windy-rule] {}]} 167 | 168 | (reset! side-effect-holder {}) 169 | 170 | (let [session (-> empty-session 171 | (insert (->WindSpeed 30 "MCI")) 172 | (insert (->Temperature 10 "MCI")) 173 | fire-rules)] 174 | 175 | ;; Check rule side effects contin the expected token. 176 | (is (has-fact? (:cold @side-effect-holder) (->Temperature 10 "MCI"))) 177 | 178 | (is (has-fact? (:windy @side-effect-holder) (->WindSpeed 30 "MCI"))))) 179 | 180 | (def-rules-test test-multiple-rules-same-fact 181 | 182 | {:rules [cold-rule [[[Temperature (< temperature 20)]] 183 | (swap! side-effect-holder assoc :cold ?__token__)] 184 | 185 | subzero-rule [[[Temperature (< temperature 0)]] 186 | (swap! side-effect-holder assoc :subzero ?__token__)]] 187 | 188 | :sessions [empty-session [cold-rule subzero-rule] {}]} 189 | 190 | (let [session (-> empty-session 191 | (insert (->Temperature -10 "MCI")) 192 | fire-rules)] 193 | 194 | (is (has-fact? (:cold @side-effect-holder) (->Temperature -10 "MCI") )) 195 | 196 | (is (has-fact? (:subzero @side-effect-holder) (->Temperature -10 "MCI"))))) 197 | 198 | (def-rules-test test-query-failure-when-provided-invalid-parameters 199 | 200 | {:queries [temp-query [[:?t] [[Temperature (= ?t temperature)]]]] 201 | 202 | :sessions [empty-session [temp-query] {}]} 203 | 204 | (let [session (-> empty-session 205 | (insert (->Temperature 10 "MCI")) 206 | ;; Ensure retracting a nonexistent item has no ill effects. 207 | (retract (->Temperature 15 "MCI")) 208 | fire-rules) 209 | 210 | expected-msg #"was not provided with the correct parameters"] 211 | 212 | ;; passivity test 213 | (is (= #{{:?t 10}} 214 | (set (query session temp-query :?t 10)))) 215 | 216 | (is (thrown-with-msg? #?(:clj IllegalArgumentException :cljs js/Error) 217 | expected-msg 218 | (query session temp-query :?another-param 42))) 219 | 220 | (is (thrown-with-msg? #?(:clj IllegalArgumentException :cljs js/Error) 221 | expected-msg 222 | (query session temp-query))) 223 | 224 | (is (thrown-with-msg? #?(:clj IllegalArgumentException :cljs js/Error) 225 | expected-msg 226 | (query session temp-query :?t 42 :?another-param 42))))) 227 | -------------------------------------------------------------------------------- /src/test/common/clara/test_memory.cljc: -------------------------------------------------------------------------------- 1 | #?(:clj 2 | (ns clara.test-memory 3 | (:require [clara.tools.testing-utils :refer [def-rules-test] :as tu] 4 | [clara.rules :refer [fire-rules 5 | insert 6 | insert-all 7 | insert! 8 | retract 9 | query]] 10 | [clara.rules.testfacts :refer [->Temperature ->Cold ->WindSpeed ->Hot 11 | ->ColdAndWindy ->First ->Second]] 12 | [clojure.test :refer [is deftest run-tests testing use-fixtures]] 13 | [clara.rules.accumulators :as acc] 14 | [schema.test :as st]) 15 | (:import [clara.rules.testfacts 16 | Temperature 17 | Hot 18 | Cold 19 | WindSpeed 20 | ColdAndWindy 21 | First 22 | Second])) 23 | 24 | :cljs 25 | (ns clara.test-memory 26 | (:require [clara.rules :refer [fire-rules 27 | insert 28 | insert! 29 | insert-all 30 | retract 31 | query]] 32 | [clara.rules.testfacts :refer [->Temperature Temperature 33 | ->Cold Cold 34 | ->Hot Hot 35 | ->WindSpeed WindSpeed 36 | ->ColdAndWindy ColdAndWindy 37 | ->First First 38 | ->Second Second]] 39 | [clara.rules.accumulators :as acc] 40 | [clara.tools.testing-utils :as tu] 41 | [cljs.test] 42 | [schema.test :as st]) 43 | (:require-macros [clara.tools.testing-utils :refer [def-rules-test]] 44 | [cljs.test :refer [is deftest run-tests testing use-fixtures]]))) 45 | 46 | (use-fixtures :once st/validate-schemas #?(:clj tu/opts-fixture)) 47 | 48 | ;; While the memory is tested through rules and queries, rather than direct unit tests on the memory, 49 | ;; the intent of these tests is to create patterns in the engine that cover edge cases and other paths 50 | ;; of concern in clara.rules.memory. 51 | ;; This test are here to verify https://github.com/cerner/clara-rules/issues/303 52 | (def-rules-test test-negation-complex-join-with-numerous-non-matching-facts-inserted-after-descendant-negation 53 | {:rules [] 54 | :queries [query1 [[] 55 | [[Hot (= ?t temperature)] 56 | [:not [Cold (tu/join-filter-equals ?t temperature)]]]] 57 | query2 [[] 58 | [[Hot (= ?t temperature)] 59 | [:not [Cold (= ?t temperature)]]]]] 60 | :sessions [empty-session-jfe [query1] {} 61 | empty-session-equals [query2] {}]} 62 | (let [lots-of-hot (doall (for [_ (range 100)] 63 | (->Hot 20)))] 64 | (is (= (repeat 100 {:?t 20}) 65 | (-> empty-session-jfe 66 | (insert (->Cold 10)) 67 | fire-rules 68 | (insert-all lots-of-hot) 69 | fire-rules 70 | (query query1)))) 71 | 72 | (is (= (repeat 100 {:?t 20}) 73 | (-> empty-session-equals 74 | (insert (->Cold 10)) 75 | fire-rules 76 | (insert-all lots-of-hot) 77 | fire-rules 78 | (query query2)))))) 79 | 80 | (def-rules-test test-query-for-many-added-elements 81 | {:queries [temp-query [[] [[Temperature (= ?t temperature)]]]] 82 | 83 | :sessions [empty-session [temp-query] {}]} 84 | 85 | (let [n 6000 86 | ;; Do not batch insert to expose any StackOverflowError potential 87 | ;; of stacking lazy evaluations in working memory. 88 | session (reduce insert empty-session 89 | (for [i (range n)] (->Temperature i "MCI"))) 90 | session (fire-rules session)] 91 | 92 | (is (= n 93 | (count (query session temp-query)))))) 94 | 95 | (def-rules-test test-query-for-many-added-tokens 96 | 97 | {:rules [cold-temp [[[Temperature (< temperature 30) (= ?t temperature)]] 98 | (insert! (->Cold ?t))]] 99 | 100 | :queries [cold-query [[] [[Cold (= ?t temperature)]]]] 101 | 102 | :sessions [empty-session [cold-temp cold-query] {}]} 103 | 104 | (let [n 6000 105 | 106 | ;; Do not batch insert to expose any StackOverflowError potential 107 | ;; of stacking lazy evaluations in working memory. 108 | session (reduce insert empty-session 109 | (for [i (range n)] (->Temperature (- i) "MCI"))) 110 | 111 | session (fire-rules session)] 112 | 113 | (is (= n 114 | (count (query session cold-query)))))) 115 | 116 | 117 | (def-rules-test test-many-retract-accumulated-for-same-accumulate-with-join-filter-node 118 | 119 | {:rules [count-cold-temps [[[Cold (= ?cold-temp temperature)] 120 | [?temp-count <- (acc/count) :from [Temperature (some? temperature) (<= temperature ?cold-temp)]]] 121 | (insert! {:count ?temp-count 122 | :type :temp-counter})]] 123 | 124 | :queries [cold-temp-count-query [[] [[:temp-counter [{:keys [count]}] (= ?count count)]]]] 125 | 126 | :sessions [empty-session [count-cold-temps cold-temp-count-query] {:fact-type-fn (fn [f] 127 | (or (:type f) 128 | (type f)))}]} 129 | 130 | (let [n 6000 131 | 132 | session (reduce insert empty-session 133 | ;; Insert all temperatures one at a time to ensure the 134 | ;; accumulate node will continuously re-accumulate via 135 | ;; `right-activate-reduced` to expose any StackOverflowError 136 | ;; potential of stacking lazy evaluations in working memory. 137 | (for [t (range n)] (->Temperature (- t) "MCI"))) 138 | session (-> session 139 | (insert (->Cold 30)) 140 | fire-rules)] 141 | 142 | ;; All temperatures are under the Cold temperature threshold. 143 | (is (= #{{:?count 6000}} (set (query session cold-temp-count-query)))))) 144 | 145 | (def-rules-test test-disjunctions-sharing-production-node 146 | ;; Ensures that when 'sibling' nodes are sharing a common child 147 | ;; production node, that activations are effectively retracted in some 148 | ;; TMS control flows. 149 | ;; See https://github.com/cerner/clara-rules/pull/145 for more context. 150 | 151 | {:rules [r [[[:or 152 | [First] 153 | [Second]] 154 | [?ts <- (acc/all) :from [Temperature]]] 155 | (insert! (with-meta {:ts ?ts} 156 | {:type :holder}))]] 157 | 158 | :queries [q [[] 159 | [[?h <- :holder]]]] 160 | 161 | :sessions [s [r q] {}]} 162 | 163 | (let [;; Vary the insertion order to ensure that the outcomes are the same. 164 | ;; This insertion order will cause retractions to need to be propagated 165 | ;; to the RHS production node that is shared by the nested conditions 166 | ;; of the disjunction. 167 | qres1 (-> s 168 | (insert (->First)) 169 | (insert (->Temperature 1 "MCI")) 170 | (insert (->Second)) 171 | (insert (->Temperature 2 "MCI")) 172 | fire-rules 173 | (query q) 174 | set) 175 | qres2 (-> s 176 | (insert (->First)) 177 | (insert (->Temperature 1 "MCI")) 178 | (insert (->Temperature 2 "MCI")) 179 | (insert (->Second)) 180 | fire-rules 181 | (query q) 182 | set)] 183 | (is (= qres1 qres2)))) 184 | 185 | (def-rules-test test-force-multiple-transient-transitions-activation-memory 186 | ;; The objective of this test is to verify that activation memory works 187 | ;; properly after going through persistent/transient shifts, including shifts 188 | ;; that empty it (i.e. firing the rules.) 189 | 190 | {:rules [rule [[[ColdAndWindy]] 191 | (insert! (->Cold 10))]] 192 | 193 | :queries [cold-query [[] 194 | [[Cold (= ?t temperature)]]]] 195 | 196 | :sessions [empty-session [rule cold-query] {}]} 197 | 198 | (let [windy-fact (->ColdAndWindy 20 20)] 199 | 200 | (is (= (-> empty-session 201 | (insert windy-fact) 202 | (insert windy-fact) 203 | fire-rules 204 | (query cold-query)) 205 | [{:?t 10} {:?t 10}]) 206 | "Make two insert calls forcing the memory to go through a persistent/transient transition 207 | in between insert calls.") 208 | 209 | (is (= (-> empty-session 210 | (insert windy-fact) 211 | (insert windy-fact) 212 | fire-rules 213 | (insert windy-fact) 214 | (insert windy-fact) 215 | fire-rules 216 | (query cold-query)) 217 | (repeat 4 {:?t 10})) 218 | "Validate that we can still go through a persistent/transient transition in the memory 219 | after firing rules causes the activation memory to be emptied."))) 220 | -------------------------------------------------------------------------------- /src/test/common/clara/tools/test_tracing.cljc: -------------------------------------------------------------------------------- 1 | #?(:clj 2 | (ns clara.tools.test-tracing 3 | (:require [clara.tools.testing-utils :refer [def-rules-test] :as tu] 4 | [clara.rules :refer [fire-rules 5 | insert 6 | insert-all 7 | insert! 8 | retract 9 | retract! 10 | query]] 11 | [clara.tools.tracing :as t] 12 | [clara.rules.accumulators :as acc] 13 | [clara.rules.testfacts :refer :all] 14 | [clojure.test :refer :all]) 15 | (:import [clara.rules.testfacts Temperature WindSpeed Cold Hot TemperatureHistory 16 | ColdAndWindy LousyWeather First Second Third Fourth])) 17 | 18 | :cljs 19 | (ns clara.tools.test-tracing 20 | (:require [clara.rules :refer [fire-rules 21 | insert 22 | insert! 23 | retract! 24 | insert-all 25 | retract 26 | query]] 27 | [clara.tools.tracing :as t] 28 | [clara.rules.accumulators :as acc] 29 | [clara.rules.testfacts :refer [->Temperature Temperature 30 | ->TemperatureHistory TemperatureHistory 31 | ->Hot Hot 32 | ->Cold Cold 33 | ->ColdAndWindy ColdAndWindy 34 | ->WindSpeed WindSpeed]]) 35 | (:require-macros [clara.tools.testing-utils :refer [def-rules-test]] 36 | [cljs.test :refer [is deftest run-tests testing use-fixtures]]))) 37 | 38 | (def-rules-test test-tracing-toggle 39 | {:rules [cold-rule [[[Temperature (< temperature 20)]] 40 | (println "It's cold!")]] 41 | 42 | :sessions [session [cold-rule] {}]} 43 | 44 | (is (= false (t/is-tracing? session))) 45 | 46 | (is (= true (t/is-tracing? (-> session 47 | (t/with-tracing))))) 48 | 49 | (is (= false (t/is-tracing? (-> session 50 | (t/with-tracing) 51 | (t/without-tracing)))))) 52 | 53 | (def rule-output (atom nil)) 54 | (def-rules-test test-simple-trace 55 | {:rules [cold-rule [[[Temperature (< temperature 20)]] 56 | (reset! rule-output ?__token__)]] 57 | :sessions [empty-session [cold-rule] {}]} 58 | 59 | (let [session (-> empty-session 60 | (t/with-tracing) 61 | (insert (->Temperature 10 "MCI")) 62 | (fire-rules))] 63 | 64 | ;; Ensure expected events occur in order. 65 | (is (= [:add-facts :alpha-activate :right-activate :left-activate :add-activations :fire-activation] 66 | (map :type (t/get-trace session)))))) 67 | 68 | (def-rules-test test-rhs-retraction-trace 69 | {:rules [cold-rule [[[Temperature (< temperature 20)]] 70 | (retract! (->Hot :too-hot))]] 71 | :queries [hot-query [[] 72 | [[?hot <- Hot]]]] 73 | :sessions [empty-session [cold-rule hot-query] {}]} 74 | 75 | (let [session (-> empty-session 76 | (t/with-tracing) 77 | (insert (->Hot :too-hot)) 78 | (fire-rules) 79 | (insert (->Temperature 10 "MCI")) 80 | (fire-rules))] 81 | (is (= (map :type (t/get-trace session)) 82 | [:add-facts :alpha-activate :right-activate :left-activate 83 | :add-facts :alpha-activate :right-activate :left-activate 84 | :add-activations :fire-activation :retract-facts 85 | :alpha-retract :right-retract :left-retract]) 86 | "Validate that a retract! call in the RHS side of a rule appears in the trace 87 | before the :right-retract"))) 88 | 89 | (def-rules-test test-accumulate-trace 90 | {:queries [coldest-query [[] 91 | [[?t <- (acc/min :temperature :returns-fact true) from [Temperature]]]]] 92 | :sessions [empty-session [coldest-query] {}]} 93 | 94 | (let [session (-> empty-session 95 | (t/with-tracing) 96 | (insert (->Temperature 15 "MCI")) 97 | (insert (->Temperature 10 "MCI")) 98 | (insert (->Temperature 80 "MCI")) 99 | fire-rules)] 100 | 101 | (is (= [:add-facts :alpha-activate :right-activate :accum-reduced 102 | :left-activate :add-facts :alpha-activate :right-activate 103 | :accum-reduced :left-retract :left-activate :add-facts 104 | :alpha-activate :right-activate :accum-reduced] 105 | 106 | (map :type (t/get-trace session)))))) 107 | 108 | (def-rules-test remove-accum-reduced 109 | {:queries [all-temps [[] 110 | [[?t <- (acc/all) from [Temperature]]]]] 111 | :sessions [empty-session [all-temps] {}]} 112 | 113 | (let [session (-> empty-session 114 | (t/with-tracing) 115 | fire-rules 116 | (insert (->Temperature 15 "MCI")) 117 | fire-rules)] 118 | 119 | (is (= [:add-facts :alpha-activate :right-activate :accum-reduced :left-retract :left-activate] 120 | 121 | (map :type (t/get-trace session)))))) 122 | 123 | (def-rules-test test-insert-trace 124 | {:rules [cold-rule [[[Temperature (= ?temperature temperature) (< temperature 20)]] 125 | (insert! (->Cold ?temperature))]] 126 | :sessions [empty-session [cold-rule] {}]} 127 | 128 | (let [session (-> empty-session 129 | (t/with-tracing) 130 | (insert (->Temperature 10 "MCI")) 131 | (fire-rules))] 132 | 133 | ;; Ensure expected events occur in order. 134 | (is (= [:add-facts :alpha-activate :right-activate :left-activate 135 | :add-activations :fire-activation :add-facts-logical :activation-group-transition] 136 | (map :type (t/get-trace session)))))) 137 | 138 | (def-rules-test test-insert-and-retract-trace 139 | {:rules [cold-rule [[[Temperature (= ?temperature temperature) (< temperature 20)]] 140 | (insert! (->Cold ?temperature))]] 141 | :sessions [empty-session [cold-rule] {:cache false}]} 142 | 143 | (let [session (-> empty-session 144 | (t/with-tracing) 145 | (insert (->Temperature 10 "MCI") 146 | (->Temperature 20 "MCI")) 147 | (fire-rules) 148 | (retract (->Temperature 10 "MCI")) 149 | (fire-rules)) 150 | 151 | session-trace (t/get-trace session)] 152 | 153 | ;; Ensure expected events occur in order. 154 | (is (= [:add-facts :alpha-activate :right-activate :left-activate :add-activations :fire-activation 155 | :add-facts-logical :activation-group-transition :retract-facts :alpha-retract :right-retract 156 | :left-retract :remove-activations :retract-facts-logical] 157 | (map :type session-trace))) 158 | 159 | ;; Ensure only the expected fact was indicated as retracted. 160 | (let [retraction (first (filter #(= :retract-facts-logical (:type %)) session-trace))] 161 | (is (= [(->Cold 10)] (:facts retraction)))))) 162 | 163 | (def-rules-test test-ranked-productions 164 | {:rules [temperature-rule [[[Temperature (= ?temperature temperature) (< temperature 20)]] 165 | (insert! (->Cold ?temperature))] 166 | 167 | cold-and-windy-rule [[[ColdAndWindy (= ?temperature temperature) (< temperature 20)]] 168 | (insert! (->Cold ?temperature))]] 169 | 170 | :sessions [empty-session [temperature-rule cold-and-windy-rule] {}]} 171 | 172 | (let [mostly-temp (-> empty-session 173 | t/with-tracing 174 | (insert (->Temperature 10 "MCI")) 175 | fire-rules 176 | (insert (->Temperature 10 "MCI")) 177 | fire-rules 178 | (insert (->ColdAndWindy 10 10)) 179 | fire-rules) 180 | 181 | mostly-temp-counts (t/ranked-productions mostly-temp) 182 | 183 | mostly-cold-and-windy (-> empty-session 184 | t/with-tracing 185 | (insert (->Temperature 10 "MCI")) 186 | fire-rules 187 | (insert (->ColdAndWindy 10 10)) 188 | fire-rules 189 | (insert (->ColdAndWindy 10 10)) 190 | fire-rules) 191 | 192 | mostly-cold-and-windy-counts (t/ranked-productions mostly-cold-and-windy)] 193 | 194 | (is (= (keys mostly-temp-counts) 195 | ["temperature-rule" "cold-and-windy-rule"])) 196 | 197 | (is (= (keys mostly-cold-and-windy-counts) 198 | ["cold-and-windy-rule" "temperature-rule"])) 199 | 200 | ;; Since the exact number of interactions is subject to change based on Clara's internal implementation details 201 | ;; we instead test the ratio of interaction counts instead, which should be more stable. The pattern above 202 | ;; of inserting and firing a single fact at a time prevents fact batching from impacting these ratios. 203 | (is (= (mostly-temp-counts "temperature-rule") 204 | (* 2 (mostly-temp-counts "cold-and-windy-rule")))) 205 | 206 | (is (= (mostly-cold-and-windy-counts "cold-and-windy-rule") 207 | (* 2 (mostly-cold-and-windy-counts "temperature-rule")))))) 208 | --------------------------------------------------------------------------------