task preprocessing

Update Deriver

.gitignore

@@ -14,4 +14,5 @@ pom.xml.asc
 *~
 \#*\#
 .\#*
-*experiments.clj
+/src/nal/experiments.clj
+*.log

.travis.yml

@@ -0,0 +1,14 @@
+language: clojure
+
+# Notify #nars
+notifications:
+  slack:
+    secure: eI5hj2PABtAUkpeYwiAHcFMa5pNvHFuU87uqe4qBtv0upPtu22/dLpw8l6EhhcMZlW6C8D2irrj6W5C1lujCy7u3Vpu1FeBPZbqzapyU1Hpe8YgSRdCY1dbygawZp/Av/HWzpi0aTket83F5/0dvTZK0fQTBRmAfyx17DEJscYEBH61dKVqdwBy5OVYvhQ1+QtEnt1TRJcT0AA8von9lanzx5/mWdQ6O+3BrKURWG6vvQUYEMZH43NU6lNGNV+PBGV1PSqZqbzCh/6C6/d6HauQdewr4Oubez90OquyCDpCZDoVG8eCAsZtZt+tzfJ5gjtz8+HA6GQeQB6QMLAp89m1bPwSZCqdnmQp9S8TNgm8Io3jREBh+5JIdpDXwukKT1kMPFrdDiPTEhHNJojyK3/BERGyrhf8azow+brPq0EIM9Fi/SkGa0gb9mUXY/BZ1MF7ulxxbzpLxHJYlT9QVlV9Q09/uhH4tIh0kPQhe+ntkMT1uLTfDur7CZakB5270ibreRSeK4RKdpy5SjaIN70hSwyrWoZHiED6aKEJJSO1t9Ve1jTDyWbcUZYewtBi+APcqAraja9NIlFApjBRO1jUneS4/BzNqxWZAFS7MOwMrk1xFft47hMIHoNYd7IgyB7TWSxhloNTwMyOWkdOhnPIqqCvds6M0yQCDKNBiVeM=
+services:
+  - redis-server
+jdk:
+  - oraclejdk8
+
+sudo: required
+dist: precise
+group: edge

project.clj

@@ -3,22 +3,29 @@
   :url "https://github.com/jarradh/narjure"
   :license {:name "GNU General Public License 2.0"
             :url  "http://www.gnu.org/licenses/old-licenses/gpl-2.0.html"}
-  :dependencies [[org.clojure/clojure "1.7.0"]
-                 [org.clojure/core.logic "0.8.10"]
+  :dependencies [[org.clojure/clojure "1.8.0"]
                  [instaparse "1.4.1"]
                  [com.rpl/specter "0.9.1"]
                  [org.clojure/tools.nrepl "0.2.12"]
                  [org.clojure/data.priority-map "0.0.7"]
-                 [co.paralleluniverse/pulsar "0.7.4"]
-                 [org.immutant/immutant "2.1.2"]
-                 [clj-time "0.11.0"]
-                 [com.taoensso/timbre "4.3.1"]]
-  :java-agents [[co.paralleluniverse/quasar-core "0.7.4"]]
+                 [org.clojure/core.match "0.3.0-alpha4"]
+                 [org.clojure/core.unify "0.5.5"]
+                 [org.onyxplatform/onyx "0.9.0"]
+                 [org.onyxplatform/onyx-kafka "0.9.0.1"]
+                 [com.taoensso/carmine "2.12.2"]
+                 [clj-kafka "0.3.4" :exclusions [org.apache.zookeeper/zookeeper zookeeper-clj]]
+                 [mount "0.1.10"]
+                 [aero "0.2.1"]
+                 [com.taoensso/timbre "4.1.4"]]
   :main ^:skip-aot narjure.core
   :plugins [[lein-cloverage "1.0.6"]
+            [jonase/eastwood "0.2.3"]
+            [lein-kibit "0.1.2"]
             [cider/cider-nrepl "0.11.0-SNAPSHOT"]]
+  :eastwood {:exclude-namespaces [nal.rules]}
   :target-path "target/%s"
   :repl-options {:init-ns          narjure.repl
                  :nrepl-middleware [narjure.repl/narsese-handler]}
-  :profiles {:uberjar {:aot :all}}
-  :jvm-opts ["-Dco.paralleluniverse.fibers.detectRunawayFibers=false"])
+  :profiles {:uberjar {:aot :all}
+             :test    {:dependencies [[com.stuartsierra/component "0.3.1"]]}
+             :dev     {:dependencies [[com.stuartsierra/component "0.3.1"]]}})

resources/config.edn

@@ -0,0 +1,29 @@
+{:env-config
+ {:onyx/tenancy-id #env [ONYX_ID "testcluster"]
+  :onyx.bookkeeper/server? true
+  :onyx.bookkeeper/local-quorum? #cond {:default false
+                                        :test true}
+  :onyx.bookkeeper/delete-server-data? true
+  :onyx.bookkeeper/local-quorum-ports [3196 3197 3198]
+  :onyx.bookkeeper/port 3196
+  :zookeeper/address #cond {:default #env [ZOOKEEPER "zookeeper"]
+                            :test "127.0.0.1:2188"}
+  :zookeeper/server? #cond {:default false
+                            :test true}
+  :zookeeper.server/port 2188}
+ :peer-config
+ {:onyx/tenancy-id                       #env [ONYX_ID "testcluster"]
+  :zookeeper/address                     #cond {:default #env [ZOOKEEPER "zookeeper"]
+                                                :test "127.0.0.1:2188"}
+  :onyx.peer/job-scheduler               :onyx.job-scheduler/greedy
+  :onyx.peer/zookeeper-timeout           60000
+  :onyx.messaging/allow-short-circuit?   #cond {:default true
+                                                :test false}
+  :onyx.messaging/impl                   :aeron
+  :onyx.messaging/bind-addr              #env [BIND_ADDR "localhost"]
+  :onyx.messaging/peer-port              40200
+  :onyx.messaging.aeron/embedded-driver? #cond {:default false
+                                                :test true}
+  :onyx.messaging/backpressure-strategy :high-restart-latency}
+ :redis-config
+ {:uri "redis://127.0.0.1:6379"}}

resources/default.meta.clj

@@ -0,0 +1,528 @@
+
+
+    ; Pei Wang's "Non-Axiomatic Logic" specified with a math. notation inspired DSL with given intiutive explainations:
+
+    ; The rules of NAL can be interpreted by considering the intiution behind the following two relations:
+    ; Statement:                 (A --> B):               A can stand for B
+    ; Statement about Statement: (A ==> B): If A is true so is/will be B
+    ; --> is a relation in meaning of terms while ==> is a relation of truth between statements.
+
+    ; Revision 
+    ; When a given belief is challenged by new experience a new belief2 with same content (and disjoint evidental base) 
+    ; a new revised task which sums up the evidence of both belief and belief2 is derived:
+
+    ; A A |- A  [:t/revision] (Commented out because it is already handled by belief management in java)
+
+    ; Similarity to Inheritance
+
+    (S --> P) (S <-> P) |- (S --> P) :pre [:question?] :post [:t/structural-intersection :p/judgment]
+
+    ; Inheritance to Similarity
+
+    (S <-> P) (S --> P) |- (S <-> P) :pre [:question?] :post [:t/structural-abduction :p/judgment]
+
+    ; Set Definition Similarity to Inheritance
+
+    (S <-> {P})   S |- (S --> {P}) :post [:t/identity :d/identity :allow-backward]
+    (S <-> {P})  {P} |- (S --> {P}) :post [:t/identity :d/identity :allow-backward]
+    ([S] <-> P) [S] |- ([S] --> P) :post [:t/identity :d/identity :allow-backward]
+    ([S] <-> P)   P |- ([S] --> P) :post [:t/identity :d/identity :allow-backward]
+
+    ({S} <-> {P})  {S} |- ({P} --> {S}) :post [:t/identity :d/identity :allow-backward]
+    ({S} <-> {P})  {P} |- ({P} --> {S}) :post [:t/identity :d/identity :allow-backward]
+    ([S] <-> [P]) [S] |- ([P] --> [S]) :post [:t/identity :d/identity :allow-backward]
+    ([S] <-> [P]) [P] |- ([P] --> [S]) :post [:t/identity :d/identity :allow-backward]
+
+    ; Set Definition Unwrap
+
+    ({S} <-> {P})  {S} |- (S <-> P) :post [:t/identity :d/identity :allow-backward]
+    ({S} <-> {P})  {P} |- (S <-> P) :post [:t/identity :d/identity :allow-backward]
+    ([S] <-> [P]) [S] |- (S <-> P) :post [:t/identity :d/identity :allow-backward]
+    ([S] <-> [P]) [P] |- (S <-> P) :post [:t/identity :d/identity :allow-backward]
+
+    ; Nothing is more specific than a instance so it's similar
+
+    (S --> {P})   S  |- (S <-> {P}) :post [:t/identity :d/identity :allow-backward]
+    (S --> {P}) {P} |- (S <-> {P}) :post [:t/identity :d/identity :allow-backward]
+
+    ; nothing is more general than a property so it's similar
+
+    ([S] --> P) [S] |- ([S] <-> P) :post [:t/identity :d/identity :allow-backward]
+    ([S] --> P)   P |- ([S] <-> P) :post [:t/identity :d/identity :allow-backward]
+
+    ; Truth-value functions: see TruthFunctions.java
+
+    ; Immediate Inference 
+    ; If S can stand for P P can to a certain low degree also represent the class S
+    ; If after S usually P happens then it might be a good guess that usually before P happens S happens.
+
+    (P --> S) (S --> P) |- (P --> S) :pre [:question?] :post [:t/conversion :p/judgment]
+    (P --> S) (S --> P) |- (P --> S) :pre [:question?] :post [:t/conversion :p/judgment]
+    (P ==> S) (S ==> P) |- (P ==> S) :pre [:question?] :post [:t/conversion :p/judgment]
+    (P =|> S) (S =|> P) |- (P =|> S) :pre [:question?] :post [:t/conversion :p/judgment]
+    (P =\> S) (S =/> P) |- (P =\> S) :pre [:question?] :post [:t/conversion :p/judgment]
+    (P =/> S) (S =\> P) |- (P =/> S) :pre [:question?] :post [:t/conversion :p/judgment]
+
+    ; "If not smoking lets you be healthy being not healthy may be the result of smoking"
+
+    ( --S ==> P)    P |- ( --P ==> S) :post [:t/contraposition :allow-backward]
+    ( --S ==> P)  --S |- ( --P ==> S) :post [:t/contraposition :allow-backward]
+    ( --S =|> P)    P |- ( --P =|> S) :post [:t/contraposition :allow-backward]
+    ( --S =|> P)  --S |- ( --P =|> S) :post [:t/contraposition :allow-backward]
+    ( --S =/> P)    P |- ( --P =\> S) :post [:t/contraposition :allow-backward]
+    ( --S =/> P)  --S |- ( --P =\> S) :post [:t/contraposition :allow-backward]
+    ( --S =\> P)    P |- ( --P =/> S) :post [:t/contraposition :allow-backward]
+    ( --S =\> P)  --S |- ( --P =/> S) :post [:t/contraposition :allow-backward]
+
+    ; A belief b <f c> is equal to --b <1-f c>  which is the negation rule:
+
+    (A --> B) A |- --(A --> B) :post [:t/negation :d/negation :allow-backward]
+    (A --> B) B |- --(A --> B) :post [:t/negation :d/negation :allow-backward]
+  --(A --> B) A |-   (A --> B) :post [:t/negation :d/negation :allow-backward]
+  --(A --> B) B |-   (A --> B) :post [:t/negation :d/negation :allow-backward]
+
+    (A <-> B) A |- --(A <-> B) :post [:t/negation :d/negation :allow-backward]
+    (A <-> B) B |- --(A <-> B) :post [:t/negation :d/negation :allow-backward]
+  --(A <-> B) A |-   (A <-> B) :post [:t/negation :d/negation :allow-backward]
+  --(A <-> B) B |-   (A <-> B) :post [:t/negation :d/negation :allow-backward]
+
+    (A ==> B) A |- --(A ==> B) :post [:t/negation :d/negation :allow-backward :order-for-all-same]
+    (A ==> B) B |- --(A ==> B) :post [:t/negation :d/negation :allow-backward :order-for-all-same]
+  --(A ==> B) A |-   (A ==> B) :post [:t/negation :d/negation :allow-backward :order-for-all-same]
+  --(A ==> B) B |-   (A ==> B) :post [:t/negation :d/negation :allow-backward :order-for-all-same]
+
+    (A <=> B) A |- --(A <=> B) :post [:t/negation :d/negation :allow-backward :order-for-all-same]
+    (A <=> B) B |- --(A <=> B) :post [:t/negation :d/negation :allow-backward :order-for-all-same]
+  --(A <=> B) A |-   (A <=> B) :post [:t/negation :d/negation :allow-backward :order-for-all-same]
+  --(A <=> B) B |-   (A <=> B) :post [:t/negation :d/negation :allow-backward :order-for-all-same]
+
+    ; TODO: probably make simpler by just allowing it for all tasks in general
+
+    ; inheritance-based syllogism
+    ;       (A --> B) ------- (B --> C)
+    ;            \               /
+    ;             \             /
+    ;              \           /
+    ;               \         /
+    ;                (A --> C)
+    ; If A is a special case of B and B is a special case of C so is A a special case of C (strong) the other variations are hypotheses (weak)
+
+    (A --> B) (B --> C) |- (A --> C) :pre [#(not= A C)] :post [:t/deduction :d/strong :allow-backward]
+    (A --> B) (A --> C) |- (C --> B) :pre [#(not= B C)] :post [:t/abduction :d/weak :allow-backward]
+    (A --> C) (B --> C) |- (B --> A) :pre [#(not= A B)] :post [:t/induction :d/weak :allow-backward]
+    (A --> B) (B --> C) |- (C --> A) :pre [#(not= C A)] :post [:t/exemplification :d/weak :allow-backward]
+
+    ; similarity from inheritance
+    ; If S is a special case of P and P is a special case of S then S and P are similar
+
+    (S --> P) (P --> S) |- (S <-> P) :post [:t/intersection :d/strong :allow-backward]
+
+    ; inheritance from similarty <- TODO check why this one was missing
+
+    (S <-> P) (P --> S) |- (S --> P) :post [:t/reduce-conjunction :d/strong :allow-backward]
+
+    ; similarity-based syllogism
+    ; If P and S are a special case of M then they might be similar (weak)
+    ; also if P and S are a general case of M
+
+    (P --> M) (S --> M) |- (S <-> P) :pre [#(not= S P)] :post [:t/comparison :d/weak :allow-backward]
+    (M --> P) (M --> S) |- (S <-> P) :pre [#(not= S P)] :post [:t/comparison :d/weak :allow-backward]
+
+    ; If M is a special case of P and S and M are similar then S is also a special case of P (strong)
+
+    (M --> P) (S <-> M) |- (S --> P) :pre [#(not= S P)] :post [:t/analogy :d/strong :allow-backward]
+    (P --> M) (S <-> M) |- (P --> S) :pre [#(not= S P)] :post [:t/analogy :d/strong :allow-backward]
+    (M <-> P) (S <-> M) |- (S <-> P) :pre [#(not= S P)] :post [:t/resemblance :d/strong :allow-backward]
+
+    ; inheritance-based composition
+    ; If P and S are in the intension/extension of M then union/difference and intersection can be built:
+
+    (P --> M) (S --> M) |- ((S | P) --> M) :pre [(not_set S) (not_set P) #(not= S P) (no_common_subterm S P)] :post [:t/intersection]
+                                                                                            ((S & P) --> M) :post [:t/union]
+                                                                                            ((P -i S) --> M) :post [:t/difference]
+
+    (M --> P) (M --> S) |- (M --> (P & S)) :pre [(not_set S) (not_set P) #(not= S P) (no_common_subterm S P)] :post [:t/intersection]
+                                                                                            (M --> (P | S)) :post [:t/union]
+                                                                                            (M --> (P -e S)) :post [:t/difference]
+
+    ; inheritance-based decomposition
+    ; if (S --> M) is the case and ((| S :list/A) --> M) is not the case then ((| :list/A) --> M) is not the case hence :t/decompose-positive-negative-negative
+
+    (S --> M) ((| S :list/A) --> M) |- ((| :list/A) --> M) :post [:t/decompose-positive-negative-negative]
+    (S --> M) ((& S :list/A) --> M) |- ((& :list/A) --> M) :post [:t/decompose-negative-positive-positive]
+    (S --> M) ((S -i P) --> M) |- (P --> M) :post [:t/decompose-positive-negative-positive]
+    (S --> M) ((P -i S) --> M) |- (P --> M) :post [:t/decompose-negative-negative-negative]
+
+    (M --> S) (M --> (& S :list/A)) |- (M --> (& :list/A)) :post [:t/decompose-positive-negative-negative]
+    (M --> S) (M --> (| S :list/A)) |- (M --> (| :list/A)) :post [:t/decompose-negative-positive-positive]
+    (M --> S) (M --> (S -e P)) |- (M --> P) :post [:t/decompose-positive-negative-positive]
+    (M --> S) (M --> (P -e S)) |- (M --> P) :post [:t/decompose-negative-negative-negative]
+
+    ; Set comprehension:
+
+    (C --> A) (C --> B) |- (C --> R) :pre [(set-ext? A) (union A B R)] :post [:t/union]
+    (C --> A) (C --> B) |- (C --> R) :pre [(set-int? A) (union A B R)] :post [:t/intersection]
+    (A --> C) (B --> C) |- (R --> C) :pre [(set-ext? A) (union A B R)] :post [:t/intersection]
+    (A --> C) (B --> C) |- (R --> C) :pre [(set-int? A) (union A B R)] :post [:t/union]
+
+    (C --> A) (C --> B) |- (C --> R) :pre [(set-ext? A) (intersection A B R)] :post [:t/intersection]
+    (C --> A) (C --> B) |- (C --> R) :pre [(set-int? A) (intersection A B R)] :post [:t/union]
+    (A --> C) (B --> C) |- (R --> C) :pre [(set-ext? A) (intersection A B R)] :post [:t/union]
+    (A --> C) (B --> C) |- (R --> C) :pre [(set-int? A) (intersection A B R)] :post [:t/intersection]
+
+    (C --> A) (C --> B) |- (C --> R) :pre [(difference A B R)] :post [:t/difference]
+    (A --> C) (B --> C) |- (R --> C) :pre [(difference A B R)] :post [:t/difference]
+
+    ; Set element takeout:
+
+    (C --> {:list/A}) C |- (C --> {:from/A}) :post [:t/structural-deduction]
+    (C --> [:list/A]) C |- (C --> [:from/A]) :post [:t/structural-deduction]
+    ({:list/A} --> C) C |- ({:from/A} --> C) :post [:t/structural-deduction]
+    ([:list/A] --> C) C |- ([:from/A] --> C) :post [:t/structural-deduction]
+
+    ; NAL3 single premise inference:
+
+    ((| :list/A) --> M) M |- (:from/A --> M) :post [:t/structural-deduction]
+    (M --> (& :list/A)) M |- (M --> :from/A) :post [:t/structural-deduction]
+
+    ((B -i G) --> S) S |- (B --> S) :post [:t/structural-deduction]
+    (R --> (B -e S)) R |- (R --> B) :post [:t/structural-deduction]
+
+    ; NAL4 - Transformations between products and images:
+    ; Relations and transforming them into different representations so that arguments and the relation it'self can become the subject or predicate
+
+    ((:list/A) --> M) A_i |- (A_i --> (/ M A_1..A_i.(substitute _)..A_n )) :post [:t/identity :d/identity]
+
+    (M --> (:list/A)) A_i |- ((\ M A_1..A_i.(substitute _)..A_n ) --> A_i) :post [:t/identity :d/identity]
+
+    (A_i --> (/ M A_1..A_i.(substitute _)..A_n )) M |- ((:list/A) --> M) :post [:t/identity :d/identity]
+
+    ((\ M A_1..A_i.(substitute _)..A_n ) --> A_i) M |- (M --> (:list/A)) :post [:t/identity :d/identity]
+
+    ; implication-based syllogism
+    ; (A ==> B) ------- (B ==> C)
+    ; \               /
+    ; \             /
+    ; \           /
+    ; \         /
+    ; (A ==> C)
+    ; If after S M happens and after M P happens so P happens after S
+
+    (M ==> P) (S ==> M) |- (S ==> P) :pre [#(not= S P)] :post [:t/deduction :order-for-all-same :allow-backward]
+
+    (P ==> M) (S ==> M) |- (S ==> P) :pre [#(not= S P)] :post [:t/induction :allow-backward]
+    (P =|> M) (S =|> M) |- (S =|> P) :pre [#(not= S P)] :post [:t/induction :allow-backward]
+    (P =/> M) (S =/> M) |- (S =|> P) :pre [#(not= S P)] :post [:t/induction :allow-backward]
+    (P =\> M) (S =\> M) |- (S =|> P) :pre [#(not= S P)] :post [:t/induction :allow-backward]
+
+    (M ==> P) (M ==> S) |- (S ==> P) :pre [#(not= S P)] :post [:t/abduction :allow-backward]
+    (M =/> P) (M =/> S) |- (S =|> P) :pre [#(not= S P)] :post [:t/abduction :allow-backward]
+    (M =|> P) (M =|> S) |- (S =|> P) :pre [#(not= S P)] :post [:t/abduction :allow-backward]
+    (M =\> P) (M =\> S) |- (S =|> P) :pre [#(not= S P)] :post [:t/abduction :allow-backward]
+
+    (P ==> M) (M ==> S) |- (S ==> P) :pre [#(not= S P)] :post [:t/exemplification :allow-backward]
+    (P =/> M) (M =/> S) |- (S =\> P) :pre [#(not= S P)] :post [:t/exemplification :allow-backward]
+    (P =\> M) (M =\> S) |- (S =/> P) :pre [#(not= S P)] :post [:t/exemplification :allow-backward]
+    (P =|> M) (M =|> S) |- (S =|> P) :pre [#(not= S P)] :post [:t/exemplification :allow-backward]
+
+    ; implication to equivalence
+    ; If when S happens P happens and before P happens S has happened then they are truth-related equivalent
+
+    (S ==> P) (P ==> S) |- (S <=> P) :pre [#(not= S P)] :post [:t/intersection :allow-backward]
+    (S =|> P) (P =|> S) |- (S <|> P) :pre [#(not= S P)] :post [:t/intersection :allow-backward]
+    (S =/> P) (P =\> S) |- (S </> P) :pre [#(not= S P)] :post [:t/intersection :allow-backward]
+    (S =\> P) (P =/> S) |- (P </> S) :pre [#(not= S P)] :post [:t/intersection :allow-backward]
+
+    ; equivalence-based syllogism
+    ; Same as for inheritance again
+
+    (P ==> M) (S ==> M) |- (S <=> P) :pre [#(not= S P)] :post [:t/comparison :allow-backward]
+    (P =/> M) (S =/> M) |- (S <|> P) :pre [#(not= S P)] :post [:t/comparison :allow-backward]
+                                            (S </> P) :post [:t/comparison :allow-backward]
+                                            (P </> S) :post [:t/comparison :allow-backward]
+    (P =|> M) (S =|> M) |- (S <|> P) :pre [#(not= S P)] :post [:t/comparison :allow-backward]
+    (P =\> M) (S =\> M) |- (S <|> P) :pre [#(not= S P)] :post [:t/comparison :allow-backward]
+                                            (S </> P) :post [:t/comparison :allow-backward]
+                                            (P </> S) :post [:t/comparison :allow-backward]
+
+    (M ==> P) (M ==> S) |- (S <=> P) :pre [#(not= S P)] :post [:t/comparison :allow-backward]
+    (M =/> P) (M =/> S) |- (S <|> P) :pre [#(not= S P)] :post [:t/comparison :allow-backward]
+                                            (S </> P) :post [:t/comparison :allow-backward]
+                                            (P </> S) :post [:t/comparison :allow-backward]
+    (M =|> P) (M =|> S) |- (S <|> P) :pre [#(not= S P)] :post [:t/comparison :allow-backward]
+
+    ; Same as for inheritance again
+
+    (M ==> P) (S <=> M) |- (S ==> P) :pre [#(not= S P)] :post [:t/analogy :allow-backward]
+    (M =/> P) (S </> M) |- (S =/> P) :pre [#(not= S P)] :post [:t/analogy :allow-backward]
+    (M =/> P) (S <|> M) |- (S =/> P) :pre [#(not= S P)] :post [:t/analogy :allow-backward]
+    (M =|> P) (S <|> M) |- (S =|> P) :pre [#(not= S P)] :post [:t/analogy :allow-backward]
+    (M =\> P) (M </> S) |- (S =\> P) :pre [#(not= S P)] :post [:t/analogy :allow-backward]
+    (M =\> P) (S <|> M) |- (S =\> P) :pre [#(not= S P)] :post [:t/analogy :allow-backward]
+
+    (P ==> M) (S <=> M) |- (P ==> S) :pre [#(not= S P)] :post [:t/analogy :allow-backward]
+    (P =/> M) (S <|> M) |- (P =/> S) :pre [#(not= S P)] :post [:t/analogy :allow-backward]
+    (P =|> M) (S <|> M) |- (P =|> S) :pre [#(not= S P)] :post [:t/analogy :allow-backward]
+    (P =\> M) (S </> M) |- (P =\> S) :pre [#(not= S P)] :post [:t/analogy :allow-backward]
+    (P =\> M) (S <|> M) |- (P =\> S) :pre [#(not= S P)] :post [:t/analogy :allow-backward]
+
+    (M <=> P) (S <=> M) |- (S <=> P) :pre [#(not= S P)] :post [:t/resemblance :order-for-all-same :allow-backward]
+    (M </> P) (S <|> M) |- (S </> P) :pre [#(not= S P)] :post [:t/resemblance :allow-backward]
+    (M <|> P) (S </> M) |- (S </> P) :pre [#(not= S P)] :post [:t/resemblance :allow-backward]
+
+    ; implication-based composition
+    ; Same as for inheritance again
+
+    (P ==> M) (S ==> M) |- ((P || S) ==> M) :pre [#(not= S P)] :post [:t/intersection]
+                                            ((P && S) ==> M) :post [:t/union]
+    (P =|> M) (S =|> M) |- ((P || S) =|> M) :pre [#(not= S P)] :post [:t/intersection]
+                                            ((P &| S) =|> M) :post [:t/union]
+    (P =/> M) (S =/> M) |- ((P || S) =/> M) :pre [#(not= S P)] :post [:t/intersection]
+                                            ((P &| S) =/> M) :post [:t/union]
+    (P =\> M) (S =\> M) |- ((P || S) =\> M) :pre [#(not= S P)] :post [:t/intersection]
+                                            ((P &| S) =\> M) :post [:t/union]
+
+    (M ==> P) (M ==> S) |- (M ==> (P && S)) :pre [#(not= S P)] :post [:t/intersection]
+                                            (M ==> (P || S)) :post [:t/union]
+    (M =/> P) (M =/> S) |- (M =/> (P &| S)) :pre [#(not= S P)] :post [:t/intersection]
+                                            (M =/> (P || S)) :post [:t/union]
+    (M =|> P) (M =|> S) |- (M =|> (P &| S)) :pre [#(not= S P)] :post [:t/intersection]
+                                            (M =|> (P || S)) :post [:t/union]
+    (M =\> P) (M =\> S) |- (M =\> (P &| S)) :pre [#(not= S P)] :post [:t/intersection]
+                                            (M =\> (P || S)) :post [:t/union]
+
+    (D =/> R) (D =\> K) |- (K =/> R) :pre [#(not= R K)] :post [:t/abduction]
+                                            (R =\> K) :post [:t/induction]
+                                            (K </> R) :post [:t/comparison]
+    ; implication-based decomposition
+    ; Same as for inheritance again
+
+    (S ==> M) ((|| S :list/A) ==> M) |- ((|| :list/A) ==> M) :post [:t/decompose-positive-negative-negative :order-for-all-same]
+    (S ==> M) ((&& S :list/A) ==> M) |- ((&& :list/A) ==> M) :post [:t/decompose-negative-positive-positive :order-for-all-same :seq-interval-from-premises]
+
+    (M ==> S) (M ==> (&& S :list/A)) |- (M ==> (&& :list/A)) :post [:t/decompose-positive-negative-negative :order-for-all-same :seq-interval-from-premises]
+    (M ==> S) (M ==> (|| S :list/A)) |- (M ==> (|| :list/A)) :post [:t/decompose-negative-positive-positive :order-for-all-same]
+
+    ; conditional syllogism
+    ; If after M P usually happens and M happens it means P is expected to happen
+
+    M (M ==> P) |- P :post [:t/deduction :d/induction :order-for-all-same] :pre [(shift-occurrence-forward unused "==>")]
+    M (P ==> M) |- P :post [:t/abduction :d/deduction :order-for-all-same] :pre [(shift-occurrence-backward unused "==>")]
+    M (S <=> M) |- S :post [:t/analogy :d/strong :order-for-all-same] :pre [(shift-occurrence-backward unused "<=>")]
+    M (M <=> S) |- S :post [:t/analogy :d/strong :order-for-all-same] :pre [(shift-occurrence-forward unused "==>")]
+
+    ; conditional composition:
+    ; They are let out for AGI purpose don't let the system generate conjunctions or useless <=> and ==> statements
+    ; For this there needs to be a semantic dependence between both either by the predicate or by the subject
+    ; or a temporal dependence which acts as special case of semantic dependence
+    ; These cases are handled by "Variable Introduction" and "Temporal Induction"
+
+    ; P S |- (S ==> P) :pre [(no_common_subterm S P)] :post [:t/induction]
+    ; P S |- (S <=> P) :pre [(no_common_subterm S P)] :post [:t/comparison]
+    ; P S |- (P && S) :pre [(no_common_subterm S P)] :post [:t/intersection]
+    ; P S |- (P || S) :pre [(no_common_subterm S P)] :post [:t/union]
+
+    ; conjunction decompose
+
+    (&& :list/A) A_1 |- A_1 :post [:t/structural-deduction :d/structural-strong]
+    (&/ :list/A) A_1 |- A_1 :post [:t/structural-deduction :d/structural-strong]
+    (&| :list/A) A_1 |- A_1 :post [:t/structural-deduction :d/structural-strong]
+    (&/ B :list/A) B |- (&/ :list/A) :pre [(task "!")] :post [:t/deduction :d/strong :seq-interval-from-premises]
+
+    ; propositional decomposition
+    ; If S is the case and (&& S :list/A) is not the case it can't be that (&& :list/A) is the case
+
+    S (&/ S :list/A) |- (&/ :list/A) :post [:t/decompose-positive-negative-negative :seq-interval-from-premises]
+    S (&| S :list/A) |- (&| :list/A) :post [:t/decompose-positive-negative-negative]
+    S (&& S :list/A) |- (&& :list/A) :post [:t/decompose-positive-negative-negative]
+    S (|| S :list/A) |- (|| :list/A) :post [:t/decompose-negative-positive-positive]
+
+    ; Additional for negation: https://groups.google.com/forum/#!topic/open-nars/g-7r0jjq2Vc
+
+    S (&/ (-- S) :list/A) |- (&/ :list/A) :post [:t/decompose-negative-negative-negative :seq-interval-from-premises]
+    S (&| (-- S) :list/A) |- (&| :list/A) :post [:t/decompose-negative-negative-negative]
+    S (&& (-- S) :list/A) |- (&& :list/A) :post [:t/decompose-negative-negative-negative]
+    S (|| (-- S) :list/A) |- (|| :list/A) :post [:t/decompose-positive-positive-positive]
+
+    ; multi-conditional syllogism
+    ; Inference about the pre/postconditions
+
+    Y ((&& X :list/A) ==> B) |- ((&& :list/A) ==> B) :pre [(substitute-if-unifies "$" X Y)] :post [:t/deduction :order-for-all-same :seq-interval-from-premises]
+    ((&& M :list/A) ==> C) ((&& :list/A) ==> C) |- M :post [:t/abduction :order-for-all-same]
+
+    ; Can be derived by NAL7 rules so this won't be necessary there (:order-for-all-same left out here)
+
+    ; the first rule does not have :order-for-all-same because it would be invalid see: https://groups.google.com/forum/#!topic/open-nars/r5UJo64Qhrk
+    ((&& :list/A) ==> C) M |- ((&& M :list/A) ==> C) :pre [(not-implication-or-equivalence M)] :post [:t/induction]
+    ((&& :list/A) =|> C) M |- ((&& M :list/A) =|> C) :pre [(not-implication-or-equivalence M)] :post [:t/induction]
+    ((&& :list/A) =/> C) M |- ((&& M :list/A) =/> C) :pre [(not-implication-or-equivalence M)] :post [:t/induction]
+    ((&& :list/A) =\> C) M |- ((&& M :list/A) =\> C) :pre [(not-implication-or-equivalence M)] :post [:t/induction]
+    (A ==> M) ((&& M :list/A) ==> C) |- ((&& A :list/A) ==> C) :post [:t/deduction :order-for-all-same :seq-interval-from-premises]
+    ((&& M :list/A) ==> C) ((&& A :list/A) ==> C) |- (A ==> M) :post [:t/induction :order-for-all-same]
+    (A ==> M) ((&& A :list/A) ==> C) |- ((&& M :list/A) ==> C) :post [:t/abduction :order-for-all-same :seq-interval-from-premises]
+
+    ; variable introduction
+    ; Introduce variables by common subject or predicate
+
+    (S --> M) (P --> M) |- ((P --> $X) ==> (S --> $X)) :pre [#(not= S P)] :post [:t/abduction]
+                                            ((S --> $X) ==> (P --> $X)) :post [:t/induction]
+                                            ((P --> $X) <=> (S --> $X)) :post [:t/comparison]
+                                            (&& (S --> #Y) (P --> #Y)) :post [:t/intersection]
+
+    (S --> M) (P --> M) |- ((&/ (P --> $X) I) =/> (S --> $X)) :pre [#(not= S P) (measure-time I)] :post [:t/induction :linkage-temporal]
+                                                             ((S --> $X) =\> (&/ (P --> $X) I)) :post [:t/abduction :linkage-temporal]
+                                                             ((&/ (P --> $X) I) </> (S --> $X)) :post [:t/comparison :linkage-temporal]
+                                                             (&/ (P --> #Y) I (S --> #Y)) :post [:t/intersection :linkage-temporal]
+
+    (S --> M) (P --> M) |- ((P --> $X) =|> (S --> $X)) :pre [#(not= S P) (concurrent Task Belief)] :post [:t/abduction :linkage-temporal]
+                                                                     ((S --> $X) =|> (P --> $X)) :post [:t/induction :linkage-temporal]
+                                                                     ((P --> $X) <|> (S --> $X)) :post [:t/comparison :linkage-temporal]
+                                                                     (&| (P --> #Y) (S --> #Y)) :post [:t/intersection :linkage-temporal]
+
+    (M --> S) (M --> P) |- (($X --> S) ==> ($X --> P)) :pre [#(not= S P)] :post [:t/induction]
+                                            (($X --> P) ==> ($X --> S)) :post [:t/abduction]
+                                            (($X --> S) <=> ($X --> P)) :post [:t/comparison]
+                                            (&& (#Y --> S) (#Y --> P)) :post [:t/intersection]
+
+    (M --> S) (M --> P) |- ((&/ ($X --> P) I) =/> ($X --> S)) :pre [#(not= S P) (measure-time I)] :post [:t/induction :linkage-temporal]
+                                                             (($X --> S) =\> (&/ ($X --> P) I)) :post [:t/abduction :linkage-temporal]
+                                                             ((&/ ($X --> P) I) </> ($X --> S)) :post [:t/comparison :linkage-temporal]
+                                                             (&/ (#Y --> P) I (#Y --> S)) :post [:t/intersection :linkage-temporal]
+
+    (M --> S) (M --> P) |- (($X --> S) =|> ($X --> P)) :pre [#(not= S P) (concurrent (M --> P) (M --> S))] :post [:t/induction :linkage-temporal]
+                                                                             (($X --> P) =|> ($X --> S)) :post [:t/abduction :linkage-temporal]
+                                                                             (($X --> S) <|> ($X --> P)) :post [:t/comparison :linkage-temporal]
+                                                                             (&| (#Y --> S) (#Y --> P)) :post [:t/intersection :linkage-temporal]
+
+    ; 2nd variable introduction
+
+    (A ==> (M --> P)) (M --> S) |- ((&& A ($X --> S)) ==> ($X --> P)) :pre [#(not= A (M --> S))] :post [:t/induction]
+                                                             (&& (A ==> (#Y --> P)) (#Y --> S)) :post [:t/intersection]
+
+    (&& (M --> P) :list/A) (M --> S) |- (($Y --> S) ==> (&& ($Y --> P) :list/A)) :pre [#(not= S P)] :post [:t/induction]
+                                                         (&& (#Y --> S) (#Y --> P) :list/A) :post [:t/intersection]
+
+    (A ==> (P --> M)) (S --> M) |- ((&& A (P --> $X)) ==> (S --> $X)) :pre [#(not= S P) #(not= A (S --> M))] :post [:t/abduction]
+                                                                             (&& (A ==> (P --> #Y)) (S --> #Y)) :post [:t/intersection]
+
+    (&& (P --> M) :list/A) (S --> M) |- ((S --> $Y) ==> (&& (P --> $Y) :list/A)) :pre [#(not= S P)] :post [:t/abduction]
+                                                         (&&  (S --> #Y) (P --> #Y) :list/A) :post [:t/intersection]
+
+    (A --> L) ((A --> S) ==> R) |- ((&& (#X --> L) (#X --> S)) ==> R) :post [:t/induction]
+    (A --> L) ((&& (A --> S) :list/A) ==> R) |- ((&& (#X --> L) (#X --> S) :list/A) ==> R) :pre [(substitute A #X)] :post [:t/induction]
+
+    ; dependent variable elimination
+    ; Decomposition with elimination of a variable
+
+    B (&& A :list/A) |- (&& :list/A) :pre [(task ".") (substitute-if-unifies "#" A B)] :post [:t/anonymous-analogy :d/strong :order-for-all-same :seq-interval-from-premises]
+
+    ; conditional abduction by dependent variable
+
+    ((A --> R) ==> Z) ((&& (#Y --> B) (#Y --> R) :list/A) ==> Z) |- (A --> B) :post [:t/abduction]
+    ((A --> R) ==> Z) ((&& (#Y --> B) (#Y --> R)) ==> Z) |- (A --> B) :post [:t/abduction]
+
+    ; conditional deduction "An inverse inference has been implemented as a form of deduction" https://code.google.com/p/open-nars/issues/detail?id=40&can=1
+
+    (U --> L) ((&& (#X --> L) (#X --> R)) ==> Z) |- ((U --> R) ==> Z) :post [:t/deduction]
+    (U --> L) ((&& (#X --> L) (#X --> R) :list/A) ==> Z) |- ((&& (U --> R) :list/A) ==> Z) :pre [(substitute #X U)] :post [:t/deduction]
+
+    ; independent variable elimination
+
+    B (A ==> C) |- C  [:t/deduction :order-for-all-same] :pre [(substitute-if-unifies "$" A B) (shift-occurrence-forward unused "==>")]
+    B (C ==> A) |- C  [:t/abduction :order-for-all-same] :pre [(substitute-if-unifies "$" A B) (shift-occurrence-backward unused "==>")]
+
+    B (A <=> C) |- C  [:t/deduction :order-for-all-same] :pre [(substitute-if-unifies "$" A B) (shift-occurrence-backward unused "<=>")]
+    B (C <=> A) |- C  [:t/deduction :order-for-all-same] :pre [(substitute-if-unifies "$" A B) (shift-occurrence-forward unused "<=>")]
+
+    ; second level variable handling rules
+    ; second level variable elimination (termlink level2 growth needed in order for these rules to work)
+
+    (A --> K) (&& (#X --> L) (($Y --> K) ==> (&& :list/A))) |- (&& (#X --> L) :list/A) :pre [(substitute $Y A)] :post [:t/deduction]
+    (A --> K) (($X --> L) ==> (&& (#Y --> K) :list/A)) |- (($X --> L) ==> (&& :list/A)) :pre [(substitute #Y A)] :post [:t/anonymous-analogy]
+
+    ; precondition combiner inference rule (variable_unification6):
+
+    ((&& C :list/A) ==> Z) ((&& C :list/B) ==> Z) |- ((&& :list/A) ==> (&& :list/B)) :post [:t/induction]
+    ((&& C :list/A) ==> Z) ((&& C :list/B) ==> Z) |- ((&& :list/B) ==> (&& :list/A)) :post [:t/induction]
+    (Z ==> (&& C :list/A)) (Z ==> (&& C :list/B)) |- ((&& :list/A) ==> (&& :list/B)) :post [:t/abduction]
+    (Z ==> (&& C :list/A)) (Z ==> (&& C :list/B)) |- ((&& :list/B) ==> (&& :list/A)) :post [:t/abduction]
+
+    ; NAL7 specific inference
+    ; Reasoning about temporal statements. those are using the ==> relation because relation in time is a relation of the truth between statements.
+
+    X (XI ==> B) |- B  [:t/deduction :d/induction :order-for-all-same] :pre [(substitute-if-unifies "$" XI (&/ X /0)) (shift-occurrence-forward XI "==>")]
+    X (BI ==> Y) |- BI  [:t/abduction :d/deduction :order-for-all-same] :pre [(substitute-if-unifies "$" Y X) (shift-occurrence-backward BI "==>")]
+
+    ; Temporal induction:
+    ; When P and then S happened according to an observation by induction (weak) it may be that alyways after P usually S happens.
+
+    P S |- ((&/ S I) =/> P) :pre [(measure-time I) (not-implication-or-equivalence P) (not-implication-or-equivalence S)] :post [:t/induction :linkage-temporal]
+                                                                                                   (P =\> (&/ S I)) :post [:t/abduction :linkage-temporal] 
+                                                                                                   ((&/ S I) </> P) :post [:t/comparison :linkage-temporal] 
+                                                                                                   (&/ S I P) :post [:t/intersection :linkage-temporal]
+
+
+    P S |- (S =|> P) :pre [(concurrent Task Belief) (not-implication-or-equivalence P) (not-implication-or-equivalence S)] :post [:t/induction :linkage-temporal]
+                                                                                                           (P =|> S) :post [:t/induction :linkage-temporal] 
+                                                                                                           (S <|> P) :post [:t/comparison :linkage-temporal] 
+                                                                                                           (&| S P) :post [:t/intersection :linkage-temporal]
+
+    ; backward inference is mostly handled by the rule transformation:
+
+    ; T B |- C  [post] =>
+    ; C B |- T  [post] :pre [:question?]
+    ; C T |- B  [post] :pre [:question?]
+
+    ; here now are the backward inference rules which should really only work on backward inference:
+
+    (A --> S) (B --> S) |- (A --> B) :pre [:question?] :post [:p/question]
+                                       (B --> A) :post [:p/question]
+                                       (A <-> B) :post [:p/question]
+
+    ; and the backward inference driven forward inference:
+
+    ; NAL2:
+
+    ([A] <-> [B]) (A <-> B) |- ([A] <-> [B]) :pre [:question?] :post [:t/belief-identity :p/judgment]
+    ({A} <-> {B}) (A <-> B) |- ({A} <-> {B}) :pre [:question?] :post [:t/belief-identity :p/judgment]
+
+    ([A] --> [B]) (A <-> B) |- ([A] --> [B]) :pre [:question?] :post [:t/belief-identity :p/judgment]
+    ({A} --> {B}) (A <-> B) |- ({A} --> {B}) :pre [:question?] :post [:t/belief-identity :p/judgment]
+
+    ; NAL3:
+
+    ; composition on both sides of a statement:
+
+    ((& B :list/A) --> (& A :list/A)) (B --> A) |- ((& B :list/A) --> (& A :list/A)) :pre [:question?] :post [:t/belief-structural-deduction :p/judgment]
+    ((| B :list/A) --> (| A :list/A)) (B --> A) |- ((| B :list/A) --> (| A :list/A)) :pre [:question?] :post [:t/belief-structural-deduction :p/judgment]
+
+    ((- S A) --> (- S B)) (B --> A) |- ((- S A) --> (- S B)) :pre [:question?] :post [:t/belief-structural-deduction :p/judgment]
+    ((~ S A) --> (~ S B)) (B --> A) |- ((~ S A) --> (~ S B)) :pre [:question?] :post [:t/belief-structural-deduction :p/judgment]
+
+    ; composition on one side of a statement:
+
+    (W --> (| B :list/A)) (W --> B) |- (W --> (| B :list/A)) :pre [:question?] :post [:t/belief-structural-deduction :p/judgment]
+    ((& B :list/A) --> W) (B --> W) |- ((& B :list/A) --> W) :pre [:question?] :post [:t/belief-structural-deduction :p/judgment]
+
+    (W --> (- S B)) (W --> B) |- (W --> (- S B)) :pre [:question?] :post [:t/beliefStructuralDifference :p/judgment]
+    ((~ S B) --> W) (B --> W) |- ((~ S B) --> W) :pre [:question?] :post [:t/beliefStructuralDifference :p/judgment]
+
+    ; NAL4:
+
+    ; composition on both sides of a statement:
+
+    ((B P) --> Z) (B --> A) |- ((B P) --> (A P)) :pre [:question?] :post [:t/belief-structural-deduction :p/judgment]
+    ((P B) --> Z) (B --> A) |- ((P B) --> (P A)) :pre [:question?] :post [:t/belief-structural-deduction :p/judgment]
+    ((B P) <-> Z) (B <-> A) |- ((B P) <-> (A P)) :pre [:question?] :post [:t/belief-structural-deduction :p/judgment]
+    ((P B) <-> Z) (B <-> A) |- ((P B) <-> (P A)) :pre [:question?] :post [:t/belief-structural-deduction :p/judgment]
+    ((\ N A _) --> Z) (N --> R) |- ((\ N A _) --> (\ R A _)) :pre [:question?] :post [:t/belief-structural-deduction :p/judgment]
+    ((/ N _ B) --> Z) (S --> B) |- ((/ N _ B) --> (/ N _ S)) :pre [:question?] :post [:t/belief-structural-deduction :p/judgment]
+
+    ; NAL5:
+
+  --A    A |- --A  :pre [:question?] :post [:t/belief-negation :p/judgment]
+    A  --A |-   A  :pre [:question?] :post [:t/belief-negation :p/judgment]
+
+    ; compound composition one premise
+
+    (|| B :list/A) B |- (|| B :list/A) :pre [:question?] :post [:t/belief-structural-deduction :p/judgment]

resources/default.meta.nal

@@ -0,0 +1,526 @@
+// Pei Wang's "Non-Axiomatic Logic" specified with a math. notation inspired DSL with given intiutive explainations:
+
+//The rules of NAL, can be interpreted by considering the intiution behind the following two relations:
+// Statement:                 (A --> B):               A can stand for B
+// Statement about Statement: (A ==> B): If A is true, so is/will be B
+// --> is a relation in meaning of terms, while ==> is a relation of truth between statements.
+
+//// Revision ////////////////////////////////////////////////////////////////////////////////////
+// When a given belief is challenged by new experience, a new belief2 with same content (and disjoint evidental base),
+// a new revised task, which sums up the evidence of both belief and belief2 is derived:
+
+//   A, A |- A, (Truth:Revision) (Commented out because it is already handled by belief management in java)
+
+//Similarity to Inheritance
+
+    (S --> P), (S <-> P), task("?") |- (S --> P), (Truth:StructuralIntersection, Punctuation:Judgment)
+
+//Inheritance to Similarity
+
+    (S <-> P), (S --> P), task("?") |- (S <-> P), (Truth:StructuralAbduction, Punctuation:Judgment)
+
+//Set Definition Similarity to Inheritance
+
+    (S <-> {P}),  S |- (S --> {P}), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+    (S <-> {P}), {P} |- (S --> {P}), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+    ([S] <-> P), [S] |- ([S] --> P), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+    ([S] <-> P),  P |- ([S] --> P), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+
+    ({S} <-> {P}), {S} |- ({P} --> {S}), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+    ({S} <-> {P}), {P} |- ({P} --> {S}), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+    ([S] <-> [P]), [S] |- ([P] --> [S]), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+    ([S] <-> [P]), [P] |- ([P] --> [S]), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+
+//Set Definition Unwrap
+
+    ({S} <-> {P}), {S} |- (S <-> P), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+    ({S} <-> {P}), {P} |- (S <-> P), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+    ([S] <-> [P]), [S] |- (S <-> P), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+    ([S] <-> [P]), [P] |- (S <-> P), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+
+//Nothing is more specific than a instance, so its similar
+
+    (S --> {P}),  S |- (S <-> {P}), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+    (S --> {P}), {P} |- (S <-> {P}), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+
+//nothing is more general than a property, so its similar
+
+    ([S] --> P), [S] |- ([S] <-> P), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+    ([S] --> P),  P |- ([S] <-> P), (Truth:Identity, Desire:Identity, Derive:AllowBackward)
+
+////// Truth-value functions: see TruthFunctions.java
+
+//// Immediate Inference ////////////////////////////////////////////////////////////////////////////////////
+//If S can stand for P, P can to a certain low degree also represent the class S
+//If after S usually P happens, then it might be a good guess that usually before P happens, S happens.
+
+    (P --> S), (S --> P), task("?") |- (P --> S), (Truth:Conversion, Punctuation:Judgment)
+    (P --> S), (S --> P), task("?") |- (P --> S), (Truth:Conversion, Punctuation:Judgment)
+    (P ==> S), (S ==> P), task("?") |- (P ==> S), (Truth:Conversion, Punctuation:Judgment)
+    (P =|> S), (S =|> P), task("?") |- (P =|> S), (Truth:Conversion, Punctuation:Judgment)
+    (P =\> S), (S =/> P), task("?") |- (P =\> S), (Truth:Conversion, Punctuation:Judgment)
+    (P =/> S), (S =\> P), task("?") |- (P =/> S), (Truth:Conversion, Punctuation:Judgment)
+
+// "If not smoking lets you be healthy, being not healthy may be the result of smoking"
+
+    ( --S ==> P),   P |- ( --P ==> S), (Truth:Contraposition, Derive:AllowBackward)
+    ( --S ==> P), --S |- ( --P ==> S), (Truth:Contraposition, Derive:AllowBackward)
+    ( --S =|> P),   P |- ( --P =|> S), (Truth:Contraposition, Derive:AllowBackward)
+    ( --S =|> P), --S |- ( --P =|> S), (Truth:Contraposition, Derive:AllowBackward)
+    ( --S =/> P),   P |- ( --P =\> S), (Truth:Contraposition, Derive:AllowBackward)
+    ( --S =/> P), --S |- ( --P =\> S), (Truth:Contraposition, Derive:AllowBackward)
+    ( --S =\> P),   P |- ( --P =/> S), (Truth:Contraposition, Derive:AllowBackward)
+    ( --S =\> P), --S |- ( --P =/> S), (Truth:Contraposition, Derive:AllowBackward)
+
+//A belief b <f,c> is equal to --b <1-f,c>, which is the negation rule:
+
+    (A --> B), A |- --(A --> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward)
+    (A --> B), B |- --(A --> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward)
+  --(A --> B), A |-   (A --> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward)
+  --(A --> B), B |-   (A --> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward)
+
+    (A <-> B), A |- --(A <-> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward)
+    (A <-> B), B |- --(A <-> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward)
+  --(A <-> B), A |-   (A <-> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward)
+  --(A <-> B), B |-   (A <-> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward)
+
+    (A ==> B), A |- --(A ==> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward, Order:ForAllSame)
+    (A ==> B), B |- --(A ==> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward, Order:ForAllSame)
+  --(A ==> B), A |-   (A ==> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward, Order:ForAllSame)
+  --(A ==> B), B |-   (A ==> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward, Order:ForAllSame)
+
+    (A <=> B), A |- --(A <=> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward, Order:ForAllSame)
+    (A <=> B), B |- --(A <=> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward, Order:ForAllSame)
+  --(A <=> B), A |-   (A <=> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward, Order:ForAllSame)
+  --(A <=> B), B |-   (A <=> B), (Truth:Negation, Desire:Negation, Derive:AllowBackward, Order:ForAllSame)
+
+//TODO: probably make simpler by just allowing it for all tasks in general
+
+//// inheritance-based syllogism ////////////////////////////////////////////////////////////////////////////////////
+//       (A --> B) ------- (B --> C)
+//            \               /
+//             \             /
+//              \           /
+//               \         /
+//                (A --> C)
+//If A is a special case of B, and B is a special case of C, so is A a special case of C (strong), the other variations are hypotheses (weak)
+
+    (A --> B), (B --> C), not_equal(A,C) |- (A --> C), (Truth:Deduction, Desire:Strong, Derive:AllowBackward)
+    (A --> B), (A --> C), not_equal(B,C) |- (C --> B), (Truth:Abduction, Desire:Weak, Derive:AllowBackward)
+    (A --> C), (B --> C), not_equal(A,B) |- (B --> A), (Truth:Induction, Desire:Weak, Derive:AllowBackward)
+    (A --> B), (B --> C), not_equal(C,A) |- (C --> A), (Truth:Exemplification, Desire:Weak, Derive:AllowBackward)
+
+//// similarity from inheritance ////////////////////////////////////////////////////////////////////////////////////
+//If S is a special case of P, and P is a special case of S, then S and P are similar
+
+    (S --> P), (P --> S) |- (S <-> P), (Truth:Intersection, Desire:Strong, Derive:AllowBackward)
+
+//// inheritance from similarty <- TODO check why this one was missing ////////////////////////////////////////////////////////////////////////////////////
+
+    (S <-> P), (P --> S) |- (S --> P), (Truth:ReduceConjunction, Desire:Strong, Derive:AllowBackward)
+
+//// similarity-based syllogism ////////////////////////////////////////////////////////////////////////////////////
+//If P and S are a special case of M, then they might be similar (weak),
+//also if P and S are a general case of M
+
+    (P --> M), (S --> M), not_equal(S,P) |- (S <-> P), (Truth:Comparison, Desire:Weak, Derive:AllowBackward)
+    (M --> P), (M --> S), not_equal(S,P) |- (S <-> P), (Truth:Comparison, Desire:Weak, Derive:AllowBackward)
+
+//If M is a special case of P and S and M are similar, then S is also a special case of P (strong)
+
+    (M --> P), (S <-> M), not_equal(S,P) |- (S --> P), (Truth:Analogy, Desire:Strong, Derive:AllowBackward)
+    (P --> M), (S <-> M), not_equal(S,P) |- (P --> S), (Truth:Analogy, Desire:Strong, Derive:AllowBackward)
+    (M <-> P), (S <-> M), not_equal(S,P) |- (S <-> P), (Truth:Resemblance, Desire:Strong, Derive:AllowBackward)
+
+//// inheritance-based composition ////////////////////////////////////////////////////////////////////////////////////
+//If P and S are in the intension/extension of M, then union/difference and intersection can be built:
+
+    (P --> M), (S --> M), not_set(S), not_set(P), not_equal(S,P), no_common_subterm(S,P) |- ((S | P) --> M), (Truth:Intersection),
+                                                                                            ((S & P) --> M), (Truth:Union),
+                                                                                            ((P ~ S) --> M), (Truth:Difference)
+
+    (M --> P), (M --> S), not_set(S), not_set(P), not_equal(S,P), no_common_subterm(S,P) |- (M --> (P & S)), (Truth:Intersection),
+                                                                                            (M --> (P | S)), (Truth:Union),
+                                                                                            (M --> (P - S)), (Truth:Difference)
+
+//// inheritance-based decomposition ////////////////////////////////////////////////////////////////////////////////////
+//if (S --> M) is the case, and ((|,S,A_1..n) --> M) is not the case, then ((|,A_1..n) --> M) is not the case, hence Truth:DecomposePositiveNegativeNegative
+
+    (S --> M), ((|,S,A_1..n) --> M) |- ((|,A_1..n) --> M), (Truth:DecomposePositiveNegativeNegative)
+    (S --> M), ((&,S,A_1..n) --> M) |- ((&,A_1..n) --> M), (Truth:DecomposeNegativePositivePositive)
+    (S --> M), ((S ~ P) --> M) |- (P --> M), (Truth:DecomposePositiveNegativePositive)
+    (S --> M), ((P ~ S) --> M) |- (P --> M), (Truth:DecomposeNegativeNegativeNegative)
+
+    (M --> S), (M --> (&,S,A_1..n)) |- (M --> (&,A_1..n)), (Truth:DecomposePositiveNegativeNegative)
+    (M --> S), (M --> (|,S,A_1..n)) |- (M --> (|,A_1..n)), (Truth:DecomposeNegativePositivePositive)
+    (M --> S), (M --> (S - P)) |- (M --> P), (Truth:DecomposePositiveNegativePositive)
+    (M --> S), (M --> (P - S)) |- (M --> P), (Truth:DecomposeNegativeNegativeNegative)
+
+//Set comprehension:
+
+    (C --> A), (C --> B), set_ext(A), union(A,B,R) |- (C --> R), (Truth:Union)
+    (C --> A), (C --> B), set_int(A), union(A,B,R) |- (C --> R), (Truth:Intersection)
+    (A --> C), (B --> C), set_ext(A), union(A,B,R) |- (R --> C), (Truth:Intersection)
+    (A --> C), (B --> C), set_int(A), union(A,B,R) |- (R --> C), (Truth:Union)
+
+    (C --> A), (C --> B), set_ext(A), intersection(A,B,R) |- (C --> R), (Truth:Intersection)
+    (C --> A), (C --> B), set_int(A), intersection(A,B,R) |- (C --> R), (Truth:Union)
+    (A --> C), (B --> C), set_ext(A), intersection(A,B,R) |- (R --> C), (Truth:Union)
+    (A --> C), (B --> C), set_int(A), intersection(A,B,R) |- (R --> C), (Truth:Intersection)
+
+    (C --> A), (C --> B), difference(A,B,R) |- (C --> R), (Truth:Difference)
+    (A --> C), (B --> C), difference(A,B,R) |- (R --> C), (Truth:Difference)
+
+//Set element takeout:
+
+    (C --> {A_1..n}), C |- (C --> {A_i}), (Truth:StructuralDeduction)
+    (C --> [A_1..n]), C |- (C --> [A_i]), (Truth:StructuralDeduction)
+    ({A_1..n} --> C), C |- ({A_i} --> C), (Truth:StructuralDeduction)
+    ([A_1..n] --> C), C |- ([A_i] --> C), (Truth:StructuralDeduction)
+
+//NAL3 single premise inference:
+
+    ((|,A_1..n) --> M), M |- (A_i --> M), (Truth:StructuralDeduction)
+    (M --> (&,A_1..n)), M |- (M --> A_i), (Truth:StructuralDeduction)
+
+    ((B ~ G) --> S), S |- (B --> S), (Truth:StructuralDeduction)
+    (R --> (B - S)), R |- (R --> B), (Truth:StructuralDeduction)
+
+////// NAL4 - Transformations between products and images: ////////////////////////////////////////////////////////////////////////////////////
+//Relations and transforming them into different representations so that arguments and the relation itself can become the subject or predicate
+
+    ((A_1..n) --> M), A_i |- (A_i --> (/,M, A_1..A_i.substitute(_)..A_n )), (Truth:Identity, Desire:Identity)
+
+    (M --> (A_1..n)), A_i |- ((\,M, A_1..A_i.substitute(_)..A_n ) --> A_i), (Truth:Identity, Desire:Identity)
+
+    (A_i --> (/,M,A_1..A_i.substitute(_)..A_n )), M |- ((A_1..n) --> M), (Truth:Identity, Desire:Identity)
+
+    ((\,M, A_1..A_i.substitute(_)..A_n ) --> A_i), M |- (M --> (A_1..n)), (Truth:Identity, Desire:Identity)
+
+//// implication-based syllogism ////////////////////////////////////////////////////////////////////////////////////
+//       (A ==> B) ------- (B ==> C)
+//            \               /
+//             \             /
+//              \           /
+//               \         /
+//                (A ==> C)
+//If after S M happens, and after M P happens, so P happens after S
+
+    (M ==> P), (S ==> M), not_equal(S,P) |- (S ==> P), (Truth:Deduction, Order:ForAllSame, Derive:AllowBackward)
+
+    (P ==> M), (S ==> M), not_equal(S,P) |- (S ==> P), (Truth:Induction, Derive:AllowBackward)
+    (P =|> M), (S =|> M), not_equal(S,P) |- (S =|> P), (Truth:Induction, Derive:AllowBackward)
+    (P =/> M), (S =/> M), not_equal(S,P) |- (S =|> P), (Truth:Induction, Derive:AllowBackward)
+    (P =\> M), (S =\> M), not_equal(S,P) |- (S =|> P), (Truth:Induction, Derive:AllowBackward)
+
+    (M ==> P), (M ==> S), not_equal(S,P) |- (S ==> P), (Truth:Abduction, Derive:AllowBackward)
+    (M =/> P), (M =/> S), not_equal(S,P) |- (S =|> P), (Truth:Abduction, Derive:AllowBackward)
+    (M =|> P), (M =|> S), not_equal(S,P) |- (S =|> P), (Truth:Abduction, Derive:AllowBackward)
+    (M =\> P), (M =\> S), not_equal(S,P) |- (S =|> P), (Truth:Abduction, Derive:AllowBackward)
+
+    (P ==> M), (M ==> S), not_equal(S,P) |- (S ==> P), (Truth:Exemplification, Derive:AllowBackward)
+    (P =/> M), (M =/> S), not_equal(S,P) |- (S =\> P), (Truth:Exemplification, Derive:AllowBackward)
+    (P =\> M), (M =\> S), not_equal(S,P) |- (S =/> P), (Truth:Exemplification, Derive:AllowBackward)
+    (P =|> M), (M =|> S), not_equal(S,P) |- (S =|> P), (Truth:Exemplification, Derive:AllowBackward)
+
+//// implication to equivalence ////////////////////////////////////////////////////////////////////////////////////
+//If when S happens, P happens, and before P happens, S has happened, then they are truth-related equivalent
+
+    (S ==> P), (P ==> S), not_equal(S,P) |- (S <=> P), (Truth:Intersection, Derive:AllowBackward)
+    (S =|> P), (P =|> S), not_equal(S,P) |- (S <|> P), (Truth:Intersection, Derive:AllowBackward)
+    (S =/> P), (P =\> S), not_equal(S,P) |- (S </> P), (Truth:Intersection, Derive:AllowBackward)
+    (S =\> P), (P =/> S), not_equal(S,P) |- (P </> S), (Truth:Intersection, Derive:AllowBackward)
+
+//// equivalence-based syllogism ////////////////////////////////////////////////////////////////////////////////////
+//Same as for inheritance again
+
+    (P ==> M), (S ==> M), not_equal(S,P) |- (S <=> P), (Truth:Comparison, Derive:AllowBackward)
+    (P =/> M), (S =/> M), not_equal(S,P) |- (S <|> P), (Truth:Comparison, Derive:AllowBackward),
+                                            (S </> P), (Truth:Comparison, Derive:AllowBackward),
+                                            (P </> S), (Truth:Comparison, Derive:AllowBackward)
+    (P =|> M), (S =|> M), not_equal(S,P) |- (S <|> P), (Truth:Comparison, Derive:AllowBackward)
+    (P =\> M), (S =\> M), not_equal(S,P) |- (S <|> P), (Truth:Comparison, Derive:AllowBackward),
+                                            (S </> P), (Truth:Comparison, Derive:AllowBackward),
+                                            (P </> S), (Truth:Comparison, Derive:AllowBackward)
+
+    (M ==> P), (M ==> S), not_equal(S,P) |- (S <=> P), (Truth:Comparison, Derive:AllowBackward)
+    (M =/> P), (M =/> S), not_equal(S,P) |- (S <|> P), (Truth:Comparison, Derive:AllowBackward),
+                                            (S </> P), (Truth:Comparison, Derive:AllowBackward),
+                                            (P </> S), (Truth:Comparison, Derive:AllowBackward)
+    (M =|> P), (M =|> S), not_equal(S,P) |- (S <|> P), (Truth:Comparison, Derive:AllowBackward)
+
+//Same as for inheritance again
+
+    (M ==> P), (S <=> M), not_equal(S,P) |- (S ==> P), (Truth:Analogy, Derive:AllowBackward)
+    (M =/> P), (S </> M), not_equal(S,P) |- (S =/> P), (Truth:Analogy, Derive:AllowBackward)
+    (M =/> P), (S <|> M), not_equal(S,P) |- (S =/> P), (Truth:Analogy, Derive:AllowBackward)
+    (M =|> P), (S <|> M), not_equal(S,P) |- (S =|> P), (Truth:Analogy, Derive:AllowBackward)
+    (M =\> P), (M </> S), not_equal(S,P) |- (S =\> P), (Truth:Analogy, Derive:AllowBackward)
+    (M =\> P), (S <|> M), not_equal(S,P) |- (S =\> P), (Truth:Analogy, Derive:AllowBackward)
+
+    (P ==> M), (S <=> M), not_equal(S,P) |- (P ==> S), (Truth:Analogy, Derive:AllowBackward)
+    (P =/> M), (S <|> M), not_equal(S,P) |- (P =/> S), (Truth:Analogy, Derive:AllowBackward)
+    (P =|> M), (S <|> M), not_equal(S,P) |- (P =|> S), (Truth:Analogy, Derive:AllowBackward)
+    (P =\> M), (S </> M), not_equal(S,P) |- (P =\> S), (Truth:Analogy, Derive:AllowBackward)
+    (P =\> M), (S <|> M), not_equal(S,P) |- (P =\> S), (Truth:Analogy, Derive:AllowBackward)
+
+    (M <=> P), (S <=> M), not_equal(S,P) |- (S <=> P), (Truth:Resemblance, Order:ForAllSame, Derive:AllowBackward)
+    (M </> P), (S <|> M), not_equal(S,P) |- (S </> P), (Truth:Resemblance, Derive:AllowBackward)
+    (M <|> P), (S </> M), not_equal(S,P) |- (S </> P), (Truth:Resemblance, Derive:AllowBackward)
+
+//// implication-based composition ////////////////////////////////////////////////////////////////////////////////////
+//Same as for inheritance again
+
+    (P ==> M), (S ==> M), not_equal(S,P) |- ((P || S) ==> M), (Truth:Intersection),
+                                            ((P && S) ==> M), (Truth:Union)
+    (P =|> M), (S =|> M), not_equal(S,P) |- ((P || S) =|> M), (Truth:Intersection),
+                                            ((P &| S) =|> M), (Truth:Union)
+    (P =/> M), (S =/> M), not_equal(S,P) |- ((P || S) =/> M), (Truth:Intersection),
+                                            ((P &| S) =/> M), (Truth:Union)
+    (P =\> M), (S =\> M), not_equal(S,P) |- ((P || S) =\> M), (Truth:Intersection),
+                                            ((P &| S) =\> M), (Truth:Union)
+
+    (M ==> P), (M ==> S), not_equal(S,P) |- (M ==> (P && S)), (Truth:Intersection),
+                                            (M ==> (P || S)), (Truth:Union)
+    (M =/> P), (M =/> S), not_equal(S,P) |- (M =/> (P &| S)), (Truth:Intersection),
+                                            (M =/> (P || S)), (Truth:Union)
+    (M =|> P), (M =|> S), not_equal(S,P) |- (M =|> (P &| S)), (Truth:Intersection),
+                                            (M =|> (P || S)), (Truth:Union)
+    (M =\> P), (M =\> S), not_equal(S,P) |- (M =\> (P &| S)), (Truth:Intersection),
+                                            (M =\> (P || S)), (Truth:Union)
+
+    (D =/> R), (D =\> K), not_equal(R,K) |- (K =/> R), (Truth:Abduction),
+                                            (R =\> K), (Truth:Induction),
+                                            (K </> R), (Truth:Comparison)
+//// implication-based decomposition ////////////////////////////////////////////////////////////////////////////////////
+//Same as for inheritance again
+
+    (S ==> M), ((||,S,A_1..n) ==> M) |- ((||,A_1..n) ==> M), (Truth:DecomposePositiveNegativeNegative, Order:ForAllSame)
+    (S ==> M), ((&&,S,A_1..n) ==> M) |- ((&&,A_1..n) ==> M), (Truth:DecomposeNegativePositivePositive, Order:ForAllSame, SequenceIntervals:FromPremises)
+
+    (M ==> S), (M ==> (&&,S,A_1..n)) |- (M ==> (&&,A_1..n)), (Truth:DecomposePositiveNegativeNegative, Order:ForAllSame, SequenceIntervals:FromPremises)
+    (M ==> S), (M ==> (||,S,A_1..n)) |- (M ==> (||,A_1..n)), (Truth:DecomposeNegativePositivePositive, Order:ForAllSame)
+
+//// conditional syllogism ////////////////////////////////////////////////////////////////////////////////////
+//If after M, P usually happens, and M happens, it means P is expected to happen
+
+    M, (M ==> P), shift_occurrence_forward(unused,"==>") |- P, (Truth:Deduction, Desire:Induction, Order:ForAllSame)
+    M, (P ==> M), shift_occurrence_backward(unused,"==>") |- P, (Truth:Abduction, Desire:Deduction, Order:ForAllSame)
+    M, (S <=> M), shift_occurrence_backward(unused,"<=>") |- S, (Truth:Analogy, Desire:Strong, Order:ForAllSame)
+    M, (M <=> S), shift_occurrence_forward(unused,"==>") |- S, (Truth:Analogy, Desire:Strong, Order:ForAllSame)
+
+//// conditional composition: ////////////////////////////////////////////////////////////////////////////////////
+//They are let out for AGI purpose, don't let the system generate conjunctions or useless <=> and ==> statements
+//For this there needs to be a semantic dependence between both, either by the predicate or by the subject,
+//or a temporal dependence which acts as special case of semantic dependence
+//These cases are handled by "Variable Introduction" and "Temporal Induction"
+
+//   P, S, no_common_subterm(S,P) |- (S ==> P), (Truth:Induction)
+//   P, S, no_common_subterm(S,P) |- (S <=> P), (Truth:Comparison)
+//   P, S, no_common_subterm(S,P) |- (P && S), (Truth:Intersection)
+//   P, S, no_common_subterm(S,P) |- (P || S), (Truth:Union)
+
+//// conjunction decompose
+
+    (&&,A_1..n), A_1 |- A_1, (Truth:StructuralDeduction, Desire:StructuralStrong)
+    (&/,A_1..n), A_1 |- A_1, (Truth:StructuralDeduction, Desire:StructuralStrong)
+    (&|,A_1..n), A_1 |- A_1, (Truth:StructuralDeduction, Desire:StructuralStrong)
+    (&/,B,A_1..n), B, task("!") |- (&/,A_1..n), (Truth:Deduction, Desire:Strong, SequenceIntervals:FromPremises)
+
+//// propositional decomposition ////////////////////////////////////////////////////////////////////////////////////
+//If S is the case, and (&&,S,A_1..n) is not the case, it can't be that (&&,A_1..n) is the case
+
+    S, (&/,S,A_1..n) |- (&/,A_1..n), (Truth:DecomposePositiveNegativeNegative, SequenceIntervals:FromPremises)
+    S, (&|,S,A_1..n) |- (&|,A_1..n), (Truth:DecomposePositiveNegativeNegative)
+    S, (&&,S,A_1..n) |- (&&,A_1..n), (Truth:DecomposePositiveNegativeNegative)
+    S, (||,S,A_1..n) |- (||,A_1..n), (Truth:DecomposeNegativePositivePositive)
+
+//Additional for negation: https://groups.google.com/forum/#!topic/open-nars/g-7r0jjq2Vc
+
+    S, (&/,(--,S),A_1..n) |- (&/,A_1..n), (Truth:DecomposeNegativeNegativeNegative, SequenceIntervals:FromPremises)
+    S, (&|,(--,S),A_1..n) |- (&|,A_1..n), (Truth:DecomposeNegativeNegativeNegative)
+    S, (&&,(--,S),A_1..n) |- (&&,A_1..n), (Truth:DecomposeNegativeNegativeNegative)
+    S, (||,(--,S),A_1..n) |- (||,A_1..n), (Truth:DecomposePositivePositivePositive)
+
+//// multi-conditional syllogism ////////////////////////////////////////////////////////////////////////////////////
+//Inference about the pre/postconditions
+
+    Y, ((&&,X,A_1..n) ==> B), substitute_if_unifies("$",X,Y) |- ((&&,A_1..n) ==> B), (Truth:Deduction, Order:ForAllSame, SequenceIntervals:FromPremises)
+    ((&&,M,A_1..n) ==> C), ((&&,A_1..n) ==> C) |- M, (Truth:Abduction, Order:ForAllSame)
+
+//Can be derived by NAL7 rules so this won't be necessary there (Order:ForAllSame left out here)
+
+//the first rule does not have Order:ForAllSame because it would be invalid, see: https://groups.google.com/forum/#!topic/open-nars/r5UJo64Qhrk
+    ((&&,A_1..n) ==> C), M, not_implication_or_equivalence(M) |- ((&&,M,A_1..n) ==> C), (Truth:Induction)
+    ((&&,A_1..n) =|> C), M, not_implication_or_equivalence(M) |- ((&&,M,A_1..n) =|> C), (Truth:Induction)
+    ((&&,A_1..n) =/> C), M, not_implication_or_equivalence(M) |- ((&&,M,A_1..n) =/> C), (Truth:Induction)
+    ((&&,A_1..n) =\> C), M, not_implication_or_equivalence(M) |- ((&&,M,A_1..n) =\> C), (Truth:Induction)
+    (A ==> M), ((&&,M,A_1..n) ==> C) |- ((&&,A,A_1..n) ==> C), (Truth:Deduction, Order:ForAllSame, SequenceIntervals:FromPremises)
+    ((&&,M,A_1..n) ==> C), ((&&,A,A_1..n) ==> C) |- (A ==> M), (Truth:Induction, Order:ForAllSame)
+    (A ==> M), ((&&,A,A_1..n) ==> C) |- ((&&,M,A_1..n) ==> C), (Truth:Abduction, Order:ForAllSame, SequenceIntervals:FromPremises)
+
+//// variable introduction ////////////////////////////////////////////////////////////////////////////////////
+//Introduce variables by common subject or predicate
+
+    (S --> M), (P --> M), not_equal(S,P) |- ((P --> $X) ==> (S --> $X)), (Truth:Abduction),
+                                            ((S --> $X) ==> (P --> $X)), (Truth:Induction),
+                                            ((P --> $X) <=> (S --> $X)), (Truth:Comparison),
+                                            (&&,(S --> #Y),(P --> #Y)), (Truth:Intersection)
+
+    (S --> M), (P --> M), not_equal(S,P), measure_time(I) |- ((&/,(P --> $X),I) =/> (S --> $X)), (Truth:Induction, Linkage:Temporal),
+                                                             ((S --> $X) =\> (&/,(P --> $X),I)), (Truth:Abduction, Linkage:Temporal),
+                                                             ((&/,(P --> $X),I) </> (S --> $X)), (Truth:Comparison, Linkage:Temporal),
+                                                             (&/,(P --> #Y), I, (S --> #Y)), (Truth:Intersection, Linkage:Temporal)
+
+    (S --> M), (P --> M), not_equal(S,P), concurrent(Task,Belief) |- ((P --> $X) =|> (S --> $X)), (Truth:Abduction, Linkage:Temporal),
+                                                                     ((S --> $X) =|> (P --> $X)), (Truth:Induction, Linkage:Temporal),
+                                                                     ((P --> $X) <|> (S --> $X)), (Truth:Comparison, Linkage:Temporal),
+                                                                     (&|,(P --> #Y),(S --> #Y)), (Truth:Intersection, Linkage:Temporal)
+
+    (M --> S), (M --> P), not_equal(S,P) |- (($X --> S) ==> ($X --> P)), (Truth:Induction),
+                                            (($X --> P) ==> ($X --> S)), (Truth:Abduction),
+                                            (($X --> S) <=> ($X --> P)), (Truth:Comparison),
+                                            (&&,(#Y --> S),(#Y --> P)), (Truth:Intersection)
+
+    (M --> S), (M --> P), not_equal(S,P), measure_time(I) |- ((&/,($X --> P),I) =/> ($X --> S)), (Truth:Induction, Linkage:Temporal),
+                                                             (($X --> S) =\> (&/,($X --> P),I)), (Truth:Abduction, Linkage:Temporal),
+                                                             ((&/,($X --> P),I) </> ($X --> S)), (Truth:Comparison, Linkage:Temporal),
+                                                             (&/,(#Y --> P), I ,(#Y --> S)), (Truth:Intersection, Linkage:Temporal)
+
+    (M --> S), (M --> P), not_equal(S,P), concurrent((M --> P),(M --> S)) |- (($X --> S) =|> ($X --> P)), (Truth:Induction, Linkage:Temporal),
+                                                                             (($X --> P) =|> ($X --> S)), (Truth:Abduction, Linkage:Temporal),
+                                                                             (($X --> S) <|> ($X --> P)), (Truth:Comparison, Linkage:Temporal),
+                                                                             (&|,(#Y --> S),(#Y --> P)), (Truth:Intersection, Linkage:Temporal)
+
+//// 2nd variable introduction ////////////////////////////////////////////////////////////////////////////////////
+
+    (A ==> (M --> P)), (M --> S), not_equal(A, (M --> S)) |- ((&&,A,($X --> S)) ==> ($X --> P)), (Truth:Induction),
+                                                             (&&,(A ==> (#Y --> P)), (#Y --> S)), (Truth:Intersection)
+
+    (&&,(M --> P), A_1..n), (M --> S), not_equal(S,P) |- (($Y --> S) ==> (&&,($Y --> P), A_1..n)), (Truth:Induction),
+                                                         (&&,(#Y --> S), (#Y --> P), A_1..n), (Truth:Intersection)
+
+    (A ==> (P --> M)), (S --> M), not_equal(S,P), not_equal(A, (S --> M)) |- ((&&,A,(P --> $X)) ==> (S --> $X)), (Truth:Abduction),
+                                                                             (&&,(A ==> (P --> #Y)), (S --> #Y)), (Truth:Intersection)
+
+    (&&,(P --> M), A_1..n), (S --> M), not_equal(S,P) |- ((S --> $Y) ==> (&&,(P --> $Y), A_1..n)), (Truth:Abduction),
+                                                         (&&, (S --> #Y), (P --> #Y), A_1..n), (Truth:Intersection)
+
+    (A --> L), ((A --> S) ==> R) |- ((&&,(#X --> L),(#X --> S)) ==> R), (Truth:Induction)
+    (A --> L), ((&&,(A --> S),A_1..n) ==> R), substitute(A,#X) |- ((&&,(#X --> L),(#X --> S),A_1..n) ==> R), (Truth:Induction)
+
+//// dependent variable elimination ////////////////////////////////////////////////////////////////////////////////////
+//Decomposition with elimination of a variable
+
+    B, (&&,A, A_1..n), task("."), substitute_if_unifies("#",A,B) |- (&&,A_1..n), (Truth:AnonymousAnalogy, Desire:Strong, Order:ForAllSame, SequenceIntervals:FromPremises)
+
+//conditional abduction by dependent variable
+
+    ((A --> R) ==> Z), ((&&,(#Y --> B),(#Y --> R),A_1..n) ==> Z) |- (A --> B), (Truth:Abduction)
+    ((A --> R) ==> Z), ((&&,(#Y --> B),(#Y --> R)) ==> Z) |- (A --> B), (Truth:Abduction)
+
+// conditional deduction "An inverse inference has been implemented as a form of deduction" https://code.google.com/p/open-nars/issues/detail?id=40&can=1
+
+    (U --> L), ((&&,(#X --> L),(#X --> R)) ==> Z) |- ((U --> R) ==> Z), (Truth:Deduction)
+    (U --> L), ((&&,(#X --> L),(#X --> R),A_1..n) ==> Z), substitute(#X,U) |- ((&&,(U --> R),A_1..n) ==> Z), (Truth:Deduction)
+
+//// independent variable elimination ////////////////////////////////////////////////////////////////////////////////////
+
+    B, (A ==> C), substitute_if_unifies("$",A,B), shift_occurrence_forward(unused,"==>") |- C, (Truth:Deduction, Order:ForAllSame)
+    B, (C ==> A), substitute_if_unifies("$",A,B), shift_occurrence_backward(unused,"==>") |- C, (Truth:Abduction, Order:ForAllSame)
+
+    B, (A <=> C), substitute_if_unifies("$",A,B), shift_occurrence_backward(unused,"<=>") |- C, (Truth:Deduction, Order:ForAllSame)
+    B, (C <=> A), substitute_if_unifies("$",A,B), shift_occurrence_forward(unused,"<=>") |- C, (Truth:Deduction, Order:ForAllSame)
+
+//// second level variable handling rules ////////////////////////////////////////////////////////////////////////////////////
+//second level variable elimination (termlink level2 growth needed in order for these rules to work)
+
+    (A --> K), (&&,(#X --> L),(($Y --> K) ==> (&&,A_1..n))), substitute($Y,A) |- (&&,(#X --> L),A_1..n), (Truth:Deduction)
+    (A --> K), (($X --> L) ==> (&&,(#Y --> K),A_1..n)), substitute(#Y,A) |- (($X --> L) ==> (&&,A_1..n)), (Truth:AnonymousAnalogy)
+
+//precondition combiner inference rule (variable_unification6):
+
+    ((&&,C,A_1..n) ==> Z), ((&&,C,B_1..m) ==> Z) |- ((&&,A_1..n) ==> (&&,B_1..m)), (Truth:Induction)
+    ((&&,C,A_1..n) ==> Z), ((&&,C,B_1..m) ==> Z) |- ((&&,B_1..m) ==> (&&,A_1..n)), (Truth:Induction)
+    (Z ==> (&&,C,A_1..n)), (Z ==> (&&,C,B_1..m)) |- ((&&,A_1..n) ==> (&&,B_1..m)), (Truth:Abduction)
+    (Z ==> (&&,C,A_1..n)), (Z ==> (&&,C,B_1..m)) |- ((&&,B_1..m) ==> (&&,A_1..n)), (Truth:Abduction)
+
+////NAL7 specific inference ////////////////////////////////////////////////////////////////////////////////////
+//Reasoning about temporal statements. those are using the ==> relation because relation in time is a relation of the truth between statements.
+
+    X, (XI ==> B), substitute_if_unifies("$",XI,(&/,X,/0)), shift_occurrence_forward(XI,"==>") |- B, (Truth:Deduction, Desire:Induction, Order:ForAllSame)
+    X, (BI ==> Y), substitute_if_unifies("$",Y,X), shift_occurrence_backward(BI,"==>") |- BI, (Truth:Abduction, Desire:Deduction, Order:ForAllSame)
+
+////Temporal induction: ////////////////////////////////////////////////////////////////////////////////////
+//When P and then S happened according to an observation, by induction (weak) it may be that alyways after P, usually S happens.
+
+    P, S, measure_time(I), not_implication_or_equivalence(P), not_implication_or_equivalence(S) |- ((&/,S,I) =/> P), (Truth:Induction, Linkage:Temporal),
+                                                                                                   (P =\> (&/,S,I)), (Truth:Abduction, Linkage:Temporal),
+                                                                                                   ((&/,S,I) </> P), (Truth:Comparison, Linkage:Temporal),
+                                                                                                   (&/,S,I,P), (Truth:Intersection, Linkage:Temporal)
+
+
+    P, S, concurrent(Task,Belief), not_implication_or_equivalence(P), not_implication_or_equivalence(S) |- (S =|> P), (Truth:Induction, Linkage:Temporal),
+                                                                                                           (P =|> S), (Truth:Induction, Linkage:Temporal),
+                                                                                                           (S <|> P), (Truth:Comparison, Linkage:Temporal),
+                                                                                                           (&|,S,P), (Truth:Intersection, Linkage:Temporal)
+
+////backward inference is mostly handled by the rule transformation:
+
+//    T, B |- C, [post] =>
+//          C, B, task("?") |- T, [post]
+//          C, T, task("?") |- B, [post]
+
+//here now are the backward inference rules which should really only work on backward inference:
+
+    (A --> S), (B --> S), task("?") |- (A --> B), (Punctuation:Question),
+                                       (B --> A), (Punctuation:Question),
+                                       (A <-> B), (Punctuation:Question)
+
+//and the backward inference driven forward inference:
+
+//NAL2:
+
+    ([A] <-> [B]), (A <-> B), task("?") |- ([A] <-> [B]), (Truth:BeliefIdentity, Punctuation:Judgment)
+    ({A} <-> {B}), (A <-> B), task("?") |- ({A} <-> {B}), (Truth:BeliefIdentity, Punctuation:Judgment)
+
+    ([A] --> [B]), (A <-> B), task("?") |- ([A] --> [B]), (Truth:BeliefIdentity, Punctuation:Judgment)
+    ({A} --> {B}), (A <-> B), task("?") |- ({A} --> {B}), (Truth:BeliefIdentity, Punctuation:Judgment)
+
+//NAL3:
+
+////composition on both sides of a statement:
+
+    ((&,B,A_1..n) --> (&,A,A_1..n)), (B --> A), task("?") |- ((&,B,A_1..n) --> (&,A,A_1..n)), (Truth:BeliefStructuralDeduction, Punctuation:Judgment)
+    ((|,B,A_1..n) --> (|,A,A_1..n)), (B --> A), task("?") |- ((|,B,A_1..n) --> (|,A,A_1..n)), (Truth:BeliefStructuralDeduction, Punctuation:Judgment)
+
+    ((-,S,A) --> (-,S,B)), (B --> A), task("?") |- ((-,S,A) --> (-,S,B)), (Truth:BeliefStructuralDeduction, Punctuation:Judgment)
+    ((~,S,A) --> (~,S,B)), (B --> A), task("?") |- ((~,S,A) --> (~,S,B)), (Truth:BeliefStructuralDeduction, Punctuation:Judgment)
+
+////composition on one side of a statement:
+
+    (W --> (|,B,A_1..n)), (W --> B), task("?") |- (W --> (|,B,A_1..n)), (Truth:BeliefStructuralDeduction, Punctuation:Judgment)
+    ((&,B,A_1..n) --> W), (B --> W), task("?") |- ((&,B,A_1..n) --> W), (Truth:BeliefStructuralDeduction, Punctuation:Judgment)
+
+    (W --> (-,S,B)), (W --> B), task("?") |- (W --> (-,S,B)), (Truth:BeliefStructuralDifference, Punctuation:Judgment)
+    ((~,S,B) --> W), (B --> W), task("?") |- ((~,S,B) --> W), (Truth:BeliefStructuralDifference, Punctuation:Judgment)
+
+//NAL4:
+
+////composition on both sides of a statement:
+
+    ((B,P) --> Z) ,(B --> A), task("?") |- ((B,P) --> (A,P)), (Truth:BeliefStructuralDeduction, Punctuation:Judgment)
+    ((P,B) --> Z) ,(B --> A), task("?") |- ((P,B) --> (P,A)), (Truth:BeliefStructuralDeduction, Punctuation:Judgment)
+    (B,P) <-> Z) ,(B <-> A), task("?") |- ((B,P) <-> (A,P)), (Truth:BeliefStructuralDeduction, Punctuation:Judgment)
+    ((P,B) <-> Z) ,(B <-> A), task("?") |- ((P,B) <-> (P,A)), (Truth:BeliefStructuralDeduction, Punctuation:Judgment)
+    ((\,N,A,_) --> Z), (N --> R), task("?") |- ((\,N,A,_) --> (\,R,A,_)), (Truth:BeliefStructuralDeduction, Punctuation:Judgment)
+    ((/,N,_,B) --> Z), (S --> B), task("?") |- ((/,N,_,B) --> (/,N,_,S)), (Truth:BeliefStructuralDeduction, Punctuation:Judgment)
+
+//NAL5:
+
+  --A,   A, task("?") |- --A, (Truth:BeliefNegation, Punctuation:Judgment)
+    A, --A, task("?") |-   A, (Truth:BeliefNegation, Punctuation:Judgment)
+
+//compound composition one premise
+
+    (||,B,A_1..n), B, task("?") |- (||,B,A_1..n), (Truth:BeliefStructuralDeduction, Punctuation:Judgment)

resources/narsese.bnf

@@ -5,7 +5,7 @@
          sentence ::= statement"." [tense] [truth]            (* judgement to be remembered *)
                     | statement"?" [tense] [truth]            (* question to be answered, tense added in OpenNARS 1.7 *)
                     | statement"@" [tense] [truth]            (* question on desire value to be answered, tense added in OpenNARS 1.7 *)
-                    | statement"!" [tense] [desire]           (* goal to be realized, tense added in OpenNARS 1.7 *)
+                    | statement"!" [tense] [truth]            (* goal to be realized, tense added in OpenNARS 1.7 *)
 
         statement ::= <"<">term copula term<">">              (* two terms related to each other *)
                     | <"(">term copula term<")">              (* two terms related to each other, new notation *)
@@ -15,15 +15,15 @@
 
            copula ::= "-->"                                   (* inheritance *)
                     | "<->"                                   (* similarity *)
-                    | "{--"                                   (* o-- instance *)
-                    | "--]"                                   (* --o property *)
-                    | "{-]"                                   (* o-o instance-property *)
+                    | "{--"                                   (* instance *)
+                    | "--]"                                   (* property *)
+                    | "{-]"                                   (* instance-property *)
                     | "==>"                                   (* implication *)
-                    | "=/>"                                   (* =+> predictive implication *)
+                    | "=/>"                                   (* predictive implication *)
                     | "=|>"                                   (* concurrent implication *)
-                    | "=\\>"                                  (* =-> retrospective implication *)
+                    | "=\\>"                                  (* =\> retrospective implication *)
                     | "<=>"                                   (* equivalence *)
-                    | "</>"                                   (* <+> predictive equivalence *)
+                    | "</>"                                   (* predictive equivalence *)
                     | "<|>"                                   (* concurrent equivalence *)
 
              term ::= word                                    (* an atomic constant term *)
@@ -72,7 +72,6 @@
          interval ::= <"/">#"\d+"                             (* integer *)
 
             truth ::= <"%">frequency[<";">confidence]<"%">    (* two numbers in [0,1]x(0,1) *)
-           desire ::= <"%">plausibility[<";">desirability]<"%"> (* two numbers in [0,1]x(0,1) *)
            budget ::= <"$">priority[<";">durability][<";">quality]<"$"> (* three numbers in [0,1]x(0,1)x[0,1] *)
 
                word : #"\w+"                                  (* unicode string *)    
@@ -81,6 +80,3 @@
             quality : #"([0]?\.[0-9]+|1\.[0]*|1|0)"           (* 0 <= x <= 1 *)
           frequency : #"([0]?\.[0-9]+|1\.[0]*|1|0)"           (* 0 <= x <= 1 *)
          confidence : #"[0]?\.[0]*[1-9]{1}[0-9]*"             (* 0 <  x <  1 *)
-       plausibility : #"([0]?\.[0-9]+|1\.[0]*|1|0)"           (* 0 <= x <= 1 *)
-       desirability : #"[0]?\.[0]*[1-9]{1}[0-9]*"             (* 0 <  x <  1 *)
-

src/nal/args_processing.clj

@@ -1,65 +0,0 @@
-(ns nal.args-processing
-  (:refer-clojure :exclude [==])
-  (:require [clojure.core.logic :refer
-             [run* project fresh conde conso run membero defne fne !=
-              nonlvaro == emptyo succeed fail conda s# u# onceo all defna]
-             :as l]
-            [nal.utils :refer [subtracto]]
-            [clojure.core.logic.pldb :refer [db-rel db with-db]]))
-
-(declare equ-producto sameo include1o include not-member dependento)
-
-(defna dependento [A1 A2 A3]
-  ([['var V L] Y ['var V [Y . L]]])
-  ([[H . T] Y [H1 . T1]] (dependento H Y H1) (dependento T Y T1))
-  ([['inheritance S P] Y ['inheritance S1 P1]]
-    (dependento S Y S1) (dependento P Y P1))
-  ([['ext-image R A] Y ['ext-image R A1]] (dependento A Y A1))
-  ([['int-image R A] Y ['int-image R A1]] (dependento A Y A1))
-  ([X _ X]))
-
-(defna equ-producto [A1 A2 A3]
-  ([[] [] []])
-  ([[T . Ls] [T . Lp] L]
-    (equ-producto Ls Lp L))
-  ([[S . Ls] [P . Lp] [['inheritance S P] . L]]
-    (equ-producto Ls Lp L)))
-
-(defna sameo [A1 A2]
-  ([[] []])
-  ([L [H . T]]
-    (nonlvaro L)
-    (fresh [L1] (membero H L) (subtracto L [H] L1) (sameo L1 T))))
-
-(defn same-seto [X Y]
-  (fresh [x]
-    (!= X []) (!= X [x]) (sameo X Y) (project [X Y] (!= X Y))))
-
-(defna include1o [A1 A2]
-  ([[] _])
-  ([[H . T1] [H . T2]] (include1o T1 T2))
-  ([[H1 . T1] [H2 . T2]] (!= H2 H1) (include1o A1 T2)))
-
-(defn includeo [L1 L2]
-  (all (nonlvaro L2) (include1o L1 L2) (!= L1 []) (!= L1 L2)))
-
-;never used in project
-(defn not-member [E C]
-  (fresh [X]
-    (conde [(emptyo C)]
-           [(conso E X C) fail]
-           ;[(fresh [S T S1] (== E [S T]) (conso [S1 T] X C) (equivalence S S1) fail)]
-           [(fresh [L] (conso X L C) (not-member L C))])))
-
-(defn replaceo
-  ([A1 A2 A3]
-   ((fne [A1 A2 A3]
-         ([[T . L] T [nil . L]])
-         ([[H . L] T [H . L1]] (replaceo L T L1)))
-     A1 A2 A3))
-  ([A1 A2 A3 A4]
-   ((fne [A1 A2 A3 A4]
-         ([[H1 . T] H1 [H2 . T] H2])
-         ([[H . T1] H1 [H . T2] H2] (replaceo T1 H1 T2 H2)))
-     A1 A2 A3 A4)))
-

src/nal/core.clj

@@ -1,516 +1,12 @@
 (ns nal.core
-  (:refer-clojure :exclude [!= == >= <= > < =])
-  (:require [clojure.core.logic :refer
-             [project fresh conde conda defna conso membero nonlvaro == !=
-              defne appendo all or* u# s# onceo lvar fne]
-             :as l]
-            [clojure.core.logic.arithmetic :refer :all]
-            [nal.utils :refer :all]
-            [nal.truth-value :refer :all]
-            [nal.args-processing :refer :all]
-            [clojure.core.logic.pldb :refer [db-rel db with-db]]))
+  (:require [nal.deriver.truth :as t]
+            [nal.deriver :refer [generate-conclusions]]))
 
-(declare similarity inheritance ext-intersection int-intersection
-         instance property ext-set int-set product negation
-         inst-prop ext-difference revision inference equivalence
-         inference2 inference3 equivalence-list reduceo replace-var
-         replace-all implication choice)
-
-;===============================================================================
-;revision
-
-(defna revision [R1 R2 R]
-  ([[S T1] [S T2] [S T]] (f-rev T1 T2 T)))
-
-;===============================================================================
-;choice
-
-(defna choice [A1 A2 A3]
-  ([[S [F1 C1]] [S [_F2 C2]] [S [F1 C1]]] (>= C1 C2))
-  ([[S [_F1 C1]] [S [F2 C2]] [S [F2 C2]]] (< C1 C2))
-  ([[S1 T1] [S2 T2] [S1 T1]]
-    (fresh [E1 E2]
-      (!= S1 S2) (f-exp T1 E1) (f-exp T2 E2) (>= E1 E2)))
-  ([[S1 T1] [S2 T2] [S2 T2]]
-    (fresh [E1 E2]
-      (!= S1 S2) (f-exp T1 E1) (f-exp T2 E2) (< E1 E2))))
-
-;===============================================================================
-;simplified version
-
-(defne infer3 [T1 T2 T3]
-  ([['inheritance W1 ['ext-image ['ext-image 'represent [nil ['inheritance ['product [X T2]] R]]] [nil W2 W3]]]
-    ['inheritance W1 ['ext-image 'represent [nil X]]]
-    [['inheritance ['ext-image 'represent [nil Y]] ['ext-image ['ext-image 'represent [nil ['inheritance ['product [Y T2]] R]]] [nil W2 W3]]] V]]
-    (f-ind [10.9] [1 0.9] V))
-
-  ([['inheritance W3 ['ext-image ['ext-image 'represent [nil ['inheritance ['product [T1 X]] R]]] [W1 W2 nil]]]
-    ['inheritance W3 ['ext-image 'represent [nil X]]]
-    [['inheritance ['ext-image 'represent [nil Y]] ['ext-image ['ext-image 'represent [nil ['inheritance ['product [T1 Y]] R]]] [W1 W2 nil]]] V]]
-    (f-ind [10.9] [1 0.9] V))
-
-  ([T1 T2 T] (inference [T1 [1 0.9]] [T2 [1 0.9]] T)))
-
-(defn infer
-  ([T1 T2] (inference [T1 [1 0.9]] T2))
-  ([T1 T2 T3] (infer3 T1 T2 T3)))
-
-;===============================================================================
-;inference
-
-
-(defn- call [vec]
-  (all
-    (nonlvaro vec)
-    (project [vec]
-      (let [[predicat & args] vec
-            vr (ns-resolve 'nal.core predicat)]
-        (if vr (apply vr args) u#)))))
-
-(defne inference2 [A1 A2]
-  ;immediate inference
-  ([[['inheritance S P] T1] [['inheritance P S] T]] (f-cnv T1 T))
-  ([[['implication S P] T1] [['implication P S] T]] (f-cnv T1 T))
-  ([[['implication ['negation S] P] T1] [['implication ['negation P] S] T]]
-    (f-cnt T1 T))
-  ([[['negation S] T1] [S T]] (f-neg T1 T))
-  ([[S [F1 C1]] [['negation S] T]] (< F1 0.5) (f-neg [F1 C1] T))
-  ;structural inference
-  ([[S1 T] [S T]]
-    (conda [(all (nonlvaro S) (reduceo S1 S) (!= S1 S))]
-           [(or* [(equivalence S1 S) (equivalence S S1)])]))
-  ([P C] (fresh [S] (inference3 P [S [1 1]] C) (call S)))
-  ([P C] (fresh [S] (inference3 [S [1 1]] P C) (call S))))
-
-(defne inference3 [A1 A2 A3]
-  ;inheritance-based syllogism
-  ([[['inheritance M P] T1] [['inheritance S M] T2] [['inheritance S P] T]]
-    (noto= S P) (f-ded T1 T2 T))
-  ([[['inheritance P M] T1] [['inheritance S M] T2] [['inheritance S P] T]]
-    (noto= S P) (f-abd T1 T2 T))
-  ([[['inheritance M P] T1] [['inheritance M S] T2] [['inheritance S P] T]]
-    (noto= S P) (f-ind T1 T2 T))
-  ([[['inheritance P M] T1] [['inheritance M S] T2] [['inheritance S P] T]]
-    (noto= S P) (f-exe T1 T2 T))
-  ; similarity from inheritance
-  ([[['inheritance S P] T1] [['inheritance P S] T2] [['similarity S P] T]]
-    (f-int T1 T2 T))
-  ; similarity-based syllogism
-  ([[['inheritance P M] T1] [['inheritance S M] T2] [['similarity S P] T]]
-    (noto= S P) (f-com T1 T2 T))
-  ([[['inheritance M P] T1] [['inheritance M S] T2] [['similarity S P] T]]
-    (noto= S P) (f-com T1 T2 T))
-  ([[['inheritance M P] T1] [['similarity S M] T2] [['inheritance S P] T]]
-    (noto= S P) (f-ana T1 T2 T))
-  ([[['inheritance P M] T1] [['similarity S M] T2] [['inheritance P S] T]]
-    (noto= S P) (f-ana T1 T2 T))
-  ([[['similarity M P] T1] [['similarity S M] T2] [['similarity S P] T]]
-    (noto= S P) (f-res T1 T2 T))
-  ; inheritance-based composition
-  ([[['inheritance P M] T1] [['inheritance S M] T2] [['inheritance N M] T]]
-    (noto= S P) (reduceo ['int-intersection [P S]] N) (f-int T1 T2 T))
-  ([[['inheritance P M] T1] [['inheritance S M] T2] [['inheritance N M] T]]
-    (noto= S P) (reduceo ['ext-intersection [P S]] N) (f-uni T1 T2 T))
-  ([[['inheritance P M] T1] [['inheritance S M] T2] [['inheritance N M] T]]
-    (noto= S P) (reduceo ['int-difference P S] N) (f-dif T1 T2 T))
-  ([[['inheritance M P] T1] [['inheritance M S] T2] [['inheritance M N] T]]
-    (noto= S P) (reduceo ['ext-intersection [P S]] N) (f-int T1 T2 T))
-  ([[['inheritance M P] T1] [['inheritance M S] T2] [['inheritance M N] T]]
-    (noto= S P) (reduceo ['int-intersection [P S]] N) (f-uni T1 T2 T))
-  ([[['inheritance M P] T1] [['inheritance M S] T2] [['inheritance M N] T]]
-    (noto= S P) (reduceo ['ext-difference P S] N) (f-dif T1 T2 T))
-  ; inheirance-based decomposition
-  ([[['inheritance S M] T1] [['inheritance ['int-intersection L] M] T2] [['inheritance P M] T]]
-    (nonlvaro S) (nonlvaro L) (membero S L)
-    (fresh [N]
-      (subtracto L [S] N) (reduceo ['int-intersection N] P) (f-pnn T1 T2 T)))
-  ([[['inheritance S M] T1] [['inheritance ['ext-intersection L] M] T2] [['inheritance P M] T]]
-    (nonlvaro S) (nonlvaro L) (membero S L)
-    (fresh [N]
-      (subtracto L [S] N) (reduceo ['ext-intersection N] P) (f-npp T1 T2 T)))
-  ([[['inheritance S M] T1] [['inheritance ['int-difference S P] M] T2] [['inheritance P M] T]]
-    (atomo S) (atomo P) (f-pnp T1 T2 T))
-  ([[['inheritance S M] T1] [['inheritance ['int-difference P S] M] T2] [['inheritance P M] T]]
-    (atomo S) (atomo P) (f-nnn T1 T2 T))
-  ([[['inheritance M S] T1] [['inheritance M ['ext-intersection L]] T2] [['inheritance M P] T]]
-    (nonlvaro S) (nonlvaro L) (membero S L)
-    (fresh [N]
-      (subtracto L [S] N) (reduceo ['ext-intersection N] P) (f-pnn T1 T2 T)))
-  ([[['inheritance M S] T1] [['inheritance M ['int-intersection L]] T2] [['inheritance M P] T]]
-    (nonlvaro S) (nonlvaro L) (membero S L)
-    (fresh [N]
-      (subtracto L [S] N) (reduceo ['int-intersection N] P) (f-npp T1 T2 T)))
-
-  ([[['inheritance M S] T1] [['inheritance M ['ext-difference S P]] T2] [['inheritance M P] T]]
-    (atomo S) (atomo P) (f-pnp T1 T2 T))
-  ([[['inheritance M S] T1] [['inheritance M ['ext-difference P S]] T2] [['inheritance M P] T]]
-    (atomo S) (atomo P) (f-nnn T1 T2 T))
-  ; implication-based syllogism
-  ([[['implication M P] T1] [['implication S M] T2] [['implication S P] T]]
-    (noto= S P) (f-ded T1 T2 T))
-  ([[['implication P M] T1] [['implication S M] T2] [['implication S P] T]]
-    (noto= S P) (f-abd T1 T2 T))
-  ([[['implication M P] T1] [['implication M S] T2] [['implication S P] T]]
-    (noto= S P) (f-ind T1 T2 T))
-  ([[['implication P M] T1] [['implication M S] T2] [['implication S P] T]]
-    (noto= S P) (f-exe T1 T2 T))
-  ; implication to equivalence
-  ([[['implication S P] T1] [['implication P S] T2] [['equivalence S P] T]]
-    (f-int T1 T2 T))
-  ; equivalence-based syllogism
-  ([[['implication P M] T1] [['implication S M] T2] [['equivalence S P] T]]
-    (noto= S P) (f-com T1 T2 T))
-  ([[['implication M P] T1] [['implication M S] T2] [['equivalence S P] T]]
-    (noto= S P) (f-com T1 T2 T))
-  ([[['implication M P] T1] [['equivalence S M] T2] [['implication S P] T]]
-    (noto= S P) (f-ana T1 T2 T))
-  ([[['implication P M] T1] [['equivalence S M] T2] [['implication P S] T]]
-    (noto= S P) (f-ana T1 T2 T))
-  ([[['equivalence M P] T1] [['equivalence S M] T2] [['equivalence S P] T]]
-    (noto= S P) (f-res T1 T2 T))
-  ; implication-based composition
-  ([[['implication P M] T1] [['implication S M] T2] [['implication N M] T]]
-    (noto= S P) (reduceo ['disjunction [P S]] N) (f-int T1 T2 T))
-  ([[['implication P M] T1] [['implication S M] T2] [['implication N M] T]]
-    (noto= S P) (reduceo ['conjunction [P S]] N) (f-uni T1 T2 T))
-  ([[['implication M P] T1] [['implication M S] T2] [['implication M N] T]]
-    (noto= S P) (reduceo ['conjunction [P S]] N) (f-int T1 T2 T))
-  ([[['implication M P] T1] [['implication M S] T2] [['implication M N] T]]
-    (noto= S P) (reduceo ['disjunction [P S]] N) (f-uni T1 T2 T))
-  ; implication-based decomposition
-  ([[['implication S M] T1] [['implication ['disjunction L] M] T2] [['implication P M] T]]
-    (nonlvaro S) (nonlvaro L) (membero S L)
-    (fresh [N]
-      (subtracto L [S] N) (reduceo ['disjunction N] P) (f-pnn T1 T2 T)))
-  ([[['implication S M] T1] [['implication ['conjunction L] M] T2] [['implication P M] T]]
-    (nonlvaro S) (nonlvaro L) (membero S L)
-    (fresh [N]
-      (subtracto L [S] N) (reduceo ['conjunction N] P) (f-npp T1 T2 T)))
-  ([[['implication M S] T1] [['implication M ['conjunction L]] T2] [['implication M P] T]]
-    (nonlvaro S) (nonlvaro L) (membero S L)
-    (fresh [N]
-      (subtracto L [S] N) (reduceo ['conjunction N] P) (f-pnn T1 T2 T)))
-  ([[['implication M S] T1] [['implication M ['disjunction L]] T2] [['implication M P] T]]
-    (nonlvaro S) (nonlvaro L) (membero S L)
-    (fresh [N]
-      (subtracto L [S] N) (reduceo ['disjunction N] P) (f-npp T1 T2 T)))
-  ; conditional syllogism
-  ([[['implication M P] T1] [M T2] [P T]]
-    ;(nonlvaro P1) (== P1 P)
-    (groundo P) (f-ded T1 T2 T))
-  ([[['implication P M] T1] [M T2] [P T]]
-    (groundo P) (f-abd T1 T2 T))
-  ([[M T1] [['equivalence S M] T2] [S T]]
-    (groundo S) (f-ana T1 T2 T))
-  ; conditional composition
-  ([[P T1] [S T2] [C T]]
-    (project [S P] (= C ['implication S P])) (f-ind T1 T2 T))
-  ([[P T1] [S T2] [C T]]
-    (project [S P] (= C ['equivalence S P])) (f-com T1 T2 T))
-  ([[P T1] [S T2] [C T]]
-    (fresh [N]
-      (reduceo ['conjunction [P S]] N)
-      (project [N] (= N C)) (f-int T1 T2 T)))
-  ([[P T1] [S T2] [C T]]
-    (fresh [N]
-      (reduceo ['disjunction [P S]] N)
-      (project [N] (= N C)) (f-uni T1 T2 T)))
-  ; propositional decomposition
-  ([[S T1] [['conjunction L] T2] [P T]]
-    (nonlvaro S) (nonlvaro L) (membero S L)
-    (fresh [N]
-      (subtracto L [S] N) (reduceo ['conjunction N] P) (f-pnn T1 T2 T)))
-  ([[S T1] [['disjunction L] T2] [P T]]
-    (nonlvaro S) (nonlvaro L) (membero S L)
-    (fresh [N]
-      (subtracto L [S] N) (reduceo ['disjunction N] P) (f-npp T1 T2 T)))
-  ; multi-conditional syllogism
-  ([[['implication ['conjunction L] C] T1] [M T2] [['implication P C] T]]
-    (fresh [A]
-      (nonlvaro L) (membero M L) (subtracto L [M] A)
-      (!= A []) (reduceo ['conjunction A] P) (f-ded T1 T2 T)))
-  ([[['implication ['conjunction L] C] T1] [['implication P C] T2] [M T]]
-    (fresh [A]
-      (nonlvaro L) (membero M L) (subtracto L [M] A) (!= A [])
-      (reduceo ['conjunction A] P) (f-abd T1 T2 T)))
-  ([[['implication ['conjunction L] C] T1] [M T2] [S T]]
-    (fresh [x] (conso M L x)
-      (project [x C] (= S ['implication ['conjunction x] C])) (f-ind T1 T2 T)))
-  ([[['implication ['conjunction Lm] C] T1] [['implication A M] T2] [['implication P C] T]]
-    (fresh [La]
-      (nonlvaro Lm) (replaceo Lm M La A)
-      (reduceo ['conjunction La] P) (f-ded T1 T2 T)))
-  ([[['implication ['conjunction Lm] C] T1] [['implication ['conjunction La] C] T2] [['implication A M] T]]
-    (nonlvaro Lm) (replaceo Lm M La A) (f-abd T1 T2 T))
-  ([[['implication ['conjunction La] C] T1] [['implication A M] T2] [['implication P C] T]]
-    (fresh [Lm]
-      (nonlvaro La) (replaceo Lm M La A)
-      (reduceo ['conjunction Lm] P) (f-ind T1 T2 T)))
-  ; variable introduction
-  ([[['inheritance M P] T1] [['inheritance M S] T2] [['implication ['inheritance X S] ['inheritance X P]] T]]
-    (noto= S P) (f-ind T1 T2 T))
-  ([[['inheritance P M] T1] [['inheritance S M] T2] [['implication ['inheritance P X] ['inheritance S X]] T]]
-    (noto= S P) (f-abd T1 T2 T))
-  ([[['inheritance M P] T1] [['inheritance M S] T2] [['equivalence ['inheritance X S] ['inheritance X P]] T]]
-    (noto= S P) (f-com T1 T2 T))
-  ([[['inheritance P M] T1] [['inheritance S M] T2] [['equivalence ['inheritance P X] ['inheritance S X]] T]]
-    (noto= S P) (f-com T1 T2 T))
-  ([[['inheritance M P] T1] [['inheritance M S] T2] [['conjunction [['inheritance ['var Y []] S] ['inheritance ['var Y []] P]]] T]]
-    (noto= S P) (f-int T1 T2 T))
-  ([[['inheritance P M] T1] [['inheritance S M] T2] [['conjunction [['inheritance S ['var Y []]] ['inheritance P ['var Y []]]]] T]]
-    (noto= S P) (f-int T1 T2 T))
-  ; 2nd variable introduction
-  ([[['implication A ['inheritance M1 P]] T1] [['inheritance M2 S] T2] [['implication ['conjunction [A ['inheritance X S]]] ['inheritance X P]] T]]
-    (noto= S P) (= M1 M2) (noto= A ['inheritance M2 S]) (f-ind T1 T2 T))
-  ([[['implication A ['inheritance M1 P]] T1] [['inheritance M2 S] T2] [['conjunction [['implication A ['inheritance ['var Y []] P]] ['inheritance ['var Y []] S]]] T]]
-    (noto= S P) (= M1 M2) (noto= A ['inheritance M2 S]) (f-int T1 T2 T))
-  ([[['conjunction L1] T1] [['inheritance M S] T2] [['implication ['inheritance Y S] ['conjunction [['inheritance Y P2] . L3]]] T]]
-    (fresh [P L2]
-      (subtracto L1 [['inheritance M P]] L2) (noto= L1 L2)
-      (noto= S P) (dependento P Y P2) (dependento L2 Y L3) (f-ind T1 T2 T)))
-  ([[['conjunction L1] T1] [['inheritance M S] T2] [['conjunction [['inheritance ['var Y []] S] ['inheritance ['var Y []] P] . L2]] T]]
-    (subtracto L1 [['inheritance M P]] L2) (noto= L1 L2) (noto= S P) (f-int T1 T2 T))
-  ([[['implication A ['inheritance P M1]] T1] [['inheritance S M2] T2] [['implication ['conjunction [A ['inheritance P X]]] ['inheritance S X]] T]]
-    (noto= S P) (= M1 M2) (noto= A ['inheritance S M2]) (f-abd T1 T2 T))
-  ([[['implication A ['inheritance P M1]] T1] [['inheritance S M2] T2] [['conjunction [['implication A ['inheritance P ['var Y []]]] ['inheritance S ['var Y []]]]] T]]
-    (noto= S P) (= M1 M2) (noto= A ['inheritance S M2]) (f-int T1 T2 T))
-  ([[['conjunction L1] T1] [['inheritance S M] T2] [['implication ['inheritance S Y] ['conjunction [['inheritance P2 Y] . L3]]] T]]
-    (fresh [P L2]
-      (subtracto L1 [['inheritance P M]] L2) (noto= L1 L2) (noto= S P)
-      (dependento P Y P2) (dependento L2 Y L3) (f-abd T1 T2 T)))
-  ([[['conjunction L1] T1] [['inheritance S M] T2] [['conjunction [['inheritance S ['var Y []]] ['inheritance P ['var Y []]] . L2]] T]]
-    (subtracto L1 [['inheritance P M]] L2) (noto= L1 L2) (noto= S P) (f-int T1 T2 T))
-  ; dependent variable elimination
-  ([[['conjunction L1] T1] [['inheritance M S] T2] [C T]]
-    (fresh [N D L2 L3 T0]
-      (subtracto L1 [['inheritance ['var N D] S]] L2) (project [L1 L2] (!= L1 L2))
-      (replace-var L2 ['var N D] L3 M) (reduceo ['conjunction L3] C)
-      (f-cnv T2 T0) (f-ana T1 T0 T)))
-  ([[['conjunction L1] T1] [['inheritance S M] T2] [C T]]
-    (fresh [N D L2 L3 T0]
-      (subtracto L1 [['inheritance S ['var N D]]] L2) (project [L1 L2] (!= L1 L2))
-      (replace-var L2 ['var N D] L3 M) (reduceo ['conjunction L3] C)
-      (f-cnv T2 T0) (f-ana T1 T0 T))))
+(defn choice [[f1 c1] [f2 c2]]
+  (if (>= c1 c2) [f1 c1] [f2 c2]))
 
 (defn inference
-  ([A1 A2] (inference2 A1 A2))
-  ([A1 A2 A3] (inference3 A1 A2 A3)))
+  [rules {:keys [task-type] :as task} belief]
+  (generate-conclusions (rules task-type) task belief))
 
-(defna replace-var [A1 A2 A3 A4]
-  ([[] _ [] _])
-  ([[['inheritance S1 P] . T1] S1 [['inheritance S2 P] . T2] S2]
-    (replace-var T1 S1 T2 S2))
-  ([[['inheritance S P1] . T1] P1 [['inheritance S P2] . T2] P2]
-    (replace-var T1 P1 T2 P2)))
-
-(defne replace-all [A1 A2 A3 A4]
-  ([[H . T1] H1 [H . T2] H2]
-    (replace-var T1 H1 T2 H2)))
-
-;===============================================================================
-;inheritance
-
-(defna inheritance [A1 A2]
-  ([['ext-intersection Ls] P] (includeo [P] Ls))
-  ([S ['int-intersection Lp]] (includeo [S] Lp))
-  ([['ext-intersection S] ['ext-intersection P]] (includeo P S) (!= P [(lvar)]))
-  ([['int-intersection S] ['int-intersection P]] (includeo S P) (!= S [(lvar)]))
-  ([['ext-set S] ['ext-set P]] (includeo S P))
-  ([['int-set S] ['int-set P]] (includeo P S))
-  ([['ext-difference S P] S] (nonlvaro S) (nonlvaro P))
-  ([S ['int-difference S P]] (nonlvaro S) (nonlvaro P))
-  ([['product L1] R]
-    (fresh [L2]
-      (nonlvaro L1) (membero ['ext-image R L2] L1)
-      (replaceo L1 ['ext-image R L2] L2)))
-  ([R ['product L1]]
-    (fresh [L2]
-      (nonlvaro L1) (membero ['int-image R L2] L1)
-      (replaceo L1 ['int-image R L2] L2))))
-
-;===============================================================================
-;similarity
-; There is a green cut in prolog's version, the second version of similarity
-; implements it.
-(defna similarity [A1 A2]
-  ([X Y] (all (nonlvaro X) (reduceo X Y) (!= X Y)))
-  ([['ext-intersection L1] ['ext-intersection L2]] (same-seto L1 L2))
-  ([['int-intersection L1] ['int-intersection L2]] (same-seto L1 L2))
-  ([['ext-set L1] ['ext-set L2]] (same-seto L1 L2))
-  ([['int-set L1] ['int-set L2]] (same-seto L1 L2)))
-
-;===============================================================================
-;implication
-
-(defna implication [A1 A2]
-  ([['similarity S P] ['inheritance S P]])
-  ([['equivalence S P] ['implication S P]])
-  ([['conjunction L] M] (nonlvaro L) (membero M L))
-  ([M ['disjunction L]] (nonlvaro L) (membero M L))
-  ([['conjunction L1] ['conjunction L2]]
-    (nonlvaro L1) (nonlvaro L2) (subseto L2 L1))
-  ([['disjunction L1] ['disjunction L2]]
-    (nonlvaro L1) (nonlvaro L2) (subseto L1 L2))
-  ([['inheritance S P]
-    ['inheritance ['ext-intersection Ls] ['ext-intersection Lp]]]
-    (fresh [L] (nonlvaro Ls) (nonlvaro Lp) (replaceo Ls S L P) (sameo L Lp)))
-  ([['inheritance S P]
-    ['inheritance ['int-intersection Ls] ['int-intersection Lp]]]
-    (fresh [L] (nonlvaro Ls) (nonlvaro Lp) (replaceo Ls S L P) (sameo L Lp)))
-  ([['similarity S P]
-    ['similarity ['ext-intersection Ls] ['ext-intersection Lp]]]
-    (fresh [L] (nonlvaro Ls) (nonlvaro Lp) (replaceo Ls S L P) (sameo L Lp)))
-  ([['similarity S P]
-    ['similarity ['int-intersection Ls] ['int-intersection Lp]]]
-    (fresh [L] (nonlvaro Ls) (nonlvaro Lp) (replaceo Ls S L P) (sameo L Lp)))
-  ([['inheritance S P]
-    ['inheritance ['ext-difference S M] ['ext-difference P M]]] (nonlvaro M))
-  ([['inheritance S P]
-    ['inheritance ['int-difference S M] ['int-difference P M]]] (nonlvaro M))
-  ([['similarity S P] ['similarity ['ext-difference S M] ['ext-difference P M]]]
-    (nonlvaro M))
-  ([['similarity S P] ['similarity ['int-difference S M] ['int-difference P M]]]
-    (nonlvaro M))
-  ([['inheritance S P] ['inheritance ['ext-difference M P] ['ext-difference M S]]]
-    (nonlvaro M))
-  ([['inheritance S P] ['inheritance ['int-difference M P] ['int-difference M S]]]
-    (nonlvaro M))
-  ([['similarity S P] ['similarity ['ext-difference M P] ['ext-difference M S]]]
-    (nonlvaro M))
-  ([['similarity S P] ['similarity ['int-difference M P] ['int-difference M S]]]
-    (nonlvaro M))
-  ([['inheritance S P] ['negation ['inheritance S ['ext-difference M P]]]]
-    (nonlvaro M))
-  ([['inheritance S ['ext-difference M P]] ['negation ['inheritance S P]]]
-    (nonlvaro M))
-  ([['inheritance S P] ['negation ['inheritance ['int-difference M S] P]]]
-    (nonlvaro M))
-  ([['inheritance ['int-difference M S] P] ['negation ['inheritance S P]]]
-    (nonlvaro M))
-  ([['inheritance S P] ['inheritance ['ext-image S M] ['ext-image P M]]]
-    (nonlvaro M))
-  ([['inheritance S P] ['inheritance ['int-image S M] ['int-image P M]]]
-    (nonlvaro M))
-  ([['inheritance S P] [inheritance ['ext-image M Lp] ['ext-image M Ls]]]
-    (fresh [L1 L2 x1 x2] (nonlvaro Ls) (nonlvaro Lp)
-      (conso S L2 x1) (appendo L1 x1 Ls)
-      (conso P L2 x2) (appendo L1 x2 Lp)))
-  ([['inheritance S P] [inheritance ['int-image M Lp] ['int-image M Ls]]]
-    (fresh [L1 L2 x1 x2]
-      (nonlvaro Ls) (nonlvaro Lp)
-      (conso S L2 x1) (appendo L1 x1 Ls)
-      (conso P L2 x2) (appendo L1 x2 Lp)))
-  ([['negation M] ['negation ['conjunction L]]] (includeo [M] L))
-  ([['negation ['disjunction L]] ['negation M]] (includeo [M] L))
-
-  ([['implication S P] ['implication ['conjunction Ls] ['conjunction Lp]]]
-    (fresh [L] (nonlvaro Ls) (nonlvaro Lp) (replaceo Ls S L P) (sameo L Lp)))
-  ([['implication S P] ['implication ['disjunction Ls] ['disjunction Lp]]]
-    (fresh [L] (nonlvaro Ls) (nonlvaro Lp) (replaceo Ls S L P) (sameo L Lp)))
-  ([['equivalence S P] ['equivalence ['conjunction Ls] ['conjunction Lp]]]
-    (fresh [L] (nonlvaro Ls) (nonlvaro Lp) (replaceo Ls S L P) (sameo L Lp)))
-  ([['equivalence S P] ['equivalence ['disjunction Ls] ['disjunction Lp]]]
-    (fresh [L] (nonlvaro Ls) (nonlvaro Lp) (replaceo Ls S L P) (sameo L Lp))))
-
-
-;===============================================================================
-;equialence
-(defna equivalence [A1 A2]
-  ([X Y] (all (nonlvaro X) (reduceo X Y) (!= X Y)))
-  ([['similarity S P] ['similarity P S]])
-  ([['inheritance S ['ext-set [P]]] ['similarity S ['ext-set [P]]]])
-  ([['inheritance ['int-set [S]] P] ['similarity ['int-set [S]] P]])
-  ([['inheritance S ['ext-intersection Lp]] ['conjunction L]]
-    (fresh [P] (findallo ['inheritance S P] (membero P Lp) L)))
-  ([['inheritance ['int-intersection Ls] P] ['conjunction L]]
-    (fresh [S] (findallo ['inheritance S P] (membero S Ls) L)))
-  ([['inheritance S ['ext-difference P1 P2]]
-    ['conjunction [['inheritance S P1] ['negation ['inheritance S P2]]]]])
-  ([['inheritance ['int-difference S1 S2] P]
-    ['conjunction [['inheritance S1 P] ['negation ['inheritance S2 P]]]]])
-  ([['inheritance ['product Ls] ['product Lp]] ['conjunction L]]
-    (equ-producto Ls Lp L))
-  ([['inheritance ['product [S . L]] ['product [P . L]]] ['inheritance S P]]
-    (nonlvaro L))
-  ([['inheritance S P] ['inheritance ['product [H . Ls]] ['product [H . Lp]]]]
-    (nonlvaro H)
-    (equivalence ['inheritance ['product Ls] ['product Lp]] ['inheritance S P]))
-  ([['inheritance ['product L] R] ['inheritance T ['ext-image R L1]]]
-    (replaceo L T L1))
-  ([['inheritance R ['product L]] ['inheritance ['int-image R L1] T]]
-    (replaceo L T L1))
-  ([['equivalence S P] ['equivalence P S]])
-  ([['equivalence ['negation S] P] ['equivalence ['negation P] S]])
-  ([['conjunction L1] ['conjunction L2]] (same-seto L1 L2))
-  ([['disjunction L1] ['disjunction L2]] (same-seto L1 L2))
-  ([['implication S ['conjunction Lp]] ['conjunction L]]
-    (fresh [P] (findallo ['implication S P] (membero P Lp) L)))
-  ([['implication ['disjunction Ls] P] ['conjunction L]]
-    (fresh [S] (findallo ['implication S P] (membero S Ls) L)))
-  ([T1 T2]
-    (noto (atomo T1)) (noto (atomo T2)) (nonlvaro T1) (nonlvaro T2)
-    (fresh [L1 L2] (== T1 L1) (== T2 L2) (equivalence-list L1 L2))))
-
-(defna equivalence-list [A1 A2]
-  ([L L])
-  ([[H . L1] [H . L2]] (equivalence-list L1 L2))
-  ([[H1 . L1] [H2 . L2]] (similarity H1 H2) (equivalence-list L1 L2))
-  ([[H1 . L1] [H2 . L2]] (equivalence H1 H2) (equivalence-list L1 L2)))
-
-;===============================================================================
-;compound term structure reduction
-
-(defna reduceo [A1 A2]
-  ([['similarity ['ext-set [S]] ['ext-set [P]]] ['similarity S P]])
-  ([['similarity ['int-set [S]] ['int-set [P]]] ['similarity S P]])
-  ([['instance S P] ['inheritance ['ext-set [S]] P]])
-  ([['property S P] ['inheritance S ['int-set [P]]]])
-  ([['inst-prop S P] ['inheritance ['ext-set [S]] ['int-set [P]]]])
-  ([['ext-intersection [T]] T])
-  ([['int-intersection [T]] T])
-  ([['ext-intersection [['ext-intersection L1] ['ext-intersection L2]]] ['ext-intersection L]]
-    (uniono L1 L2 L))
-  ([['ext-intersection [['ext-intersection L1] L2]] ['ext-intersection L]]
-    (uniono L1 [L2] L))
-  ([['ext-intersection [L1 ['ext-intersection L2]]] ['ext-intersection L]]
-    (uniono [L1] L2 L))
-  ([['ext-intersection [['ext-set L1] ['ext-set L2]]] ['ext-set L]]
-    (intersectiono L1 L2 L))
-  ([['ext-intersection [['int-set L1] ['int-set L2]]] ['int-set L]]
-    (uniono L1 L2 L))
-  ([['int-intersection [['int-intersection L1] ['int-intersection L2]]] ['int-intersection L]]
-    (uniono L1 L2 L))
-  ([['int-intersection [['int-intersection L1] L2]] ['int-intersection L]]
-    (uniono L1 [L2] L))
-  ([['int-intersection [L1 ['int-intersection L2]]] ['int-intersection L]]
-    (uniono [L1] L2 L))
-  ([['int-intersection [['int-set L1] ['int-set L2]]] ['int-set L]]
-    (intersectiono L1 L2 L))
-  ([['int-intersection [['ext-set L1] ['ext-set L2]]] ['ext-set L]]
-    (uniono L1 L2 L))
-  ([['ext-difference ['ext-set L1] ['ext-set L2]] ['ext-set L]]
-    (subtracto L1 L2 L))
-  ([['int-difference ['int-set L1] ['int-set L2]] ['int-set L]]
-    (subtracto L1 L2 L))
-  ([['product ['product L] T] ['product L1]]
-    (appendo L [T] L1))
-  ([['ext-image ['product L1] L2] T1]
-    (membero T1 L1) (replaceo L1 T1 L2))
-  ([['int-image ['product L1] L2] T1]
-    (membero T1 L1) (replaceo L1 T1 L2))
-  ([['negation ['negation S]] S])
-  ([['conjunction [T]] T])
-  ([['disjunction [T]] T])
-  ([['conjunction [['conjunction L1] ['conjunction L2]]] ['conjunction L]]
-    (uniono L1 L2 L))
-  ([['conjunction [['conjunction L1] L2]] ['conjunction L]]
-    (uniono L1 [L2] L))
-  ([['conjunction [L1 ['conjunction L2]]] ['conjunction L]]
-    (uniono [L1] L2 L))
-  ([['disjunction ['disjunction L1] ['disjunction L2]] ['disjunction L]]
-    (uniono L1 L2 L))
-  ([['disjunction ['disjunction L1] L2] ['disjunction L]]
-    (uniono L1 [L2] L))
-  ([['disjunction L1 ['disjunction L2]] ['disjunction L]]
-    (uniono [L1] L2 L))
-  ([X X]))
+(def revision t/revision)

src/nal/cut.clj

@@ -1,61 +0,0 @@
-(ns nal.cut
-  (:refer-clojure :exclude [== reduce replace])
-  (:require [clojure.core.logic :refer
-             [run* project fresh conde conso run membero defne
-              nonlvaro == emptyo succeed fail conda s# u# onceo defna] :as l]
-            [clojure.core.logic.pldb :refer [db-rel db with-db]]))
-
-;https://en.wikibooks.org/wiki/Prolog/Cuts_and_Negation
-;===============================================================================
-;(db-rel b p)
-;(db-rel c p)
-;
-;(defn a [X Y]
-;  (all (onceo (b X)) (c Y)))
-;
-;(with-db
-;  (db [b 'k]
-;      [b 1]
-;      [c 1]
-;      [c 2]
-;      [c 3])
-;  (run 10 [X Y]
-;       (a X Y)))
-;
-; is equal to
-;
-; a(X, Y) :- b(X), !, c(Y).
-; b(1).
-; b(2).
-; b(3).
-;
-; c(1).
-; c(2).
-; c(3).
-;
-;===============================================================================
-;(run* [x y]
-;  (conda
-;    [(== 2 x) u#]
-;    [(== 1 y)]))
-;
-; is equal to
-;
-; k(X, _) :- X = 2, !, fail.
-; k(_, Y) :- Y = 1.
-;
-;===============================================================================
-;(run* [x y]
-;  (conda
-;    [(== 2 x)]
-;    [(== 1 y)]))
-;
-; is equal to
-;
-; k(X, _) :- X = 2, !.
-; k(_, Y) :- Y = 1.
-;
-; == acts as =/2
-; = acts as ==/2
-; != acts as \==/2
-; noto= acts as \=/2

src/nal/deriver.clj

@@ -0,0 +1,23 @@
+(ns nal.deriver
+  (:require
+    [nal.deriver.utils :refer [walk]]
+    [nal.deriver.key-path :refer [mall-paths all-paths mpath-invariants
+                                  path-with-max-level]]
+    [nal.deriver.rules :refer [rule]]))
+
+(defn get-matcher [rules p1 p2]
+  (let [matchers (->> (mall-paths p1 p2)
+                      (filter rules)
+                      (map rules)
+                      (map (fn [el] (:matcher el))))]
+    (case (count matchers)
+      0 (constantly [])
+      1 (first matchers)
+      (fn [t1 t2] (mapcat #(% t1 t2) matchers)))))
+
+(def mget-matcher (memoize get-matcher))
+(def mpath (memoize path-with-max-level))
+(defn generate-conclusions
+  [rules {p1 :statement :as t1} {p2 :statement :as t2}]
+  (let [matcher (mget-matcher rules (mpath p1) (mpath p2))]
+    (matcher t1 t2)))

src/nal/deriver/backward_rules.clj

@@ -0,0 +1,50 @@
+(ns nal.deriver.backward-rules
+  (:require [nal.deriver.key-path :refer [rule-path]]
+            [clojure.string :as s]))
+
+;http://pastebin.com/3zLX7rPx
+(defn allow-backward?
+  "Return true if rule allows backward inference."
+  [{:keys [conclusions]}]
+  (some #{:allow-backward} (:post (first conclusions))))
+
+(defn has-prefix? [prefix cond]
+  (when (keyword? cond)
+    (s/starts-with? (str cond) prefix)))
+
+(defn not-equal? [cond]
+  (when (coll? cond)
+    (= :!= (first cond))))
+
+(defn check-not-equal [pre conclusion]
+  (if (some not-equal? pre)
+    (let [pre (remove not-equal? pre)]
+      (if (and (coll? conclusion) (= 3 (count conclusion)))
+        (let [[_ t1 t2] conclusion]
+          (conj pre (list :!= t1 t2)))
+        pre))
+    pre))
+
+(defn expand-backward-rules
+  "If rule allows backward inference it will be expanded to three rules,
+  where first one is the rule itself, and rest rules will be generated by
+  swapping conclusion with every premise."
+  [{:keys [p1 p2 conclusions pre] :as rule}]
+  (mapcat (fn [{:keys [conclusion post] :as fc}]
+            (let [post (reduce #(remove (partial has-prefix? %2) %1)
+                               post [":t/" ":d/"])]
+              (conj (map
+                      (fn [r] (update r :pre conj :question?))
+                      [(assoc rule :conclusions [(assoc fc :post post)])
+                       (assoc rule :p1 conclusion
+                                   :conclusions [{:conclusion p1
+                                                  :post       post}]
+                                   :full-path (rule-path conclusion p2)
+                                   :pre (check-not-equal pre p1))
+                       (assoc rule :p2 conclusion
+                                   :conclusions [{:conclusion p2
+                                                  :post       post}]
+                                   :full-path (rule-path p1 conclusion)
+                                   :pre (check-not-equal pre p2))])
+                    rule)))
+          conclusions))

src/nal/deriver/key_path.clj

@@ -0,0 +1,58 @@
+(ns nal.deriver.key-path)
+
+(defn path
+  "Generates premises \"path\" by replacing terms with :any"
+  [statement]
+  (if (coll? statement)
+    (let [[fst & tail] statement]
+      (conj (map path tail) fst))
+    :any))
+
+(defn path-with-max-level
+  ([statement] (path-with-max-level 0 statement))
+  ([level statement]
+   (if (coll? statement)
+     (let [[fst & tail] statement]
+       (cons fst
+             (if (> 1 level)
+               (let [next-level (if (= 'conj fst) level (inc level))]
+                 (map #(path-with-max-level next-level %) tail))
+               (repeat (count tail) :any))))
+     :any)))
+
+(defn rule-path
+  "Generates detailed pattern for the rule."
+  [p1 p2]
+  [(path p1) :and (path p2)])
+
+(defn cart
+  "Cartesian product."
+  [colls]
+  (if (empty? colls)
+    '(())
+    (for [x (first colls)
+          more (cart (rest colls))]
+      (cons x more))))
+
+(declare mpath-invariants)
+
+(defn path-invariants
+  "Generates all pathes that will match with path from args."
+  [path]
+  (if (coll? path)
+    (let [[op & args] path
+          args-inv (map mpath-invariants args)]
+      (concat (cart (concat [[op]] args-inv)) [:any]))
+    [path]))
+
+(def mpath-invariants (memoize path-invariants))
+
+;(all-paths 'Y '(==> (seq-conj X A1 A2 A3) B))
+(defn all-paths
+  "Generates all pathes for pair of premises."
+  [p1 p2]
+  (let [paths1 (mpath-invariants p1)
+        paths2 (mpath-invariants p2)]
+    (cart [paths1 [:and] paths2])))
+
+(def mall-paths (memoize all-paths))

src/nal/deriver/list_expansion.clj

@@ -0,0 +1,59 @@
+(ns nal.deriver.list-expansion
+  (:require [nal.deriver.utils :refer [walk]]
+            [clojure.string :as s]))
+
+(def max-elements-in-list 7)
+
+(defn get-list
+  "Finds the first :list element in the rule."
+  [prefix statement]
+  (cond
+    (and (keyword? statement) (s/starts-with? (str statement) prefix))
+    statement
+    (coll? statement) (some identity (map #(get-list prefix %) statement))
+    :default nil))
+
+(defn gen-symbols
+  "Generates n symbols with prefix."
+  [prefix n]
+  (map #(symbol (str prefix (inc %))) (range n)))
+
+(defn replace-list-elemets
+  "Replaces :list/ with symbols."
+  [statement l list-name n]
+  (walk statement
+    (and (coll? el) (some #{l} el))
+    (mapcat (fn [e] (if (= l e)
+                   (concat '() (gen-symbols list-name n))
+                   (list e))) el)))
+
+(defn list-name
+  "Fetches name of the list."
+  [l]
+  (->> l str (drop 6) s/join))
+
+(defn expand-:from-element
+  "Expands :from/ element in rule, so as a result will be created n rules, in
+  each of them :form/A will be replaced with A1 or A2 or A3, etc."
+  [statement from-name list-name n]
+  (map (fn [idx]
+         (walk statement
+           (= from-name el) (symbol (str list-name idx))))
+       (range 1 (inc n))))
+
+(defn generate-all-lists
+  "Expands rules with :list/ elements, as a result will be created 5 rules,
+  where :list/ will be replaced with A1, A1 A2, ..., A1..A5."
+  [r]
+  (let [list (get-list ":list" r)
+        l-name (list-name list)]
+    (mapcat #(let [st (replace-list-elemets r list l-name %)]
+              (if-let [from-name (get-list ":from" st)]
+                (expand-:from-element st from-name l-name %)
+                [st]))
+            (range 1 (inc max-elements-in-list)))))
+
+(defn contains-list?
+  "Checks if rule contains any :list element."
+  [r]
+  (get-list ":list" r))

src/nal/deriver/matching.clj

@@ -0,0 +1,345 @@
+(ns nal.deriver.matching
+  (:require
+    [nal.deriver.utils :refer [walk operator? not-operator?]]
+    [clojure.core.unify :as u]
+    [clojure.set :refer [map-invert intersection]]
+    [clojure.string :as s]
+    [nal.deriver
+     [set-functions :refer [f-map not-empty-diff? not-empty-inter?]]
+     [substitution :refer [munification-map substitute]]
+     [preconditions :refer [sets compound-precondition conclusion-transformation
+                            implications-and-equivalences get-terms abs
+                            preconditions-transformations]]
+     [normalization :refer [commutative-ops sort-commutative reducible-ops]
+      :as n]
+     [truth :as t]]))
+
+;operators/functions that shouldn't be quoted
+(def reserved-operators
+  #{`= `not= `seq? `first `and `let `pos? `> `>= `< `<= `coll? `set `quote
+    `count 'aops `- `not-empty-diff? `not-empty-inter? `walk `munification-map
+    `substitute `sets `some `deref `do `vreset! `volatile! `fn `mapv `if
+    `sort-commutative `n/reduce-ext-inter `n/reduce-symilarity `complement
+    `n/reduce-int-dif `n/reduce-and `n/reduce-ext-dif `n/reduce-image
+    `n/reduce-int-inter `n/reduce-neg `n/reduce-or `nil? `not `or `abs
+    `implications-and-equivalences `get-terms `empty? `intersection
+    `n/reduce-seq-conj})
+
+(defn operators->placeholders
+  [statement]
+  (walk statement
+    (and (symbol? :el)
+         (operator? :el)) '_
+    (= :interval :el) '_
+    (coll? :el) (vec :el)))
+
+(defn quote-operators
+  [statement]
+  (walk statement
+    (and
+      (not (reserved-operators :el))
+      (symbol? :el)
+      (or (operator? :el) (#{'Y 'X} :el))) `'~:el
+    (and (coll? :el)
+         ((complement map?) :el)
+         (let [f (first :el)]
+           (and (not (reserved-operators f))
+                (not (fn? f)))))
+    (vec :el)))
+
+(defn form-conclusion
+  "Formation of cocnlusion in terms of task and truth/desire functions"
+  [{:keys [t1 t2 task-type]}
+   {c  :statement tf :t-function pj :p/judgement df :d-function
+    sc :shift-conditions}]
+  (let [conclusion-type (if pj :judgement task-type)
+        conclusion {:statement  c
+                    :task-type  conclusion-type
+                    :occurrence :t-occurrence}
+        conclusion (case conclusion-type
+                     :judgement (assoc conclusion :truth (list tf t1 t2))
+                     :goal (assoc conclusion :desire (list df t1 t2))
+                     conclusion)]
+    (if sc
+      (conclusion-transformation sc conclusion)
+      conclusion)))
+
+(defn traverse-node
+  "Generates code for precondition node."
+  [vars result {:keys [conclusions children condition]}]
+  `(when ~(quote-operators condition)
+     ~(when-not (zero? (count conclusions))
+        `(vswap! ~result concat
+                 ~@(set (map #(mapv (partial form-conclusion vars) %)
+                             (quote-operators conclusions)))))
+     ~@(map (fn [n] (traverse-node vars result n)) children)))
+
+(defn traversal
+  "Walk through preconditions tree and generates code for matcher."
+  [vars tree]
+  (let [results (gensym)]
+    `(let [~results (volatile! [])]
+       ~(traverse-node vars results tree)
+       @~results)))
+
+(defn replace-occurrences
+  "Reblaces occurrences keywords from matcher's code by generated symbols."
+  [code]
+  (let [t-occurrence (gensym) b-occurrence (gensym)]
+    (walk code
+      (= :el :t-occurrence) t-occurrence
+      (= :el :b-occurrence) b-occurrence)))
+
+(defn match-rules
+  "Generates code of function that will match premises. Generated function
+  should be called with task and beleif as arguments."
+  [rules pattern task-type]
+  (let [t1 (gensym) t2 (gensym)
+        task (gensym) belief (gensym)
+        truth-kw (if (= :goal task-type) :desire :truth)]
+    (replace-occurrences
+      `(fn [{p1# :statement ~t1 ~truth-kw :t-occurrence :occurrence :as ~task}
+            {p2# :statement ~t2 :truth :b-occurrence :occurrence :as ~belief}]
+         (let [~(operators->placeholders (first pattern)) p1#
+               ~(operators->placeholders (second pattern)) p2#]
+           ~(traversal {:t1        t1
+                        :t2        t2
+                        :task      task
+                        :belief    belief
+                        :task-type task-type}
+                       rules))))))
+
+(defn find-and-replace-symbols
+  "Replaces all terms in statemnt to placeholders that will be used in pattern
+  matching or unification. Return vector, where the first element is map from
+  placeolder to term and the second is statement with replaced terms.
+  Form instance:
+
+  (find-and-replace-symbols '[--> [- A B] C] \"x\")
+  ;[{x0 A, x1 B, x2 C} [(quote -->) [(quote -) x0 x1] x2]]
+  "
+  [statement prefix]
+  (let [cnt (volatile! 0)
+        sym-map (volatile! {})
+        get-sym #(symbol (str prefix %))
+        result (walk statement
+                 (and (symbol? el) (not-operator? el))
+                 (let [s (get-sym @cnt)]
+                   (vswap! cnt inc)
+                   (vswap! sym-map assoc s el)
+                   s))]
+    [@sym-map result]))
+
+(defn symbols->placeholders
+  "Replaces "
+  [premise]
+  (second (find-and-replace-symbols premise "x")))
+
+(defn symbol-ordering-keyfn
+  [sym]
+  (if (symbol? sym)
+    (try (Integer/parseInt (s/join (drop 1 (str sym))))
+         (catch Exception _ -100))
+    -1))
+
+(defn sort-placeholders
+  "Sorts placeholder for preconditions. If we have two precondition like
+  (!= x0 x2) and (!= x2 x0) they are equal but we can not check this easely.
+  So this function sort [x2 x0] to [x0 x2], so we can reason that
+  (!= x0 x2) and (!= x2 x0) are equal."
+  [tail]
+  (sort-by symbol-ordering-keyfn tail))
+
+(defn apply-preconditions
+  "Generates code for preconditions."
+  [preconditions]
+  (reduce (fn [ac condition]
+            (if (seq? condition)
+              (concat ac (compound-precondition condition))
+              ac))
+          [] preconditions))
+
+(defn replace-symbols
+  "Replaces elements from statement if finds them in sym-map."
+  [conclusion sym-map]
+  (let [sym-map (map-invert sym-map)]
+    (walk conclusion
+      (sym-map el) (sym-map el))))
+
+(defn find-kv-by-prefix [prefix coll]
+  (first (filter #(and (keyword? %) (s/starts-with? (str %) prefix)) coll)))
+
+(defn get-truth-fn [post] (find-kv-by-prefix ":t/" post))
+
+(defn get-desire-fn [post] (find-kv-by-prefix ":d/" post))
+
+(defn get-aliases
+  "Filter map of symbols and keep only aliases of symbol that have lower
+  order-key (to avoid preconditions with swapped symbols, like (= x1 x2)
+  (= x2 x1)."
+  [symbols-map alias]
+  (let [sym (symbols-map alias)]
+    (->> (dissoc symbols-map alias)
+         (filter (fn [[a v]]
+                   (and (< (symbol-ordering-keyfn alias)
+                           (symbol-ordering-keyfn a))
+                        (= v sym))))
+         keys)))
+
+(defn aliases->conditins
+  [symbols-map alias]
+  (mapcat #(list `= alias %) (get-aliases symbols-map alias)))
+
+(defn check-conditions [syms]
+  (->> (keys syms)
+       (keep (partial aliases->conditins syms))
+       (filter not-empty)))
+
+(defn commutative? [st]
+  (and (coll? st) (some commutative-ops st)))
+
+(defn check-commutative [conclusion]
+  (if (commutative? conclusion)
+    `(sort-commutative ~(sort-commutative conclusion))
+    conclusion))
+
+(defn check-reduction [conclusion]
+  (walk conclusion
+    (and (coll? :el) (reducible-ops (first :el)) (<= 3 (count :el)))
+    `(~(reducible-ops (first :el)) ~:el)))
+
+(defn find-shift-precondition
+  [preconditions]
+  (first
+    (filter
+      #(and (coll? %)
+            (#{:shift-occurrence-backward
+               :shift-occurrence-forward}
+              (first %))) preconditions)))
+
+(defn premises-pattern
+  "Creates map with preconditions and conclusions regarding to the main pattern
+   of rules branch.
+   Example:
+
+   the main pattern of riles branch is
+   [[--> :any [- :any :any]] :and [--> :any :any]]
+
+   before it will be applied to pattern matching it will be transformed to
+   [[--> x1 [- x2 x3]] [--> x4 x5]]
+
+   When whe want to use the pattern above to derive conclusions from some
+   another rule, we have to map placeholders from pattern to terms in this rule.
+
+   For rule with premises [[--> A B] [--> B C]] and conclusion [--> A C]
+   map will be
+   {x1 A, ['- x2 x3] B, x4 B, x5 C}
+
+   From this map, conditions will be the list with one condition:
+   [(= ['- x2 x3] x4)]
+
+   and conclusion will be
+   [--> x1 x4]."
+  [pattern premise {:keys [post conclusion]} preconditions]
+  (let [[sym-map pat] (find-and-replace-symbols premise "?a")
+        unification-map (u/unify pattern pat)
+        sym-map (into {} (map (fn [[k v]] [(k unification-map) v]) sym-map))
+        inverted-sym-map (map-invert sym-map)
+        pre (walk (apply-preconditions preconditions)
+              (inverted-sym-map el) (inverted-sym-map el)
+              (seq? el)
+              (let [[f & tail] el]
+                (if-not (#{`munification-map `not-empty-diff?} f)
+                  (concat (list f) (sort-placeholders tail))
+                  el)))]
+    {:conclusion {:statement        (-> conclusion
+                                        (preconditions-transformations preconditions)
+                                        (replace-symbols sym-map)
+                                        check-commutative
+                                        check-reduction)
+                  :shift-conditions (replace-symbols
+                                      (find-shift-precondition preconditions)
+                                      sym-map)
+                  :t-function       (t/tvtypes (get-truth-fn post))
+                  :d-function       (t/dvtypes (get-desire-fn post))
+                  :p/judgement      (some #{:p/judgement} post)}
+     :conditions (remove nil?
+                         (walk (concat (check-conditions sym-map) pre)
+                           (and (coll? el) (= \a (first (str (first el)))))
+                           (concat '() el)
+                           (and (coll? el) (not ((conj reserved-operators 'quote)
+                                                  (first el))))
+                           (vec el)))}))
+
+(defn conditions->conclusions-map
+  "Creates map from conditions to conclusions."
+  [main rules]
+  (->> rules
+       (map (fn [[premises conclusions preconditions]]
+              (premises-pattern main premises conclusions preconditions)))
+       (group-by :conditions)
+       (map (fn [[k v]] [k (map :conclusion v)]))))
+
+(defrecord TreeNode [condition conclusions children])
+
+(defn group-conditions
+  "Groups conditions->conclusions map by first condition and remove it."
+  [conds]
+  (into {} (map (fn [[k v]]
+                  [k (map (fn [[k v]]
+                            [(drop 1 k) (set v)]) v)])
+                (group-by #(-> % first first) conds))))
+
+(defn generate-tree
+  "Generates tree of conditions from conditions->conclusions map."
+  ([conds] (generate-tree true conds))
+  ([cond conds]
+   (let [grouped-conditions (group-conditions conds)
+         reached-keys (map second (grouped-conditions nil))
+         other (dissoc grouped-conditions nil)]
+     (->TreeNode cond reached-keys
+                 (map (fn [[cond conds]]
+                        (generate-tree cond conds))
+                      other)))))
+
+(defn conds-priorities-map
+  "Generates the map of priorities for coditions according to their frequency."
+  [conds]
+  (->> (mapcat (fn [[cnds k]]
+                 (if (not-empty cnds)
+                   (map (fn [c] [c k]) cnds)
+                   [(list '() k)])) conds)
+       (group-by first)
+       (map (fn [[k v]] [k (+ (- (count v)) (rand 0.4))]))
+       (into {})))
+
+(defn sort-conds
+  "Sorts conditions in conditions->conclusions map according to the map of
+   priorities of conditions. If condition occurs frequntly it will have higher
+   priority."
+  [conds cpm]
+  (map (fn [[cnds k]] [(sort-by cpm cnds) k]) conds))
+
+(defn gen-rules
+  "Prepeares data for generation of conditions tree and then generates tree."
+  [main-pattern rules]
+  (let [rules (mapcat (fn [{:keys [p1 p2 conclusions pre]}]
+                        (map #(vector [p1 p2] % pre) conclusions))
+                      rules)
+        cond-conclusions-m (conditions->conclusions-map main-pattern rules)
+        cpm (conds-priorities-map cond-conclusions-m)
+        sorted-conds (sort-conds cond-conclusions-m cpm)]
+    (generate-tree sorted-conds)))
+
+(defn generate-matching
+  "Generates code for rule matcher."
+  [rules task-type]
+  (->> rules
+       (map (fn [[k {:keys [pattern rules] :as v}]]
+              (let [main-pattern (symbols->placeholders pattern)
+                    match-fn-code (-> main-pattern
+                                      (gen-rules rules)
+                                      (match-rules main-pattern task-type))]
+                [k (assoc v :matcher (eval match-fn-code)
+                            :matcher-code match-fn-code)])))
+       (into {})))

src/nal/deriver/normalization.clj

@@ -0,0 +1,196 @@
+(ns nal.deriver.normalization
+  (:require [clojure.string :as s]
+            [clojure.set :as set]
+            [clojure.core.match :as m]))
+
+;operators that should be movet from infix to prefix position
+(def operators
+  #{'&| '--> '<-> '==> 'retro-impl 'pred-impl 'seq-conj 'inst 'prop 'inst-prop
+    'int-image 'ext-image '=/> '=|> '| '<=> '</> '<|> '- 'int-dif '|| '&&
+    'ext-inter 'conj})
+
+;commutative:	<-> <=> <|> & | && ||
+;not commutative: --> ==> =/> =\> </> &/ - ~
+
+(def commutative-ops #{'<-> '<=> '<|> '| '|| 'conj 'ext-inter})
+
+(defn infix->prefix
+  "Makes transformaitions like [A --> B] to [--> A B]."
+  [premise]
+  (if (coll? premise)
+    (let [[f s & tail] premise]
+      (map infix->prefix
+           (if (operators s)
+             (concat [s f] tail)
+             premise)))
+    premise))
+
+(defn- neg-symbol?
+  "Checks if symbol starts with --, true for --A, --X"
+  [el]
+  (and (not= el '-->) (symbol? el) (s/starts-with? (str el) "--")))
+
+(defn- trim-negation
+  "Removes -- from symbols with negation:
+  (trim-negation '--A) => A"
+  [el]
+  (symbol (s/join (drop 2 (str el)))))
+
+(defn neg [el] (list '-- el))
+
+(defn replace-negation
+  "Replaces negations's \"new notation\"."
+  [statement]
+  (cond
+    (neg-symbol? statement) (neg (trim-negation statement))
+    (or (vector? statement) (and (seq? statement) (not= '-- (first statement))))
+    (:st
+      (reduce
+        (fn [{:keys [prev st] :as ac} el]
+          (if (= '-- el)
+            (assoc ac :prev true)
+            (->> [(cond prev (neg el)
+                        (coll? el) (replace-negation el)
+                        (neg-symbol? el) (neg (trim-negation el))
+                        :else el)]
+                 (concat st)
+                 (assoc ac :prev false :st))))
+        {:prev false :st '()}
+        statement))
+    :else statement))
+
+(defn sort-commutative [conclusions]
+  (if (coll? conclusions)
+    (let [f (first conclusions)]
+      (if (commutative-ops f)
+        (vec (conj (sort-by hash (drop 1 conclusions)) f))
+        conclusions))
+    conclusions))
+
+;https://gist.github.com/TonyLo1/a3f8e05458c5e90c2e72
+(defn union
+  ([c1 c2] (sort-by hash (set (concat c1 c2))))
+  ([op c1 c2] (vec (conj (union c1 c2) op))))
+
+(defn diff
+  ([c1 c2] (into '() (set/difference (set c1) (set c2))))
+  ([op c1 c2] (vec (conj (diff c1 c2) op))))
+
+(defn reduce-ext-inter
+  [st]
+  (m/match
+    st
+    [_ t] t
+    [_ ['ext-inter & l1] ['ext-inter & l2]] (union 'ext-inter l1 l2)
+    [_ ['ext-inter & l1] l2] (union 'ext-inter l1 [l2])
+    [_ l1 ['ext-inter & l2]] (union 'ext-inter [l1] l2)
+    [_ ['int-set & l1] ['int-set & l2]] (union 'int-set l1 l2)
+    ;[_ ['ext-set & l1] ['ext-set & l2]] (union 'ext-set l1 l2)
+    :else st))
+
+(defn reduce-int-inter
+  [st]
+  (m/match st
+    ['| t] t
+    ['| ['| & l1] ['| & l2]] (union '| l1 l2)
+    ['| ['| & l1] l2] (union '| l1 [l2])
+    ['| l1 ['| & l2]] (union '| [l1] l2)
+    ['| ['int-set & l1] ['int-set & l2]] (union 'int-set l1 l2)
+    ['| ['ext-set & l1] ['ext-set & l2]] (union 'ext-set l1 l2)
+    :else st))
+
+(defn reduce-int-dif
+  [st]
+  (m/match st
+    [_ ['int-set & l1] ['int-set & l2]] (diff 'int-set l1 l2)
+    :else st))
+
+(defn reduce-ext-dif
+  [st]
+  (m/match st
+    [_ ['ext-set & l1] ['ext-set & l2]] (diff 'ext-set l1 l2)
+    :else st))
+
+(defn reduce-symilarity
+  [st]
+  (m/match st
+    ['<-> ['ext-set s] ['ext-set p]] ['<-> s p]
+    ['<-> ['int-set s] ['int-set p]] ['<-> s p]
+    :else st))
+
+(defn reduce-production
+  [st]
+  (m/match st
+    ['* ['* & l1] & l2] (vec (conj (concat l1 l2) '*))
+    :else st))
+
+(defn reduce-image
+  [st]
+  (m/match st
+    [_ ['* t1 t2] t3] (if (and (= t2 t3) (not= t1 t2)) t1 st)
+    :else st))
+
+(defn reduce-neg
+  [st]
+  (m/match st
+    ['-- ['-- t]] t
+    :else st))
+
+(defn reduce-or
+  [st]
+  (m/match st
+    ['|| t] t
+    ['|| ['|| & l1] ['|| & l2]] (union '|| l1 l2)
+    ['|| ['|| & l1] l2] (union '|| l1 [l2])
+    ['|| l1 ['|| & l2]] (union '|| [l1] l2)
+    ['|| t1 t2] (if (= t1 t2) t1 st)
+    :else st))
+
+(defn reduce-and
+  [st]
+  (m/match st
+    ['conj t] t
+    ['conj ['conj & l1] ['conj & l2]] (union 'conj l1 l2)
+    ['conj ['conj & l1] l2] (union 'conj l1 [l2])
+    ['conj l1 ['conj & l2]] (union 'conj [l1] l2)
+    ['conj t1 t2] (if (= t1 t2) t1 st)
+    :else st))
+
+(defn reduce-seq-conj
+  [st]
+  (let [cnt (count st)]
+    (cond
+      (= 3 cnt) (second st)
+      (odd? cnt) (vec (butlast st))
+      :else st)))
+
+(def reducible-ops
+  {'ext-inter `reduce-ext-inter
+   '|         `reduce-int-inter
+   '-         `reduce-ext-dif
+   'int-dif   `reduce-int-dif
+   '<->       `reduce-symilarity
+   '*         `reduce-production
+   'int-image `reduce-image
+   'ext-image `reduce-image
+   '--        `reduce-neg
+   'conj      `reduce-and
+   '||        `reduce-or})
+
+(defn reduce-ops
+  [st]
+  (let [f (first st)]
+    (case f
+      ext-inter (reduce-ext-inter st)
+      | (reduce-int-inter st)
+      - (reduce-ext-dif st)
+      int-dif (reduce-int-dif st)
+      <-> (reduce-symilarity st)
+      * (reduce-production st)
+      int-image (reduce-image st)
+      ext-image (reduce-image st)
+      -- (reduce-neg st)
+      conj (reduce-and st)
+      || (reduce-or st)
+      st)))
+

src/nal/deriver/preconditions.clj

@@ -0,0 +1,201 @@
+(ns nal.deriver.preconditions
+  (:require [nal.deriver.set-functions
+             :refer [f-map not-empty-diff? not-empty-inter?]]
+            [nal.deriver.utils :refer [walk]]
+            [nal.deriver.substitution :refer [substitute munification-map]]
+            [nal.deriver.terms-permutation :refer [implications equivalences]]
+            [clojure.set :refer [union intersection]]
+            [narjure.defaults :refer [temporal-window-duration]]
+            [clojure.core.match :as m]
+            [nal.deriver.normalization :refer [reduce-seq-conj]]))
+
+(defn abs [^long n] (Math/abs n))
+
+;TODO preconditions
+;:shift-occurrence-forward :shift-occurrence-backward
+(defmulti compound-precondition
+  "Expands compound precondition to clojure sequence
+  that will be evaluted later"
+  first)
+
+(defmethod compound-precondition :default [_] [])
+
+(defmethod compound-precondition :!=
+  [[_ & args]]
+  [`(not= ~@args)])
+
+(defn check-set [set-type arg]
+  `(and (coll? ~arg) (= ~set-type (first ~arg))))
+
+(defmethod compound-precondition :set-ext? [[_ arg]]
+  [(check-set 'ext-set arg)])
+
+(defmethod compound-precondition :set-int? [[_ arg]]
+  [(check-set 'int-set arg)])
+
+(def sets '#{ext-set int-set})
+
+(defn set-conditions [set1 set2]
+  [`(coll? ~set1)
+   `(coll? ~set2)
+   `(let [k# 1 afop# (first ~set1)]
+      (and (sets afop#) (= afop# (first ~set2))))])
+
+(defmethod compound-precondition :difference [[_ arg1 arg2]]
+  (concat (set-conditions arg1 arg2)
+          [`(not-empty-diff? ~arg1 ~arg2)]))
+
+(defmethod compound-precondition :union [[_ arg1 arg2]]
+  (set-conditions arg1 arg2))
+
+(defmethod compound-precondition :intersection [[_ arg1 arg2]]
+  (concat (set-conditions arg1 arg2)
+          [`(not-empty-inter? ~arg1 ~arg2)]))
+
+(defmethod compound-precondition :substitute-if-unifies
+  [[_ arg1 arg2 arg3]]
+  [`(munification-map ~arg1 ~arg2 ~arg3)])
+
+(defmethod compound-precondition :contains?
+  [[_ arg1 arg2]]
+  [`(some (set [~arg2]) ~arg1)])
+
+(def implications-and-equivalences
+  (union implications equivalences))
+
+(defmethod compound-precondition :not-implication-or-equivalence
+  [[_ arg]]
+  [`(if (coll? ~arg)
+      (nil? (~`implications-and-equivalences (first ~arg)))
+      true)])
+
+(defn get-terms
+  [st]
+  (if (coll? st)
+    (mapcat get-terms (rest st))
+    [st]))
+
+(defmethod compound-precondition :no-common-subterm
+  [[_ arg1 arg2]]
+  [`(empty? (intersection (set (get-terms ~arg1))
+                          (set (get-terms ~arg2))))])
+
+(defmethod compound-precondition :not-set?
+  [[_ arg]]
+  [`(or (not (coll? ~arg)) (not (sets (first ~arg))))])
+
+(defmethod compound-precondition :measure-time
+  [_]
+  [`(not= :eternal :t-occurrence)
+   `(not= :eternal :b-occurrence)
+   `(<= ~temporal-window-duration (abs (- :t-occurrence :b-occurrence)))])
+
+(defmethod compound-precondition :concurrent
+  [_]
+  [`(> ~temporal-window-duration (abs (- :t-occurrence :b-occurrence)))])
+
+;-------------------------------------------------------------------------------
+(defmulti precondition-transformation (fn [arg1 _] (first arg1)))
+
+(defmethod precondition-transformation :default [_ conclusion] conclusion)
+
+(defn sets-transformation
+  [[cond-name el1 el2 el3] conclusion]
+  (walk conclusion (= :el el3)
+    `(~(f-map cond-name) ~el1 ~el2)))
+
+(doall (map
+         #(defmethod precondition-transformation %
+           [cond concl] (sets-transformation cond concl))
+         [:difference :union :intersection]))
+
+(defmethod precondition-transformation :substitute
+  [[_ el1 el2] conclusion]
+  `(walk ~conclusion
+     (= :el ~el1) ~el2))
+
+(defmethod precondition-transformation :substitute-from-list
+  [[_ el1 el2] conclusion]
+  `(mapv (fn [k#]
+           (if (= k# ~el1)
+             k#
+             (walk k# (= :el ~el1) ~el2)))
+         ~conclusion))
+
+(defmethod precondition-transformation :substitute-if-unifies
+  [[_ p1 p2 p3] conclusion]
+  `(substitute ~p1 ~p2 ~p3 ~conclusion))
+
+(defmethod precondition-transformation :measure-time
+  [[_ arg] conclusion]
+  (let [mt (gensym)]
+    (walk `(let [~arg (abs (- :t-occurrence :b-occurrence))]
+             ~(walk conclusion
+                (= :el arg) [:interval arg]))
+      (= :el arg) mt)))
+
+(defn check-precondition
+  [conclusion precondition]
+  (if (seq? precondition)
+    (precondition-transformation precondition conclusion)
+    conclusion))
+
+(defn preconditions-transformations
+  "Some transformations of conclusion may be required by precondition."
+  [conclusion preconditions]
+  (reduce check-precondition conclusion preconditions))
+
+;-------------------------------------------------------------------------------
+(defmulti conclusion-transformation (fn [arg1 _] (first arg1)))
+
+(defn shift-forward-let
+  ([sym conclusion] (shift-forward-let sym nil conclusion nil))
+  ([sym op conclusion duration]
+   `(let [interval# ~sym
+          ~@(if duration
+              `[:t-occurrence (~op :t-occurrence ~duration)]
+              [])
+          :t-occurrence (if interval# (+ :t-occurrence interval#)
+                                      :t-occurrence)]
+      ~conclusion)))
+
+(defmethod conclusion-transformation :shift-occurrence-forward
+  [args concl]
+  (m/match (mapv #(if (and (coll? %) (= 'quote (first %)))
+                   (second %) %) (rest args))
+    [(:or '=|> '==>)] concl
+    ['pred-impl] `(let [:t-occurrence (+ :t-occurrence ~temporal-window-duration)] ~concl)
+    ['retro-impl] `(let [:t-occurrence (- :t-occurrence ~temporal-window-duration)] ~concl)
+    [sym (:or '=|> '==>)] (shift-forward-let sym concl)
+    [sym 'pred-impl] (shift-forward-let sym `+ concl temporal-window-duration)
+    [sym 'retro-impl] (shift-forward-let sym `- concl temporal-window-duration)))
+
+(defn backward-interval-check [sym]
+  `(and (coll? ~sym) (= (first ~sym) (quote ~'seq-conj))
+        (let [cnt# (count ~sym)]
+          (and (odd? cnt#) (get-in ~sym [(dec cnt#) 1])))))
+
+(defn shift-backward-let
+  ([sym conclusion] (shift-backward-let sym nil conclusion nil))
+  ([sym op conclusion duration]
+   `(let [interval# ~(backward-interval-check sym)
+          ~@(if duration
+              `[:t-occurrence (~op :t-occurrence ~duration)]
+              [])
+          :t-occurrence (if interval# (+ :t-occurrence interval#)
+                                      :t-occurrence)]
+      (if interval#
+        (update ~conclusion :statement reduce-seq-conj)
+        ~conclusion))))
+
+(defmethod conclusion-transformation :shift-occurrence-backward
+  [args concl]
+  (let [duration (- temporal-window-duration)]
+    (m/match (mapv #(if (and (coll? %) (= 'quote (first %)))
+                     (second %) %) (rest args))
+      [(:or '=|> '==>)] concl
+      ['pred-impl] `(let [:t-occurrence (+ :t-occurrence ~duration)] ~concl)
+      ['retro-impl] `(let [:t-occurrence (- :t-occurrence ~duration)] ~concl)
+      [sym (:or '=|> '==>)] (shift-backward-let sym concl)
+      [sym 'pred-impl] (shift-backward-let sym `+ concl duration)
+      [sym 'retro-impl] (shift-backward-let sym `- concl duration))))

src/nal/deriver/premises_swapping.clj

@@ -0,0 +1,24 @@
+(ns nal.deriver.premises-swapping
+  (:require [nal.deriver.key-path :refer [rule-path]]
+            [nal.deriver.normalization :refer [commutative-ops]]))
+
+;the set of keys which prevent premises swapping for rule
+(def anti-swapping-keys
+  #{:question? :judgement? :goal? :measure-time :t/belief-structural-deduction
+    :t/structural-deduction :t/belief-structural-difference :t/identity
+    :t/negation :union :intersection :t/intersection :t/union})
+
+(defn allow-swapping?
+  "Checks if rule allow swapping of premises."
+  [{:keys [pre conclusions]}]
+  (let [{:keys [post conclusion]} (first conclusions)]
+    (and (not-any? anti-swapping-keys (flatten (concat pre post)))
+         (not-any? commutative-ops (flatten conclusion)))))
+
+(defn swap-premises
+  [{:keys [p1 p2] :as rule}]
+  (assoc rule :p1 p2
+              :p2 p1
+              :full-path (rule-path p2 p1)))
+
+(defn swap [rule] [rule (swap-premises rule)])

src/nal/deriver/rules.clj

@@ -0,0 +1,143 @@
+(ns nal.deriver.rules
+  (:require [clojure.string :as s]
+            [clojure.set :refer [map-invert]]
+            [nal.deriver
+             [key-path :refer [rule-path all-paths path-invariants path]]
+             [utils :refer [walk]]
+             [list-expansion :refer [contains-list? generate-all-lists]]
+             [premises-swapping :refer [allow-swapping? swap]]
+             [matching :refer [generate-matching]]
+             [backward-rules :refer [allow-backward? expand-backward-rules]]
+             [normalization :refer [infix->prefix replace-negation]]
+             [terms-permutation :refer [order-for-all-same? generate-all-orders]]]))
+
+(defn options
+  "Generates map from rest of the rule's args."
+  [args]
+  (when (seq args)
+    (into {} (map vec (partition 2 args)))))
+
+(defn get-conclusions
+  "Parses conclusions from the rule."
+  [c opts]
+  (if (and (seq? c) (some #{:post} c))
+    (map (fn [[c _ post]] {:conclusion c :post post}) (partition 3 c))
+    [{:conclusion c :post (:post opts)}]))
+
+(defn rule
+  "Generates rule from #R statement."
+  [data]
+  (let [[p1 p2 _ c & other] (replace-negation data)]
+    (let [p1 (infix->prefix p1)
+          p2 (infix->prefix p2)
+          c (infix->prefix c)
+          opts (options other)
+          conclusions (get-conclusions c opts)]
+      (map (fn [c]
+             {:p1          p1
+              :p2          p2
+              :conclusions [c]
+              :full-path   (rule-path p1 p2)
+              :pre         (infix->prefix (:pre opts))})
+           conclusions))))
+
+(defn check-duplication
+  "Checks if there are rules with same premises and preconditions but with
+  different conclusions, merges them if they exist."
+  [rules]
+  (vals (reduce (fn [ac {:keys [p1 p2 pre conclusions] :as r}]
+                  (let [k [p1 p2 pre]]
+                    (if (ac k)
+                      (update-in ac [k :conclusions] concat conclusions)
+                      (assoc ac k r))))
+                {} rules)))
+
+(defn question?
+  "Return true if rule allows only question as task."
+  [{:keys [pre]}]
+  (some #{:question?} pre))
+
+(defn goal?
+  "Return true if rule allows only goal as task."
+  [{pre :pre [{post :post}] :conclusions}]
+  (or (some #{:goal?} pre)
+      (some (fn [el] (and (keyword? el)
+                          (s/starts-with? (str el) ":d/")))
+            post)))
+
+(defn judgement?
+  "Return true if rule allows only judgement as task."
+  [{:keys [pre] :as rule}]
+  (not (or (question? rule) (some #{:goal} pre))))
+
+(defn add-possible-paths
+  "Selects all rules that will match the same path as current rule and adds
+  these rules to the set of rules that matches path.
+  For instance:
+  current rule's path [[--> [- :any :any] :any] :and [--> [:any :any]]]
+
+  so, if we find rule with path [[--> :any :any] :and [--> [:any :any]]],
+  it matches to current's rule path too, hence it should be added to the set
+  of rules that matches [[--> [- :any :any] :any] :and [--> [:any :any]]] path."
+  [ac [k {:keys [all]}]]
+  (let [rules (mapcat :rules (vals (select-keys ac all)))]
+    (-> ac
+        (update-in [k :rules] concat rules)
+        (update-in [k :rules] set))))
+
+(defn rule->map
+  "Adds rule to map of rules, conjoin rule to set of rules that
+  matches to pattern. Rules paths are keys in this map."
+  [ac {:keys [p1 p2 full-path] :as rule}]
+  (-> ac
+      (update-in [full-path :rules] conj rule)
+      (assoc-in [full-path :pattern] [p1 p2])
+      (assoc-in [full-path :all] (all-paths (path p1) (path p2)))
+      (assoc-in [full-path :starts-with] (set (path-invariants p1)))
+      (assoc-in [full-path :end-with] (set (path-invariants p2)))))
+
+(defn rules-map
+  "Generates map from list of #R satetments, whetre key is path, and value is
+  another map with keys pattern ans rules. Pattern is will be used to match
+  values from the premises, rules will be used to generate deriver."
+  [ruleset task-type]
+  (let [rules (reduce rule->map {} ruleset)]
+    (generate-matching rules task-type)))
+
+;---------------------------------------------------------------------------
+
+(defmacro rules->> [raw-rules & transformations]
+  (let [pairs (partition 2 transformations)]
+    (reduce (fn [code [pred fun]]
+              `(mapcat (fn [rule#]
+                         (if (~pred rule#)
+                           (~fun rule#)
+                           [rule#]))
+                       ~code))
+            `~raw-rules
+            pairs)))
+
+(defmacro defrules [name & rules]
+  `(def ~name (quote ~rules)))
+
+(defn compile-rules
+  "Define rules. Rules must be #R statements."
+  ;TODO exception on duplication of the rule
+  [& rules]
+  (time
+    (let [rules (rules->> (apply concat rules)
+                          contains-list? generate-all-lists
+                          contains-list? generate-all-lists
+                          identity rule
+                          order-for-all-same? generate-all-orders
+                          allow-swapping? swap
+                          allow-backward? expand-backward-rules)
+          judgement-rules# (check-duplication (filter judgement? rules))
+          question-rules# (check-duplication (filter question? rules))
+          goal-rules# (check-duplication (filter goal? rules))]
+      (println "Q rules:" (count question-rules#))
+      (println "J rules:" (count judgement-rules#))
+      (println "G rules:" (count goal-rules#))
+      {:judgement (rules-map judgement-rules# :judgement)
+       :question  (rules-map question-rules# :question)
+       :goal      (rules-map goal-rules# :goal)})))

src/nal/deriver/set_functions.clj

@@ -0,0 +1,22 @@
+(ns nal.deriver.set-functions
+  (:require [clojure.set :as set]))
+
+;todo performance
+(defn difference [[op & set1] [_ & set2]]
+  (into [op] (sort-by hash (set/difference (set set1) (set set2)))))
+
+(defn union [[op & set1] [_ & set2]]
+  (into [op] (sort-by hash (set/union (set set1) (set set2)))))
+
+(defn intersection [[op & set1] [_ & set2]]
+  (into [op] (sort-by hash (set/intersection (set set1) (set set2)))))
+
+(def f-map {:difference   difference
+            :union        union
+            :intersection intersection})
+
+(defn not-empty-diff? [[_ & set1] [_ & set2]]
+  (not-empty (set/difference (set set1) (set set2))))
+
+(defn not-empty-inter? [[_ & set1] [_ & set2]]
+  (not-empty (set/intersection (set set1) (set set2))))

src/nal/deriver/substitution.clj

@@ -0,0 +1,39 @@
+(ns nal.deriver.substitution
+  (:require [nal.deriver.utils :refer [walk]]
+            [clojure.core.unify :as u]
+            [clojure.string :as s]))
+
+(defn replace-vars
+  "Defn replaces var-elements from statemts by placeholders for unification."
+  [var-type statement]
+  (walk statement
+    (and (coll? :el) (= var-type (first :el)))
+    (->> :el second (str "?") symbol)))
+
+(defn unification-map
+  "Returns map of inified elements from both collections."
+  [var-symbol p2 p3]
+  (let [var-type (if (= var-symbol "$")
+                   'ind-var
+                   'dep-var)]
+    ((u/make-occurs-unify-fn #(and (coll? %) (= var-type (first %)))) p2 p3)))
+
+(def munification-map (memoize unification-map))
+
+(defn placeholder->symbol [pl]
+  (->> pl str (drop 1) s/join symbol))
+
+(defn replace-placeholders
+  "Updates keys in unification map from placeholders like ?X to vectors like
+  ['dep-var X]"
+  [var-type u-map]
+  (->> u-map
+       (map (fn [[k v]] [[var-type (placeholder->symbol k)] v]))
+       (into {})))
+
+(defn substitute
+  "Unifies p2 and p3, then replaces elements from the unification map
+  inside the conclusion."
+  [var-symbol p2 p3 conclusion]
+  (let [u-map (munification-map var-symbol p2 p3)]
+    (walk conclusion (u-map el) (u-map el))))

src/nal/deriver/terms_permutation.clj

@@ -0,0 +1,52 @@
+(ns nal.deriver.terms-permutation
+  (:require [nal.deriver.utils :refer [walk]]))
+
+(defn contains-op?
+  "Checks if statement contains operators from set."
+  [statement s]
+  (cond
+    (symbol? statement) (s statement)
+    (or (keyword? statement)
+        (char? statement)
+        (string? statement)
+        (number? statement)) false
+    :default (some identity (map #(contains-op? % s) statement))))
+
+(defn replace-op
+  "Replaces operator \"from\" by operator \"to\""
+  [statement from to]
+  (walk statement (= from el) to))
+
+(defn permute-op
+  "Makes permuatation of operators from s in statement."
+  [statement s]
+  (if-let [op (contains-op? statement s)]
+    (map #(replace-op statement op %) s)
+    [statement]))
+
+;equivalences, implications, conjunctions - sets of operators that are use in
+; permutation for :order-for-all-same postcondititon
+(def equivalences #{'<=> '</> '<|>})
+(def implications #{'==> 'pred-impl '=|> 'retro-impl})
+(def conjunctions #{'conj '&| 'seq-conj})
+
+(defn generate-all-orders
+  "Permutes all operators in statement with :order-for-all-same precondition."
+  [{:keys [p1 p2 conclusions full-path pre] :as rule}]
+  (let [{:keys [conclusion] :as c1} (first conclusions)
+        statements (->> (permute-op [p1 p2 conclusion full-path pre] equivalences)
+                        (mapcat (fn [st] (permute-op st conjunctions)))
+                        (mapcat (fn [st] (permute-op st implications)))
+                        set)]
+    (map (fn [[p1 p2 c full-path pre]]
+           (assoc rule :p1 p1
+                       :p2 p2
+                       :full-path full-path
+                       :conclusions [(assoc c1 :conclusion c)]
+                       :pre pre))
+         statements)))
+
+(defn order-for-all-same?
+  "Return true if rule contains order-for-all-same postcondition"
+  [{:keys [conclusions]}]
+  (some #{:order-for-all-same} (:post (first conclusions))))

src/nal/deriver/truth.clj

@@ -0,0 +1,175 @@
+(ns nal.deriver.truth
+  (:require [narjure.defaults :refer [horizon] :as d]))
+
+;https://github.com/opennars/opennars/blob/6611ee7f0b1428676b01ae4a382241a77ae3a346/nars_logic/src/main/java/nars/nal/meta/BeliefFunction.java
+;https://github.com/opennars/opennars/blob/7b27dacec4cdbe77ca03d89296323d49875ac213/nars_logic/src/main/java/nars/truth/TruthFunctions.java
+;https://github.com/opennars/opennars/blob/b3d97d1543b70dac604aff75eca7fe3d38f1e823/nars_logic/src/main/java/nars/truth/Truth.java#L87
+
+(defn t-and
+  (^double [^double a ^double b] (* a b))
+  (^double [^double a ^double b ^double c] (* a b c))
+  (^double [^double a ^double b ^double c ^double d] (* a b c d)))
+
+(defn t-or
+  (^double [^double a ^double b] (- 1 (* (- 1 a) (- 1 b)))))
+
+(defn w2c ^double [^double w]
+  (let [^double h horizon] (/ w (+ w h))))
+
+(defn c2w ^double [^double c]
+  (let [^double h horizon] (/ (* h c) (- 1 c))))
+
+;--------------------------------------------
+(defn conversion [_ p1]
+  (when-let [[f c] p1] [1 (w2c (and f c))]))
+
+(defn negation [[^double f ^double c] _] [(- 1 f) c])
+
+(defn contraposition [[^double f ^double c]]
+  [0 (w2c (and (- 1 f) c))])
+
+(defn revision [[^double f1 ^double c1] [^double f2 ^double c2]]
+  (let [w1 (c2w c1)
+        w2 (c2w c2)
+        w (+ w1 w2)]
+    [(/ (+ (* w1 f1) (* w2 f2)) w) (w2c w)]))
+
+(defn deduction [[^double f1 ^double c1] [^double f2 ^double c2]]
+  [(t-and f1 f2) (t-and c1 c2)])
+(defn a-deduction [[^double f1 ^double c1] c2] [f1 (t-and f1 c1 c2)])
+
+(defn analogy [[^double f1 ^double c1] [^double f2 ^double c2]]
+  [(t-and f1 f2) (t-and c1 c2 f2)])
+
+(defn resemblance [[^double f1 ^double c1] [^double f2 ^double c2]]
+  [(t-and f1 f2) (t-and c1 c2 (t-or f1 f2))])
+
+(defn abduction [[^double f1 ^double c1] [^double f2 ^double c2]]
+  [f1 (w2c (t-and f2 c1 c2))])
+
+(defn induction [p1 p2] (abduction p2 p1))
+
+(defn exemplification [[^double f1 ^double c1] [^double f2 ^double c2]]
+  [1 (w2c (t-and f1 f2 c1 c2))])
+
+(defn comparison [[^double f1 ^double c1] [^double f2 ^double c2]]
+  (let [f0 (t-or f1 f2)
+        f (if (zero? f0) 0 (/ (t-and f1 f2) f0))
+        c (w2c (t-and f0 c1 c2))]
+    [f c]))
+
+(defn union [[^double f1 ^double c1] [^double f2 ^double c2]]
+  [(t-or f1 f2) (t-and c1 c2)])
+
+(defn intersection [[^double f1 ^double c1] [^double f2 ^double c2]]
+  [(t-and f1 f2) (t-and c1 c2)])
+
+(defn anonymous-analogy [[^double f1 ^double c1] p2] (analogy p2 [f1 (w2c c1)]))
+
+(defn decompose-pnn [[^double f1 ^double c1] p2]
+  (when p2
+    (let [[^double f2 ^double c2] p2
+          fn (t-and f1 (- 1 f2))]
+      [(- 1 fn) (t-and fn c1 c2)])))
+
+(defn decompose-npp [[^double f1 ^double c1] p2]
+  (when p2
+    (let [[^double f2 ^double c2] p2
+          f (t-and (- 1 f1) f2)]
+      [f (t-and f c1 c2)])))
+
+(defn decompose-pnp [[^double f1 ^double c1] p2]
+  (when p2
+    (let [[^double f2 ^double c2] p2
+          f (t-and f1 (- 1 f2))]
+      [f (t-and f c1 c2)])))
+
+(defn decompose-ppp [p1 p2] (decompose-npp (negation p1 p2) p2))
+
+(defn decompose-nnn [[^double f1 ^double c1] p2]
+  (when p2
+    (let [[^double f2 ^double c2] p2
+          fn (t-and (- 1 f1) (- 1 f2))]
+      [(- 1 fn) (t-and fn c1 c2)])))
+
+(defn difference [[^double f1 ^double c1] [^double f2 ^double c2]]
+  [(t-and f1 (- 1 f2)) (t-and c1 c2)])
+
+(defn structual-intersection [_ p2] (deduction p2 [1 d/judgement-confidence]))
+
+(defn structual-deduction [p1 _] (deduction p1 [1 d/judgement-confidence]))
+
+(defn structual-abduction [p1 _] (abduction p1 [1 d/judgement-confidence]))
+
+(defn reduce-conjunction [p1 p2]
+  (-> (negation p1 p2)
+      (intersection p2)
+      (a-deduction 1)
+      (negation p2)))
+
+(defn t-identity [p1 _] p1)
+
+(defn belief-identity [p1 p2] (when p2 p1))
+
+(defn belief-structural-deduction [_ p2]
+  (when p2 (deduction p2 [1 d/judgement-confidence])))
+
+(defn belief-structural-difference [_ p2]
+  (when p2
+    (let [[^double f ^double c] (deduction p2 [1 d/judgement-confidence])]
+      [(- 1 f) c])))
+
+(defn belief-negation [_ p2] (when p2 (negation p2 nil)))
+
+(defn desire-weak [[f1 c1] [f2 c2]]
+  [(t-and f1 f2) (t-and c1 c2 f2 (w2c 1.0))])
+
+(defn desire-induction
+  [[f1 c1] [f2 c2]]
+  [f1 (w2c (t-and f2 c1 c2))])
+
+(defn desire-structural-strong
+  [t _]
+  (analogy t [1.0 d/judgement-confidence]))
+
+(defn expectation [[f c]]
+  (+ (* c (- f 0.5)) 0.5))
+
+(def tvtypes
+  {:t/structural-deduction         structual-abduction
+   :t/struct-int                   structual-intersection
+   :t/struct-abd                   structual-abduction
+   :t/identity                     t-identity
+   :t/conversion                   conversion
+   :t/contraposition               contraposition
+   :t/negation                     negation
+   :t/comparison                   comparison
+   :t/intersection                 intersection
+   :t/union                        union
+   :t/difference                   difference
+   :t/decompose-ppp                decompose-ppp
+   :t/decompose-pnn                decompose-pnn
+   :t/decompose-nnn                decompose-nnn
+   :t/decompose-npp                decompose-npp
+   :t/decompose-pnp                decompose-pnp
+   :t/induction                    induction
+   :t/abduction                    abduction
+   :t/deduction                    deduction
+   :t/exemplification              exemplification
+   :t/analogy                      analogy
+   :t/resemblance                  resemblance
+   :t/anonymous-analogy            anonymous-analogy
+   :t/belief-identity              belief-identity
+   :t/belief-structural-deduction  belief-structural-deduction
+   :t/belief-structural-difference belief-structural-difference
+   :t/belief-negation              belief-negation
+   :t/reduce-conjunction           reduce-conjunction})
+
+(def dvtypes
+  {:d/strong            analogy
+   :d/deduction         intersection
+   :d/weak              desire-weak
+   :d/induction         desire-induction
+   :d/identity          identity
+   :d/negation          negation
+   :d/structural-strong desire-structural-strong})

src/nal/deriver/utils.clj

@@ -0,0 +1,22 @@
+(ns nal.deriver.utils
+  (:require [clojure.walk :as w]))
+
+(defn not-operator?
+  "Checks if element is not operator"
+  [el] (re-matches #"[akxA-Z$]" (-> el str first str)))
+
+(def operator? (complement not-operator?))
+
+(defmacro walk
+  "Macro that helps to replace elements during walk. The first argument
+  is collection, rest of the arguments are cond-like
+  expressions. Default result of cond is element itself.
+  el (optionally :el) is reserved name for current element of collection."
+  [coll & conditions]
+  (let [el (gensym)
+        replace-el (fn [coll]
+                     (w/postwalk #(if (or (= 'el %) (= :el %)) el %) coll))]
+    `(w/postwalk
+       (fn [~el] (cond ~@(replace-el conditions)
+                       :else ~el))
+       ~coll)))

src/nal/reader.clj

@@ -0,0 +1,56 @@
+(ns nal.reader
+  (:require [clojure.string :as s])
+  (:import (clojure.lang LispReader)))
+
+(defn dispatch-reader-macro [ch fun]
+  (let [dm (.get
+             (doto
+               (.getDeclaredField LispReader "dispatchMacros")
+               (.setAccessible true))
+             nil)]
+    (aset dm (int ch) fun)))
+
+(defn fetch-rule
+  ([rdr] (fetch-rule rdr "" 0))
+  ([rdr prev cnt]
+   (let [c (.read rdr)
+         cnt (case (char c)
+               \] (dec cnt)
+               \[ (inc cnt)
+               cnt)]
+     (if (neg? cnt)
+       prev
+       (recur rdr (str prev (char c)) cnt)))))
+
+(defn add-brackets [s]
+  (str "[" s "]"))
+
+(defn replacements [s]
+  (-> s
+      (s/replace #"\{([^\}]*)\}" "(ext-set $1)")
+      (s/replace #"\[([^\]]*)]" "(int-set $1)")
+      (s/replace #"=\\>" "retro-impl")
+      (s/replace #"=/>" "pred-impl")
+      (s/replace #"~" "int-dif")
+      (s/replace #"&/" "seq-conj ")
+      (s/replace #"\(&\s" "(ext-inter ")
+      (s/replace #"\s&\s" " ext-inter ")
+      (s/replace #"&&" "conj")
+      (s/replace #"\{--" "inst")
+      (s/replace #"--]" "prop")
+      (s/replace #"\{-\]" "inst-prop")
+      (s/replace #"\(\\" "(int-image")
+      (s/replace #"\(/" "(ext-image")
+      (s/replace #"\$([A-Z])" "(ind-var $1)")
+      (s/replace #"#([A-Z])" "(dep-var $1)")))
+
+(defn read-rule [s]
+  (-> s replacements add-brackets read-string))
+
+(defn rule [rdr letter-R opts & other]
+  (let [c (.read rdr)]
+    (if (= c (int \[))
+      (read-rule (fetch-rule rdr))
+      (throw (Exception. (str "Reader barfed on " (char c)))))))
+
+(dispatch-reader-macro \R rule)

src/nal/rules.clj

@@ -0,0 +1,452 @@
+(ns nal.rules
+  (:require [nal.deriver.rules :refer [defrules compile-rules]]
+            nal.reader))
+
+(declare --S S --P P <-> |- --> ==> M || && =|> -- A Ai B <=>)
+
+(defrules all-rules
+  ;Similarity to Inheritance
+  #R[(S --> P) (S <-> P) |- (S --> P) :post (:t/struct-int :p/judgement) :pre (:question?)]
+  ;Inheritance to Similarity
+  #R[(S <-> P) (S --> P) |- (S <-> P) :post (:t/struct-abd :p/judgement) :pre (:question?)]
+  ;Set Definition Similarity to Inheritance
+  #R[(S <-> {P}) S |- (S --> {P}) :post (:t/identity :d/identity :allow-backward)]
+  #R[(S <-> {P}) {P} |- (S --> {P}) :post (:t/identity :d/identity :allow-backward)]
+  #R[([S] <-> P) [S] |- ([S] --> P) :post (:t/identity :d/identity :allow-backward)]
+  #R[([S] <-> P) P |- ([S] --> P) :post (:t/identity :d/identity :allow-backward)]
+  #R[({S} <-> {P}) {S} |- ({P} --> {S}) :post (:t/identity :d/identity :allow-backward)]
+  #R[({S} <-> {P}) {P} |- ({P} --> {S}) :post (:t/identity :d/identity :allow-backward)]
+  #R[([S] <-> [P]) [S] |- ([P] --> [S]) :post (:t/identity :d/identity :allow-backward)]
+  #R[([S] <-> [P]) [P] |- ([P] --> [S]) :post (:t/identity :d/identity :allow-backward)]
+
+  ;Set Definition Unwrap
+  #R[({S} <-> {P}) {S} |- (S <-> P) :post (:t/identity :d/identity :allow-backward)]
+  #R[({S} <-> {P}) {P} |- (S <-> P) :post (:t/identity :d/identity :allow-backward)]
+  #R[([S] <-> [P]) [S] |- (S <-> P) :post (:t/identity :d/identity :allow-backward)]
+  #R[([S] <-> [P]) [P] |- (S <-> P) :post (:t/identity :d/identity :allow-backward)]
+
+  ; Nothing is more specific than a instance so it's similar
+  #R[(S --> {P}) S |- (S <-> {P}) :post (:t/identity :d/identity :allow-backward)]
+  #R[(S --> {P}) {P} |- (S <-> {P}) :post (:t/identity :d/identity :allow-backward)]
+
+  ; nothing is more general than a property so it's similar
+  #R[([S] --> P) [S] |- ([S] <-> P) :post (:t/identity :d/identity :allow-backward)]
+  #R[([S] --> P) P |- ([S] <-> P) :post (:t/identity :d/identity :allow-backward)]
+
+  ; Immediate Inference
+  ; If S can stand for P P can to a certain low degree also represent the class S
+  ; If after S usually P happens then it might be a good guess that usually before P happens S happens.
+  #R[(P --> S) (S --> P) |- (P --> S) :post (:t/conversion :p/judgement) :pre (:question?)]
+  #R[(P ==> S) (S ==> P) |- (P ==> S) :post (:t/conversion :p/judgement) :pre (:question?)]
+  #R[(P =|> S) (S =|> P) |- (P =|> S) :post (:t/conversion :p/judgement) :pre (:question?)]
+  #R[(P =\> S) (S =/> P) |- (P =\> S) :post (:t/conversion :p/judgement) :pre (:question?)]
+  #R[(P =/> S) (S =\> P) |- (P =/> S) :post (:t/conversion :p/judgement) :pre (:question?)]
+
+  ; "If not smoking lets you be healthy being not healthy may be the result of smoking"
+  #R[(--S ==> P) P |- (--P ==> S) :post (:t/contraposition :allow-backward)]
+  #R[(--S ==> P) --S |- (--P ==> S) :post (:t/contraposition :allow-backward)]
+  #R[(--S =|> P) P |- (--P =|> S) :post (:t/contraposition :allow-backward)]
+  #R[(--S =|> P) --S |- (--P =|> S) :post (:t/contraposition :allow-backward)]
+  #R[(--S =/> P) P |- (--P =\> S) :post (:t/contraposition :allow-backward)]
+  #R[(--S =/> P) --S |- (--P =\> S) :post (:t/contraposition :allow-backward)]
+  #R[(--S =\> P) P |- (--P =/> S) :post (:t/contraposition :allow-backward)]
+  #R[(--S =\> P) --S |- (--P =/> S) :post (:t/contraposition :allow-backward)]
+
+  ; A belief b <f c> is equal to --b <1-f c>  which is the negation rule:
+  #R[(A --> B) A |- --(A --> B) :post (:t/negation :d/negation :allow-backward)]
+  #R[(A --> B) B |- --(A --> B) :post (:t/negation :d/negation :allow-backward)]
+  #R[--(A --> B) A |- (A --> B) :post (:t/negation :d/negation :allow-backward)]
+  #R[--(A --> B) B |- (A --> B) :post (:t/negation :d/negation :allow-backward)]
+
+  #R[(A <-> B) A |- --(A <-> B) :post (:t/negation :d/negation :allow-backward)]
+  #R[(A <-> B) B |- --(A <-> B) :post (:t/negation :d/negation :allow-backward)]
+  #R[--(A <-> B) A |- (A <-> B) :post (:t/negation :d/negation :allow-backward)]
+  #R[--(A <-> B) B |- (A <-> B) :post (:t/negation :d/negation :allow-backward)]
+
+  #R[(A ==> B) A |- --(A ==> B) :post (:t/negation :d/negation :allow-backward :order-for-all-same)]
+  #R[(A ==> B) B |- --(A ==> B) :post (:t/negation :d/negation :allow-backward :order-for-all-same)]
+  #R[--(A ==> B) A |- (A ==> B) :post (:t/negation :d/negation :allow-backward :order-for-all-same)]
+  #R[--(A ==> B) B |- (A ==> B) :post (:t/negation :d/negation :allow-backward :order-for-all-same)]
+
+  #R[(A <=> B) A |- --(A <=> B) :post (:t/negation :d/negation :allow-backward :order-for-all-same)]
+  #R[(A <=> B) B |- --(A <=> B) :post (:t/negation :d/negation :allow-backward :order-for-all-same)]
+  #R[--(A <=> B) A |- (A <=> B) :post (:t/negation :d/negation :allow-backward :order-for-all-same)]
+  #R[--(A <=> B) B |- (A <=> B) :post (:t/negation :d/negation :allow-backward :order-for-all-same)]
+
+  ; If A is a special case of B and B is a special case of C so is A a special case of C (strong) the other variations are hypotheses (weak)
+  #R[(A --> B) (B --> C) |- (A --> C) :pre ((:!= A C)) :post (:t/deduction :d/strong :allow-backward)]
+  #R[(A --> B) (A --> C) |- (C --> B) :pre ((:!= B C)) :post (:t/abduction :d/weak :allow-backward)]
+  #R[(A --> C) (B --> C) |- (B --> A) :pre ((:!= A B)) :post (:t/induction :d/weak :allow-backward)]
+  #R[(A --> B) (B --> C) |- (C --> A) :pre ((:!= C A)) :post (:t/exemplification :d/weak :allow-backward)]
+
+  ; similarity from inheritance
+  ; If S is a special case of P and P is a special case of S then S and P are similar
+  #R[(S --> P) (P --> S) |- (S <-> P) :post (:t/intersection :d/strong :allow-backward)]
+
+  ; inheritance from similarty <- TODO check why this one was missing
+  #R[(S <-> P) (P --> S) |- (S --> P) :post (:t/reduce-conjunction :d/strong :allow-backward)]
+
+  ; similarity-based syllogism
+  ; If P and S are a special case of M then they might be similar (weak)
+  ; also if P and S are a general case of M
+  #R[(P --> M) (S --> M) |- (S <-> P) :post (:t/comparison :d/weak :allow-backward) :pre ((:!= S P))]
+  #R[(M --> P) (M --> S) |- (S <-> P) :post (:t/comparison :d/weak :allow-backward) :pre ((:!= S P))]
+
+  ; If M is a special case of P and S and M are similar then S is also a special case of P (strong)
+  #R[(M --> P) (S <-> M) |- (S --> P) :pre ((:!= S P)) :post (:t/analogy :d/strong :allow-backward)]
+  #R[(P --> M) (S <-> M) |- (P --> S) :pre ((:!= S P)) :post (:t/analogy :d/strong :allow-backward)]
+  #R[(M <-> P) (S <-> M) |- (S <-> P) :pre ((:!= S P)) :post (:t/resemblance :d/strong :allow-backward)]
+
+  ; inheritance-based composition
+  ; If P and S are in the intension/extension of M then union/difference and intersection can be built:
+  #R[(P --> M) (S --> M) |- (((S | P) --> M) :post (:t/intersection)
+                              ((S & P) --> M) :post (:t/union)
+                              ((P ~ S) --> M) :post (:t/difference))
+     :pre ((:not-set? S) (:not-set? P)(:!= S P) (:no-common-subterm S P))]
+
+  #R[(M --> P) (M --> S) |- ((M --> (P & S)) :post (:t/intersection)
+                              (M --> (P | S)) :post (:t/union)
+                              (M --> (P - S)) :post (:t/difference))
+     :pre ((:not-set? S) (:not-set? P)(:!= S P) (:no-common-subterm S P))]
+
+  ; inheritance-based decomposition
+  ; if (S --> M) is the case and ((| S :list/A) --> M) is not the case then ((| :list/A) --> M) is not the case hence :t/decompose-pnn
+  #R[(S --> M) ((| S :list/A) --> M) |- ((| :list/A) --> M) :post (:t/decompose-pnn)]
+  #R[(S --> M) ((& S :list/A) --> M) |- ((& :list/A) --> M) :post (:t/decompose-npp)]
+  #R[(S --> M) ((S - P) --> M) |- (P --> M) :post (:t/decompose-pnp)]
+  #R[(S --> M) ((P - S) --> M) |- (P --> M) :post (:t/decompose-nnn)]
+
+  #R[(M --> S) (M --> (& S :list/A)) |- (M --> (& :list/A)) :post (:t/decompose-pnn)]
+  #R[(M --> S) (M --> (| S :list/A)) |- (M --> (| :list/A)) :post (:t/decompose-npp)]
+  #R[(M --> S) (M --> (S ~ P)) |- (M --> P) :post (:t/decompose-pnp)]
+  #R[(M --> S) (M --> (P ~ S)) |- (M --> P) :post (:t/decompose-nnn)]
+
+  ; Set comprehension:
+  #R[(C --> A) (C --> B) |- (C --> R) :post (:t/union) :pre ((:set-ext? A) (:union A B R))]
+  #R[(C --> A) (C --> B) |- (C --> R) :post (:t/intersection) :pre ((:set-int? A) (:union A B R))]
+  #R[(A --> C) (B --> C) |- (R --> C) :post (:t/intersection) :pre ((:set-ext? A) (:union A B R))]
+  #R[(A --> C) (B --> C) |- (R --> C) :post (:t/union) :pre ((:set-int? A) (:union A B R))]
+
+  #R[(C --> A) (C --> B) |- (C --> R) :post (:t/intersection) :pre ((:set-ext? A) (:intersection A B R))]
+  #R[(C --> A) (C --> B) |- (C --> R) :post (:t/union) :pre ((:set-int? A) (:intersection A B R))]
+  #R[(A --> C) (B --> C) |- (R --> C) :post (:t/union) :pre ((:set-ext? A) (:intersection A B R))]
+  #R[(A --> C) (B --> C) |- (R --> C) :post (:t/intersection) :pre ((:set-int? A) (:intersection A B R))]
+
+  #R[(C --> A) (C --> B) |- (C --> R) :post (:t/difference) :pre ((:difference A B R))]
+  #R[(A --> C) (B --> C) |- (R --> C) :post (:t/difference) :pre ((:difference A B R))]
+
+  ; Set element takeout:
+  #R[(C --> {:list/A}) C |- (C --> {:from/A}) :post (:t/structural-deduction)]
+  #R[(C --> [:list/A]) C |- (C --> [:from/A]) :post (:t/structural-deduction)]
+  #R[({:list/A} --> C) C |- ({:from/A} --> C) :post (:t/structural-deduction)]
+  #R[([:list/A] --> C) C |- ([:from/A] --> C) :post (:t/structural-deduction)]
+
+  ; NAL3 single premise inference:
+  #R[((| :list/A) --> M) M |- (:from/A --> M) :post (:t/structural-deduction)]
+  #R[(M --> (& :list/A)) M |- (M --> :from/A) :post (:t/structural-deduction)]
+
+  #R[((B - G) --> S) S |- (B --> S) :post (:t/structural-deduction)]
+  #R[(R --> (B ~ S)) R |- (R --> B) :post (:t/structural-deduction)]
+
+  ; NAL4 - Transformations between products and images:
+  ; Relations and transforming them into different representations so that arguments and the relation it'self can become the subject or predicate
+  #R[((* :list/A) --> M) Ai |- (Ai --> (/ M :list/A))
+     :pre ((:substitute-from-list Ai _) (:contains? (:list/A) Ai))
+     :post (:t/identity :d/identity)]
+  #R[(M --> (* :list/A)) Ai |- ((\ M :list/A) --> Ai)
+     :pre ((:substitute-from-list Ai _) (:contains? (:list/A) Ai))
+     :post (:t/identity :d/identity)]
+  #R[(Ai --> (/ M :list/A )) M |- ((* :list/A) --> M)
+     :pre ((:substitute-from-list _ Ai) (:contains? (:list/A) Ai))
+     :post (:t/identity :d/identity)]
+  #R[((\ M :list/A) --> Ai) M |- (M --> (:list/A))
+      :pre ((:substitute-from-list _ Ai) (:contains? (:list/A) Ai))
+     :post (:t/identity :d/identity)]
+
+  ; implication-based syllogism
+  #R[(M ==> P) (S ==> M) |- (S ==> P) :post (:t/deduction :order-for-all-same :allow-backward) :pre ((:!= S P))]
+
+  #R[(P ==> M) (S ==> M) |- (S ==> P) :post (:t/induction :allow-backward) :pre ((:!= S P))]
+  #R[(P =|> M) (S =|> M) |- (S =|> P) :post (:t/induction :allow-backward) :pre ((:!= S P))]
+  #R[(P =/> M) (S =/> M) |- (S =|> P) :post (:t/induction :allow-backward) :pre ((:!= S P))]
+  #R[(P =\> M) (S =\> M) |- (S =|> P) :post (:t/induction :allow-backward) :pre ((:!= S P))]
+
+  #R[(M ==> P) (M ==> S) |- (S ==> P) :post (:t/abduction :allow-backward) :pre ((:!= S P))]
+  #R[(M =/> P) (M =/> S) |- (S =|> P) :post (:t/abduction :allow-backward) :pre ((:!= S P))]
+  #R[(M =|> P) (M =|> S) |- (S =|> P) :post (:t/abduction :allow-backward) :pre ((:!= S P))]
+  #R[(M =\> P) (M =\> S) |- (S =|> P) :post (:t/abduction :allow-backward) :pre ((:!= S P))]
+
+  #R[(P ==> M) (M ==> S) |- (S ==> P) :post (:t/exemplification :allow-backward) :pre ((:!= S P))]
+  #R[(P =/> M) (M =/> S) |- (S =\> P) :post (:t/exemplification :allow-backward) :pre ((:!= S P))]
+  #R[(P =\> M) (M =\> S) |- (S =/> P) :post (:t/exemplification :allow-backward) :pre ((:!= S P))]
+  #R[(P =|> M) (M =|> S) |- (S =|> P) :post (:t/exemplification :allow-backward) :pre ((:!= S P))]
+
+  ; equivalence-based syllogism
+  ; Same as for inheritance again
+  #R[(P ==> M) (S ==> M) |- (S <=> P) :pre ((:!= S P)) :post (:t/comparison :allow-backward)]
+  #R[(P =/> M) (S =/> M) |- ((S <|> P) :post (:t/comparison :allow-backward)
+                              (S </> P) :post (:t/comparison :allow-backward)
+                              (P </> S) :post (:t/comparison :allow-backward))
+     :pre ((:!= S P))]
+  #R[(P =|> M) (S =|> M) |- (S <|> P) :pre ((:!= S P)) :post (:t/comparison :allow-backward)]
+  #R[(P =\> M) (S =\> M) |- ((S <|> P) :post (:t/comparison :allow-backward)
+                              (S </> P) :post (:t/comparison :allow-backward)
+                              (P </> S) :post (:t/comparison :allow-backward))
+     :pre ((:!= S P))]
+
+  #R[(M ==> P) (M ==> S) |- (S <=> P) :pre ((:!= S P)) :post (:t/comparison :allow-backward)]
+  #R[(M =/> P) (M =/> S) |- ((S <|> P) :post (:t/comparison :allow-backward)
+                              (S </> P) :post (:t/comparison :allow-backward)
+                              (P </> S) :post (:t/comparison :allow-backward))
+     :pre ((:!= S P))]
+  #R[(M =|> P) (M =|> S) |- (S <|> P) :pre ((:!= S P)) :post (:t/comparison :allow-backward)]
+
+  ; Same as for inheritance again
+  #R[(M ==> P) (S <=> M) |- (S ==> P) :pre ((:!= S P)) :post (:t/analogy :allow-backward)]
+  #R[(M =/> P) (S </> M) |- (S =/> P) :pre ((:!= S P)) :post (:t/analogy :allow-backward)]
+  #R[(M =/> P) (S <|> M) |- (S =/> P) :pre ((:!= S P)) :post (:t/analogy :allow-backward)]
+  #R[(M =|> P) (S <|> M) |- (S =|> P) :pre ((:!= S P)) :post (:t/analogy :allow-backward)]
+  #R[(M =\> P) (M </> S) |- (S =\> P) :pre ((:!= S P)) :post (:t/analogy :allow-backward)]
+  #R[(M =\> P) (S <|> M) |- (S =\> P) :pre ((:!= S P)) :post (:t/analogy :allow-backward)]
+
+  #R[(P ==> M) (S <=> M) |- (P ==> S) :pre ((:!= S P)) :post (:t/analogy :allow-backward)]
+  #R[(P =/> M) (S <|> M) |- (P =/> S) :pre ((:!= S P)) :post (:t/analogy :allow-backward)]
+  #R[(P =|> M) (S <|> M) |- (P =|> S) :pre ((:!= S P)) :post (:t/analogy :allow-backward)]
+  #R[(P =\> M) (S </> M) |- (P =\> S) :pre ((:!= S P)) :post (:t/analogy :allow-backward)]
+  #R[(P =\> M) (S <|> M) |- (P =\> S) :pre ((:!= S P)) :post (:t/analogy :allow-backward)]
+
+  #R[(M <=> P) (S <=> M) |- (S <=> P) :pre ((:!= S P)) :post (:t/resemblance :order-for-all-same :allow-backward)]
+  #R[(M </> P) (S <|> M) |- (S </> P) :pre ((:!= S P)) :post (:t/resemblance :allow-backward)]
+  #R[(M <|> P) (S </> M) |- (S </> P) :pre ((:!= S P)) :post (:t/resemblance :allow-backward)]
+
+  ; implication-based composition
+  ; Same as for inheritance again
+  #R[(P ==> M) (S ==> M) |- (((P || S) ==> M) :post (:t/intersection)
+                              ((P && S) ==> M) :post (:t/union))
+     :pre ((:!= S P))]
+  #R[(P =|> M) (S =|> M) |- (((P || S) =|> M) :post (:t/intersection)
+                              ((P &| S) =|> M) :post (:t/union))
+     :pre ((:!= S P))]
+  #R[(P =/> M) (S =/> M) |- (((P || S) =/> M) :post (:t/intersection)
+                              ((P &| S) =/> M) :post (:t/union))
+     :pre ((:!= S P)) ]
+  #R[(P =\> M) (S =\> M) |- (((P || S) =\> M) :post (:t/intersection)
+                                ((P &| S) =\> M) :post (:t/union))
+     :pre ((:!= S P))]
+
+  #R[(M ==> P) (M ==> S) |- ((M ==> (P && S)) :post (:t/intersection)
+                              (M ==> (P || S)) :post (:t/union))
+     :pre ((:!= S P))]
+  #R[(M =/> P) (M =/> S) |- ((M =/> (P &| S)) :post (:t/intersection)
+                              (M =/> (P || S)) :post (:t/union))
+     :pre ((:!= S P))]
+  #R[(M =|> P) (M =|> S) |- ((M =|> (P &| S)) :post (:t/intersection)
+                              (M =|> (P || S)) :post (:t/union))
+     :pre ((:!= S P))]
+  #R[(M =\> P) (M =\> S) |- ((M =\> (P &| S)) :post (:t/intersection)
+                              (M =\> (P || S)) :post (:t/union))
+     :pre ((:!= S P))]
+
+  #R[(D =/> R) (D =\> K) |- ((K =/> R) :post (:t/abduction)
+                              (R =\> K) :post (:t/induction)
+                              (K </> R) :post (:t/comparison))
+     :pre ((:!= R K))]
+
+  ; implication-based decomposition
+  ; Same as for inheritance again
+  #R[(S ==> M) ((|| S :list/A) ==> M) |- ((|| :list/A) ==> M) :post (:t/decompose-pnn :order-for-all-same)]
+  #R[(S ==> M) ((&& S :list/A) ==> M) |- ((&& :list/A) ==> M) :post (:t/decompose-npp :order-for-all-same :seq-interval-from-premises)]
+  #R[(M ==> S) (M ==> (&& S :list/A)) |- (M ==> (&& :list/A)) :post (:t/decompose-pnn :order-for-all-same :seq-interval-from-premises)]
+  #R[(M ==> S) (M ==> (|| S :list/A)) |- (M ==> (|| :list/A)) :post (:t/decompose-npp :order-for-all-same)]
+
+  ; conditional syllogism
+  ; If after M P usually happens and M happens it means P is expected to happen
+  #R[M (M ==> P) |- P :post (:t/deduction :d/induction :order-for-all-same) :pre ((:shift-occurrence-forward ==>))]
+  #R[M (P ==> M) |- P :post (:t/abduction :d/deduction :order-for-all-same) :pre ((:shift-occurrence-backward ==>))]
+  #R[M (S <=> M) |- S :post (:t/analogy :d/strong :order-for-all-same) :pre ((:shift-occurrence-backward <=>))]
+  #R[M (M <=> S) |- S :post (:t/analogy :d/strong :order-for-all-same) :pre ((:shift-occurrence-forward ==>))]
+
+  ; conjunction decompose
+  #R[(&& :list/A) Ai |- Ai :pre (:contains? (:list/A) Ai) :post (:t/structural-deduction :d/structural-strong)]
+  #R[(&/ :list/A) Ai |- Ai :pre (:contains? (:list/A) Ai) :post (:t/structural-deduction :d/structural-strong)]
+  #R[(&| :list/A) Ai |- Ai :pre (:contains? (:list/A) Ai) :post (:t/structural-deduction :d/structural-strong)]
+  #R[(&/ B :list/A) B |- (&/ :list/A) :pre (:goal?) :post (:t/deduction :d/strong :seq-interval-from-premises)]
+
+  ; propositional decomposition
+  ; If S is the case and (&& S :list/A) is not the case it can't be that (&& :list/A) is the case
+  #R[S (&/ S :list/A) |- (&/ :list/A) :post (:t/decompose-pnn :seq-interval-from-premises)]
+  #R[S (&| S :list/A) |- (&| :list/A) :post (:t/decompose-pnn)]
+  #R[S (&& S :list/A) |- (&& :list/A) :post (:t/decompose-pnn)]
+  #R[S (|| S :list/A) |- (|| :list/A) :post (:t/decompose-npp)]
+
+  ; Additional for negation: https://groups.google.com/forum/#!topic/open-nars/g-7r0jjq2Vc
+  #R[S (&/ (-- S) :list/A) |- (&/ :list/A) :post (:t/decompose-nnn :seq-interval-from-premises)]
+  #R[S (&| (-- S) :list/A) |- (&| :list/A) :post (:t/decompose-nnn)]
+  #R[S (&& (-- S) :list/A) |- (&& :list/A) :post (:t/decompose-nnn)]
+  #R[S (|| (-- S) :list/A) |- (|| :list/A) :post (:t/decompose-ppp)]
+
+  ; multi-conditional syllogism
+  ; Inference about the pre/postconditions
+  #R[Y ((&& X :list/A) ==> B) |- ((&& :list/A) ==> B) :pre ((:substitute-if-unifies "$" X Y)) :post (:t/deduction :order-for-all-same :seq-interval-from-premises)]
+  #R[((&& M :list/A) ==> C) ((&& :list/A) ==> C) |- M :post (:t/abduction :order-for-all-same)]
+
+  ; Can be derived by NAL7 rules so this won't be necessary there (:order-for-all-same left out here)
+  ; the first rule does not have :order-for-all-same because it would be invalid see: https://groups.google.com/forum/#!topic/open-nars/r5UJo64Qhrk
+  #R[((&& :list/A) ==> C) M |- ((&& M :list/A) ==> C) :pre ((:not-implication-or-equivalence M)) :post (:t/induction)]
+  #R[((&& :list/A) =|> C) M |- ((&& M :list/A) =|> C) :pre ((:not-implication-or-equivalence M)) :post (:t/induction)]
+  #R[((&& :list/A) =/> C) M |- ((&& M :list/A) =/> C) :pre ((:not-implication-or-equivalence M)) :post (:t/induction)]
+  #R[((&& :list/A) =\> C) M |- ((&& M :list/A) =\> C) :pre ((:not-implication-or-equivalence M)) :post (:t/induction)]
+  #R[(A ==> M) ((&& M :list/A) ==> C) |- ((&& A :list/A) ==> C) :post (:t/deduction :order-for-all-same :seq-interval-from-premises)]
+  #R[((&& M :list/A) ==> C) ((&& A :list/A) ==> C) |- (A ==> M) :post (:t/induction :order-for-all-same)]
+  #R[(A ==> M) ((&& A :list/A) ==> C) |- ((&& M :list/A) ==> C) :post (:t/abduction :order-for-all-same :seq-interval-from-premises)]
+
+  ; variable introduction
+  ; Introduce variables by common subject or predicate
+  #R[(S --> M) (P --> M) |- (((P --> $X) ==> (S --> $X)) :post (:t/abduction)
+                              ((S --> $X) ==> (P --> $X)) :post (:t/induction)
+                              ((P --> $X) <=> (S --> $X)) :post (:t/comparison)
+                              (&& (S --> #Y) (P --> #Y)) :post (:t/intersection))
+                                  :pre ((:!= S P))]
+
+  #R[(S --> M) (P --> M) |- (((&/ (P --> $X) I) =/> (S --> $X)) :post (:t/induction :linkage-temporal)
+                              ((S --> $X) =\> (&/ (P --> $X) I)) :post (:t/abduction :linkage-temporal)
+                              ((&/ (P --> $X) I) </> (S --> $X)) :post (:t/comparison :linkage-temporal)
+                              (&/ (P --> #Y) I (S --> #Y)) :post (:t/intersection :linkage-temporal))
+            :pre ((:!= S P) (:measure-time I))]
+
+  #R[(S --> M) (P --> M) |- (((P --> $X) =|> (S --> $X)) :post (:t/abduction :linkage-temporal)
+                              ((S --> $X) =|> (P --> $X)) :post (:t/induction :linkage-temporal)
+                              ((P --> $X) <|> (S --> $X)) :post (:t/comparison :linkage-temporal)
+                              (&| (P --> #Y) (S --> #Y)) :post (:t/intersection :linkage-temporal))
+            :pre ((:!= S P) (:concurrent Task Belief))]
+
+  #R[(M --> S) (M --> P) |- ((($X --> S) ==> ($X --> P)) :post (:t/induction)
+                              (($X --> P) ==> ($X --> S)) :post (:t/abduction)
+                              (($X --> S) <=> ($X --> P)) :post (:t/comparison)
+                              (&& (#Y --> S) (#Y --> P)) :post (:t/intersection))
+     :pre ((:!= S P)) ]
+
+  #R[(M --> S) (M --> P) |- (((&/ ($X --> P) I) =/> ($X --> S))  :post (:t/induction :linkage-temporal)
+                              (($X --> S) =\> (&/ ($X --> P) I)) :post (:t/abduction :linkage-temporal)
+                              ((&/ ($X --> P) I) </> ($X --> S)) :post (:t/comparison :linkage-temporal)
+                              (&/ (#Y --> P) I (#Y --> S)) :post (:t/intersection :linkage-temporal))
+     :pre ((:!= S P) (:measure-time I))]
+
+  #R[(M --> S) (M --> P) |- ((($X --> S) =|> ($X --> P)) :post (:t/induction :linkage-temporal)
+                              (($X --> P) =|> ($X --> S)) :post (:t/abduction :linkage-temporal)
+                              (($X --> S) <|> ($X --> P)) :post (:t/comparison :linkage-temporal)
+                              (&| (#Y --> S) (#Y --> P)) :post (:t/intersection :linkage-temporal))
+     :pre ((:!= S P) (:concurrent (M --> P) (M --> S)))]
+
+  ; 2nd variable introduction
+  #R[(A ==> (M --> P)) (M --> S) |- (((&& A ($X --> S)) ==> ($X --> P)) :post (:t/induction)
+                                      (&& (A ==> (#Y --> P)) (#Y --> S)) :post (:t/intersection))
+     :pre ((:!= A (M --> S)))]
+
+  #R[(&& (M --> P) :list/A) (M --> S) |- ((($Y --> S) ==> (&& ($Y --> P) :list/A)) :post (:t/induction)
+                                           (&& (#Y --> S) (#Y --> P) :list/A) :post (:t/intersection))
+     :pre ((:!= S P))]
+
+  #R[(A ==> (P --> M)) (S --> M) |- (((&& A (P --> $X)) ==> (S --> $X)) :post (:t/abduction)
+                                       (&& (A ==> (P --> #Y)) (S --> #Y)) :post (:t/intersection)) ]
+
+  #R[(&& (P --> M) :list/A) (S --> M) |- (((S --> $Y) ==> (&& (P --> $Y) :list/A))  :post (:t/abduction)
+                                            (&&  (S --> #Y) (P --> #Y) :list/A) :post (:t/intersection))
+                                                 :pre ((:!= S P))]
+
+  #R[(A --> L) ((A --> S) ==> R) |- ((&& (#X --> L) (#X --> S)) ==> R) :post (:t/induction)]
+  #R[(A --> L) ((&& (A --> S) :list/A) ==> R) |- ((&& (#X --> L) (#X --> S) :list/A) ==> R) :pre ((:substitute A #X)) :post (:t/induction)]
+
+  ; dependent variable elimination
+  ; Decomposition with elimination of a variable
+  #R[B (&& A :list/A) |- (&& :list/A) :pre (:judgement? (:substitute-if-unifies "#" A B)) :post (:t/anonymous-analogy :d/strong :order-for-all-same :seq-interval-from-premises)]
+
+  ; conditional abduction by dependent variable
+  #R[((A --> R) ==> Z) ((&& (#Y --> B) (#Y --> R) :list/A) ==> Z) |- (A --> B) :post (:t/abduction)]
+  #R[((A --> R) ==> Z) ((&& (#Y --> B) (#Y --> R)) ==> Z) |- (A --> B) :post (:t/abduction)]
+
+  ; conditional deduction "An inverse inference has been implemented as a form of deduction" https://code.google.com/p/open-nars/issues/detail?id=40&can=1
+  #R[(U --> L) ((&& (#X --> L) (#X --> R)) ==> Z) |- ((U --> R) ==> Z) :post (:t/deduction)]
+  #R[(U --> L) ((&& (#X --> L) (#X --> R) :list/A) ==> Z) |- ((&& (U --> R) :list/A) ==> Z) :pre ((:substitute #X U)) :post (:t/deduction)]
+
+
+  ; independent variable elimination
+  #R[B (A ==> C) |- C :post (:t/deduction :order-for-all-same) :pre ((:substitute-if-unifies "$" A B) (:shift-occurrence-forward ==>))]
+  #R[B (C ==> A) |- C :post (:t/abduction :order-for-all-same) :pre ((:substitute-if-unifies "$" A B) (:shift-occurrence-backward C ==>))]
+
+  #R[B (A <=> C) |- C :post (:t/deduction :order-for-all-same) :pre ((:substitute-if-unifies "$" A B) (:shift-occurrence-backward <=>))]
+  #R[B (C <=> A) |- C :post (:t/deduction :order-for-all-same) :pre ((:substitute-if-unifies "$" A B) (:shift-occurrence-forward <=>))]
+
+  ; second level variable handling rules
+  ; second level variable elimination (termlink level2 growth needed in order for these rules to work)
+  #R[(A --> K) (&& (#X --> L) (($Y --> K) ==> (&& :list/A))) |- (&& (#X --> L) :list/A) :pre ((:substitute $Y A)) :post (:t/deduction)]
+  #R[(A --> K) (($X --> L) ==> (&& (#Y --> K) :list/A)) |- (($X --> L) ==> (&& :list/A)) :pre ((:substitute #Y A)) :post (:t/anonymous-analogy)]
+
+  ; precondition combiner inference rule (variable_unification6):
+  #R[((&& C :list/A) ==> Z) ((&& C :list/B) ==> Z) |- (((&& :list/A) ==> (&& :list/B)) :post (:t/induction)
+                                                        ((&& :list/B) ==> (&& :list/A)) :post (:t/induction))]
+  #R[(Z ==> (&& C :list/A)) (Z ==> (&& C :list/B)) |- (((&& :list/A) ==> (&& :list/B)) :post (:t/abduction)
+                                                      ((&& :list/B) ==> (&& :list/A)) :post (:t/abduction))]
+
+  ; NAL7 specific inference
+  ; Reasoning about temporal statements. those are using the ==> relation because relation in time is a relation of the truth between statements.
+  #R[X ((&/ K (:interval I)) ==> B) |- B  :post (:t/deduction :d/induction :order-for-all-same) :pre ((:substitute-if-unifies "$" K X) (:shift-occurrence-forward I ==>))]
+  #_#R[X (XI ==> B) |- B  :post (:t/deduction :d/induction :order-for-all-same) :pre ((:substitute-if-unifies "$" XI (&/ X :interval)) (:shift-occurrence-forward XI ==>))]
+  #_#R[X (BI ==> Y) |- BI :post (:t/abduction :d/deduction :order-for-all-same) :pre ((:substitute-if-unifies "$" Y X) (:shift-occurrence-backward BI ==>))]
+
+  ; Temporal induction:
+  ; When P and then S happened according to an observation by induction (weak) it may be that alyways after P usually S happens.
+  #R[P S |- (((&/ S I) =/> P) :post (:t/induction :linkage-temporal)
+              (P =\> (&/ S I)) :post (:t/abduction :linkage-temporal)
+              ((&/ S I) </> P) :post (:t/comparison :linkage-temporal)
+              (&/ S I P) :post (:t/intersection :linkage-temporal))
+     :pre ((:measure-time I))]
+  #R[P S |- ((S =|> P) :post (:t/induction :linkage-temporal)
+              ;(P =|> S) :post (:t/induction :linkage-temporal)
+              (S <|> P) :post (:t/comparison :linkage-temporal)
+              (&| S P) :post (:t/intersection :linkage-temporal))
+     :pre [(:concurrent Task Belief) (:not-implication-or-equivalence P) (:not-implication-or-equivalence S)]]
+
+  ; here now are the backward inference rules which should really only work on backward inference:
+  #R[(A --> S) (B --> S) |- ((A --> B) :post (:p/question)
+                              (B --> A) :post (:p/question)
+                              (A <-> B) :post (:p/question))
+     :pre (:question?)]
+
+  ; and the backward inference driven forward inference:
+  ; NAL2:
+  #R[([A] <-> [B]) (A <-> B) |- ([A] <-> [B]) :pre (:question?) :post (:t/belief-identity :p/judgement)]
+  #R[({A} <-> {B}) (A <-> B) |- ({A} <-> {B}) :pre (:question?) :post (:t/belief-identity :p/judgement)]
+
+  #R[([A] --> [B]) (A <-> B) |- ([A] --> [B]) :pre (:question?) :post (:t/belief-identity :p/judgement)]
+  #R[({A} --> {B}) (A <-> B) |- ({A} --> {B}) :pre (:question?) :post (:t/belief-identity :p/judgement)]
+
+  ; NAL3:
+  ; composition on both sides of a statement:
+  #R[((& B :list/A) --> (& A :list/A)) (B --> A) |- ((& B :list/A) --> (& A :list/A)) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+  #R[((| B :list/A) --> (| A :list/A)) (B --> A) |- ((| B :list/A) --> (| A :list/A)) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+  #R[((- S A) --> (- S B)) (B --> A) |- ((- S A) --> (- S B)) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+  #R[((~ S A) --> (~ S B)) (B --> A) |- ((~ S A) --> (~ S B)) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+
+  ; composition on one side of a statement:
+  #R[(W --> (| B :list/A)) (W --> B) |- (W --> (| B :list/A)) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+  #R[((& B :list/A) --> W) (B --> W) |- ((& B :list/A) --> W) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+  #R[(W --> (- S B)) (W --> B) |- (W --> (- S B)) :pre (:question?) :post (:t/belief-structural-difference :p/judgement)]
+  #R[((~ S B) --> W) (B --> W) |- ((~ S B) --> W) :pre (:question?) :post (:t/belief-structural-difference :p/judgement)]
+
+  ; NAL4:
+  ; composition on both sides of a statement:
+  #R[((* B P) --> Z) (B --> A) |- ((* B P) --> (* A P)) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+  #R[((* P B) --> Z) (B --> A) |- ((* P B) --> (* P A)) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+  #R[((* B P) <-> Z) (B <-> A) |- ((* B P) <-> (* A P)) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+  #R[((* P B) <-> Z) (B <-> A) |- ((* P B) <-> (* P A)) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+  #R[((\ N A _) --> Z) (N --> R) |- ((\ N A _) --> (\ R A _)) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+  #R[((/ N _ B) --> Z) (S --> B) |- ((/ N _ B) --> (/ N _ S)) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+
+  ; NAL5:
+  #R[--A    A |- --A  :pre (:question?) :post (:t/belief-negation :p/judgement)]
+  #R[A  --A |-   A  :pre (:question?) :post (:t/belief-negation :p/judgement)]
+
+  ; compound composition one premise
+  #R[(|| B :list/A) B |- (|| B :list/A) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+)

src/nal/truth_value.clj

@@ -1,108 +0,0 @@
-(ns nal.truth-value
-  (:refer-clojure :exclude [== < >])
-  (:require [clojure.core.logic :refer [project fresh == defne]]
-            [clojure.core.logic.arithmetic :refer [< >]]
-            [nal.utils :refer :all]))
-
-(declare f-exp f-neg f-cnv f-cnt f-ded f-ana f-res f-abd f-exe f-com f-int
-         f-uni f-dif f-pnn f-npp f-pnp f-nnn)
-
-(defne f-rev [A1 A2 A3]
-  ([[F1 C1] [F2 C2] [F C]]
-    (< C1 1) (< C2 1)
-    (project [C1 C2]
-      (fresh [M1 M2]
-        (== M1 (/ C1 (- 1 C1)))
-        (== M2 (/ C2 (- 1 C2)))
-        (project [M1 M2 F1 F2]
-          (== F (/ (+ (* M1 F1) (* M2 F2)) (+ M1 M2)))
-          (== C (/ (+ M1 M2) (+ M1 M2 1))))))))
-
-(defne f-exp [A1 A2]
-  ([[F C] E] (project [F C] (== E (+ (* C (- F 0.5)) 0.5)))))
-
-(defne f-neg [A1 A2] ([[F1 C1] [F C1]] (u-not F1 F)))
-
-(defne f-cnv [A1 A2]
-  ([[F1 C1] [1 C]] (fresh [W] (u-and [F1 C1] W) (u-w2c W C))))
-
-(defne f-cnt [A1 A2]
-  ([[F1 C1] [0 C]] (fresh [F0 W] (u-not F1 F0) (u-and [F0 C1] W) (u-w2c W C))))
-
-(defne f-ded [A1 A2 A3]
-  ([[F1 C1] [F2 C2] [F C]] (u-and [F1 F2] F) (u-and [C1 C2 F] C)))
-
-(defne f-ana [A1 A2 A3]
-  ([[F1 C1] [F2 C2] [F C]] (u-and [F1 F2] F) (u-and [C1 C2 F2] C)))
-
-(defne f-res [A1 A2 A3]
-  ([[F1 C1] [F2 C2] [F C]]
-    (fresh [F0] (u-and [F1 F2] F) (u-or [F1 F2] F0) (u-and [C1 C2 F0] C))))
-
-(defne f-abd [A1 A2 A3]
-  ([[F1 C1] [F2 C2] [F2 C]]
-    (fresh [W] (u-and [F1 C1 C2] W) (u-w2c W C))))
-
-(defn f-ind [T1 T2 T] (f-abd T2 T1 T))
-
-(defne f-exe [A1 A2 A3]
-  ([[F1 C1] [F2 C2] [1 C]]
-    (fresh [W] (u-and [F1 C1 F2 C2] W) (u-w2c W C))))
-
-(defne f-com [A1 A2 A3]
-  ([[0 C1] [0 C2] [0 0]])
-  ([[F1 C1] [F2 C2] [F C]]
-    (fresh [F0 W]
-      (u-or [F1 F2] F0)
-      (project [F0] (> F0 0))
-      (project [F1 F2 F0] (== F (/ (* F1 F2) F0)))
-      (u-and [F0 C1 C2] W)
-      (u-w2c W C))))
-
-(defne f-int [A1 A2 A3]
-  ([[F1 C1] [F2 C2] [F C]]
-    (u-and [F1 F2] F)
-    (u-and [C1 C2] C)))
-
-(defne f-uni [A1 A2 A3]
-  ([[F1 C1] [F2 C2] [F C]]
-    (u-or [F1 F2] F)
-    (u-and [C1 C2] C)))
-
-(defne f-dif [A1 A2 A3]
-  ([[F1 C1] [F2 C2] [F C]]
-    (fresh [F0]
-      (u-not F2 F0)
-      (u-and [F1 F0] F)
-      (u-and [C1 C2] C))))
-
-(defne f-pnn [A1 A2 A3]
-  ([[F1 C1] [F2 C2] [F C]]
-    (fresh [F2n Fn]
-      (u-not F2 F2n)
-      (u-and [F1 F2n] Fn)
-      (u-not Fn F)
-      (u-and [Fn C1 C2] C))))
-
-(defne f-npp [A1 A2 A3]
-  ([[F1 C1] [F2 C2] [F C]]
-    (fresh [F1n]
-      (u-not F1 F1n)
-      (u-and [F1n F2] F)
-      (u-and [F C1 C2] C))))
-
-(defne f-pnp [A1 A2 A3]
-  ([[F1 C1] [F2 C2] [F C]]
-    (fresh [F2n]
-      (u-not F2 F2n)
-      (u-and [F1 F2n] F)
-      (u-and [F C1 C2] C))))
-
-(defne f-nnn [A1 A2 A3]
-  ([[F1 C1] [F2 C2] [F C]]
-    (fresh [F1n F2n Fn]
-      (u-not F1 F1n)
-      (u-not F2 F2n)
-      (u-and [F1n F2n] Fn)
-      (u-not Fn F)
-      (u-and [Fn C1 C2] C))))

src/nal/utils.clj

@@ -1,90 +0,0 @@
-(ns nal.utils
-  (:refer-clojure :exclude [!= == reduce replace >= <= > < =])
-  (:require [clojure.core.logic
-             :refer [project fresh == defne lvaro conda nonlvaro run* membero
-                     conso defna onceo u# s# appendo != and* all]
-             :as l]
-            [clojure.core.logic.arithmetic :refer [=]]))
-
-(declare u-and u-or subtracto intersectiono uniono subseto deleteo)
-
-(defn u-not [n0 n]
-  (project [n0] (== n (- 1 n0))))
-
-(defne u-and [A1 A2]
-  ([[N] N])
-  ([[N0 . Nt] N]
-    (fresh [N1]
-      (u-and Nt N1)
-      (project [N0 N1] (== N (* N0 N1))))))
-
-(defne u-or [A1 A2]
-  ([[N] N])
-  ([[N0 . Nt] N]
-    (fresh [N1]
-      (u-or Nt N1)
-      (project [N0 N1] (== N (- (+ N0 N1) (* N0 N1)))))))
-
-(defn u-w2c [w c]
-  (project [w c] (== c (/ w (inc w)))))
-
-;ported from prlog
-;http://eclipseclp.org/doc/bips/lib/lists/subtract-3.html
-(defna subtracto [L1 L2 L3]
-  ([[] _ []])
-  ([[Head . Tail] L2 L3]
-    (onceo (membero Head L2))
-    (subtracto Tail L2 L3))
-  ([[Head . Tail1] L2 [Head . Tail3]]
-    (subtracto Tail1 L2 Tail3)))
-
-;ported from prolog
-;http://eclipseclp.org/doc/bips/lib/lists/intersection-3.html
-(defna intersectiono [S1 S2 S3]
-  ([[] _ []])
-  ([[Head . L1tail] L2 L3]
-    (onceo (membero Head L2))
-    (fresh [L3tail]
-      (conso Head L3tail L3)
-      (intersectiono L1tail L2 L3tail)))
-  ([[_ . L1tail] L2 L3]
-    (intersectiono L1tail L2 L3)))
-
-;ported from prolog
-;http://eclipseclp.org/doc/bips/lib/lists/union-3.html
-(defna uniono [L1 L2 L3]
-  ([[] L L])
-  ([[Head . L1tail] L2 L3]
-    (onceo (membero Head L2))
-    (uniono L1tail L2 L3))
-  ([[Head . L1tail] L2 [Head . L3tail]]
-    (uniono L1tail L2 L3tail)))
-
-(defn trueo [a] (== true a))
-
-;http://eclipseclp.org/doc/bips/kernel/typetest/atom-1.html
-(defn atomo [a]
-  (nonlvaro a) (project [a] (trueo (symbol? a))))
-
-(defn noto [a] (conda [a u#] [s#]))
-
-(defmacro findallo [T G L]
-  `(== ~L (run* [q#] (== q# ~T) ~G)))
-
-(defna subseto [A1 A2]
-  ([[] A2])
-  ([[X . L] [X . S]] (subseto L S))
-  ([L [_ . S]] (subseto L S)))
-
-(defn nonlvarso [lvars]
-  (and* (map (fn [l] (nonlvaro l)) lvars)))
-
-(defn groundo [T]
-  (all (nonlvaro T)
-       (project [T]
-         (conda [(trueo (coll? T)) (nonlvarso T)]
-                [s#]))))
-
-(defn noto= [x y]
-  "Like \\= in prolog."
-  (noto (== x y)))

src/narjure/actor/active_concept_collator.clj

@@ -1,28 +0,0 @@
-(ns narjure.actor.active-concept-collator
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer [defsfn]]
-     [actors :refer [register! set-state! self]]]
-    [narjure.actor.utils :refer [actor-loop defhandler]]
-    [taoensso.timbre :refer [debug]])
-  (:refer-clojure :exclude [promise await]))
-
-(declare process active-concept-collator)
-
-(def aname :active-concept-collator)
-
-(defsfn active-concept-collator
-  "State is collection of active concepts."
-  []
-  (register! aname @self)
-  (set-state! [])
-  (actor-loop aname process))
-
-(defhandler process)
-
-(defmethod process :inference-tick-msg [_ _]
-  ;(debug aname "process-inference-tick")
-  [])
-
-(defmethod process :active-concept-msg [_ _]
-  (debug aname "process-active-concept"))

src/narjure/actor/anticipated_event.clj

@@ -1,36 +0,0 @@
-(ns narjure.actor.anticipated-event
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer [defsfn]]
-     [actors :refer [register! set-state! self !]]]
-    [narjure.actor.utils :refer [actor-loop defhandler]]
-    [taoensso.timbre :refer [debug]])
-  (:refer-clojure :exclude [promise await]))
-
-(declare anticipated-event process)
-
-(def aname :anticipated-event)
-
-(defsfn anticipated-event
-  "State is system-time and collection of anticipated events."
-  []
-  (register! aname @self)
-  (set-state! {:time 0 :anticipated-events {}})
-  (actor-loop aname process))
-
-(defhandler process)
-
-(defmethod process :system-time-msg
-  [[_ time] state]
-  (debug aname "process-system-time")
-  {:time time :anticipated-events (state :percepts)})
-
-(defmethod process :anticipated-event-msg
-  [_ _]
-  #_(debug aname "process-anticipated-event"))
-
-(defmethod process :input-task-msg
-  [[_ input-task] _]
-  #_(debug aname "process-input-task")
-  (! :task-dispatcher [:task-msg input-task]))
-

src/narjure/actor/concept.clj

@@ -1,34 +0,0 @@
-(ns narjure.actor.concept
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer [defsfn]]
-     [actors :refer [register! set-state!]]]
-    [narjure.actor.utils :refer [actor-loop defhandler]]
-    [taoensso.timbre :as t])
-  (:refer-clojure :exclude [promise await]))
-
-(declare concept process)
-
-(defsfn concept
-  "State is a map
-  {:name :budget :activation-level :belief-tab :goal-tab :task-bag :term-bag}
-  (this list may not be complete)."
-  []
-  (set-state! {})
-  (actor-loop :concept process))
-
-(defhandler process)
-
-(defn debug [msg] (t/debug :concept msg))
-
-(defmethod process :task [_ _]
-  #_(debug "process-task"))
-
-(defmethod process :belief-req [_ _]
-  (debug "process-belief-req"))
-
-(defmethod process :inference-req [_ _]
-  (debug "process-inference-req"))
-
-(defmethod process :persistence-req [_ _]
-  (debug "process-persistence-req"))

src/narjure/actor/concept_creator.clj

@@ -1,38 +0,0 @@
-(ns narjure.actor.concept-creator
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer [defsfn]]
-     [actors :refer [register! set-state! self ! spawn]]]
-    [narjure.actor.concept :refer [concept]]
-    [narjure.actor.utils :refer [actor-loop]]
-    [taoensso.timbre :refer [debug]])
-  (:refer-clojure :exclude [promise await]))
-
-(declare concept-creator process-task)
-
-(def aname :concept-creator)
-
-(defsfn concept-creator
-  []
-  (register! aname @self)
-  (actor-loop aname process-task))
-
-(defn create-concept
-  ;TODO: update state for concept-actor to state initialiser
-  ;TODO: Create required sub-term concepts and propogate budget
-  [task c-map]
-  (let [{term :term} task]
-    (swap! c-map assoc term (spawn concept))
-    #_(debug aname (str "Created concept: " term))))
-
-(defn process-task
-  "When concept-map does not contain :term, create concept actor for term
-   then post task to task-dispatcher either way."
-  [[_ from task c-map] _]
-  (let [term (task :term)]
-    ; when concept not exist then create - goes here
-    (when (not (contains? @c-map term))
-      (create-concept task c-map)))
-
-  (! from [:task-msg task])
-  #_(debug aname "concept-creator - process-task"))

src/narjure/actor/cross_modal_integrator.clj

@@ -1,29 +0,0 @@
-(ns narjure.actor.cross-modal-integrator
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer [defsfn]]
-     [actors :refer [register! set-state! self]]]
-    [narjure.actor.utils :refer [actor-loop defhandler]]
-    [taoensso.timbre :refer [debug]])
-  (:refer-clojure :exclude [promise await]))
-
-(declare cross-modal-integrator process)
-
-(def aname :cross-modal-integrator)
-
-(defsfn cross-modal-integrator
-  "State is system-time and collection of precepts from current duration window."
-  []
-  (register! :cross-modal-integrator @self)
-  (set-state! {:time 0 :percepts []})
-  (actor-loop aname process))
-
-(defhandler process)
-
-(defmethod process :system-time [[_ time] state]
-  (debug aname "process-system-time")
-  {:time time :percepts (state :percepts)})
-
-(defmethod process :percept-sentence [_ _]
-  (debug aname "process-percept-sentence"))
-

src/narjure/actor/derived_task_creator.clj

@@ -1,26 +0,0 @@
-(ns narjure.actor.derived-task-creator
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer [defsfn]]
-     [actors :refer [register! set-state! self]]]
-    [narjure.actor.utils :refer [actor-loop defhandler]]
-    [taoensso.timbre :refer [debug]])
-  (:refer-clojure :exclude [promise await]))
-
-(declare derived-task-creator process)
-
-(def aname :derived-task-creator)
-
-(defsfn derived-task-creator
-  "State is system-time."
-  []
-  (register! aname @self)
-  (set-state! {:time 0})
-  (actor-loop aname process))
-
-(defn process-system-time [[_ time] _]
-  (debug aname "process-system-time")
-  {:time time})
-
-(defn process-inference-result [_ _]
-  (debug aname "process-inference-result"))

src/narjure/actor/forgettable_concept_collator.clj

@@ -1,27 +0,0 @@
-(ns narjure.actor.forgettable-concept-collator
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer [defsfn]]
-     [actors :refer [register! set-state! self]]]
-    [narjure.actor.utils :refer [actor-loop defhandler]]
-    [taoensso.timbre :refer [debug]])
-  (:refer-clojure :exclude [promise await]))
-
-(declare forgettable-concept-collator process)
-
-(def aname :forgettable-concept-collator)
-
-(defsfn forgettable-concept-collator
-  "State is collection of forgettable concepts."
-  []
-  (register! :forgettable-concept-collator @self)
-  (set-state! [])
-  (actor-loop aname process))
-
-(defhandler process)
-
-(defmethod process :forgetting-tick-msg [_ _]
-  #_(debug aname "process-forgetting-tick"))
-
-(defmethod process :forgettable-concept-msg [_ _]
-  (debug aname "process-forgettable-concept"))

src/narjure/actor/general_inferencer.clj

@@ -1,24 +0,0 @@
-(ns narjure.actor.general-inferencer
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer [defsfn]]
-     [actors :refer [register! set-state! self]]]
-    [narjure.actor.utils :refer [actor-loop]]
-    [taoensso.timbre :refer [debug]])
-  (:refer-clojure :exclude [promise await]))
-
-(declare general-inferencer do-inference)
-
-(def aname :general-inferencer)
-
-(defsfn general-inferencer
-  "state is inference rule trie or equivalent"
-  []
-  (register! aname @self)
-  (set-state! {:trie 0})
-  (actor-loop aname do-inference))
-
-(defn do-inference [_ _]
-  (debug aname "process-do-inference"))
-
-

src/narjure/actor/operator_executor.clj

@@ -1,31 +0,0 @@
-(ns narjure.actor.operator-executor
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer [defsfn]]
-     [actors :refer [register! set-state! self]]]
-    [narjure.actor.utils :refer [actor-loop defhandler]]
-    [taoensso.timbre :refer [debug]])
-  (:refer-clojure :exclude [promise await]))
-
-(declare operator-executor process)
-
-(def aname :operator-executor)
-
-(defsfn operator-executor
-  "state is system-time"
-  []
-  (register! aname @self)
-  (set-state! {:time 0})
-  (actor-loop aname process))
-
-(defhandler process)
-
-(defmethod process :system-time-msg [[_ time] _]
-  (debug aname "process-system-time")
-  {:time time})
-
-(defmethod process :operator-execution-req-msg [_ _]
-  (debug aname "process-operator-execution-req"))
-
-
-

src/narjure/actor/persistence_manager.clj

@@ -1,22 +0,0 @@
-(ns narjure.actor.persistence-manager
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer [defsfn]]
-     [actors :refer [register! set-state! self]]]
-    [narjure.actor.utils :refer [actor-loop]]
-    [taoensso.timbre :refer [debug]])
-  (:refer-clojure :exclude [promise await]))
-
-(declare concept-state persistence-manager)
-
-(def aname :persistence-manager)
-
-(defsfn persistence-manager
-  "state is file system handles"
-  [in-state]
-  (register! aname @self)
-  (set-state! in-state)
-  (actor-loop aname concept-state))
-
-(defn concept-state [_ _]
-  (debug aname "process-concept-state"))

src/narjure/actor/sentence_parser.clj

@@ -1,43 +0,0 @@
-(ns narjure.actor.sentence-parser
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer [defsfn]]
-     [actors :refer [register! set-state! self !]]]
-    [narjure.narsese :refer [parse]]
-    [narjure.actor.utils :refer [actor-loop defhandler]]
-    [taoensso.timbre :refer [debug info]])
-  (:refer-clojure :exclude [promise await]))
-
-(declare sentence-parser process)
-
-(def aname :sentence-parser)
-
-(def serial-no (atom 0))
-
-(defsfn sentence-parser
-  []
-  (register! aname @self)
-  (set-state! {:time 0})
-  (actor-loop aname process))
-
-(defhandler process)
-
-(defmethod process :system-time-msg [[_ time] _]
-  (debug aname "process-system-time")
-  {:time time})
-
-(defn parse-task
-  "Parses a narsese string."
-  [string system-time]
-  (assoc (parse string)
-    :stamp
-    {:id              (swap! serial-no inc)
-     :creation-time   system-time
-     :occurrence-time system-time
-     :trail           [serial-no]}))
-
-(defmethod process :narsese-string-msg
-  [[_ string] {time :time}]
-  (let [task (parse-task string time)]
-    (! :anticipated-event [:input-task-msg task])
-    (info aname (str "process-narsese-string" task))))

src/narjure/actor/system_time.clj

@@ -1,23 +0,0 @@
-(ns narjure.actor.system-time
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer [defsfn]]
-     [actors :refer [register! set-state! self]]]
-    [narjure.actor.utils :refer [actor-loop]]
-    [taoensso.timbre :refer [debug]])
-  (:refer-clojure :exclude [promise await]))
-
-(declare system-time system-time-tick)
-
-(def aname :system-time)
-
-(defsfn system-time
-  "state is system-time"
-  []
-  (register! aname @self)
-  (set-state! 0)
-  (actor-loop aname system-time-tick))
-
-(defn system-time-tick [_ state]
-  ;(debug aname (str "process-system-time-tick " state))
-  (inc state))

src/narjure/actor/task_dispatcher.clj

@@ -1,37 +0,0 @@
-(ns narjure.actor.task-dispatcher
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer [defsfn]]
-     [actors :refer [register! set-state! self ! whereis]]]
-    [narjure.actor.utils :refer [actor-loop defhandler]]
-    [taoensso.timbre :refer [debug info]])
-  (:refer-clojure :exclude [promise await]))
-
-(declare task-dispatcher process)
-
-(def aname :task-dispatcher)
-(def c-map (atom {}))
-
-(defsfn task-dispatcher
-  "concept-map is atom {:term :actor-ref} shared between
-         task-dispatcher and concept-creator"
-  []
-  (register! aname @self)
-  (actor-loop aname process))
-
-(defhandler process)
-
-(defmethod process :task-msg
-  [[_ input-task] _]
-  (let [concept-creator (whereis :concept-creator)
-        term (input-task :term)]
-    (if-let [concept (@c-map term)]
-      (! concept :task-msg input-task)
-      (! concept-creator [:create-concept-msg @self input-task c-map])))
-  #_(debug aname (str "process-task" input-task)))
-
-(defmethod process :forget-concept-msg [[_ forget-concept] _]
-  (debug aname "process-forget-concept"))
-
-(defmethod process :concept-count-msg [_ _]
-  (info aname (format "Concept count[%s]" (count @c-map))))

src/narjure/actor/utils.clj

@@ -1,19 +0,0 @@
-(ns narjure.actor.utils
-  (:require
-    [co.paralleluniverse.pulsar
-     [actors :refer [set-state! state receive !]]]
-    [taoensso.timbre :refer [debug]]))
-
-(defmacro defhandler [name]
-  `(do
-     (defmulti ~name (fn [[t#] c#] t#))
-     (defmethod ~name :default [a# b#] :unhandled)))
-
-(defmacro actor-loop [name f]
-  `(loop []
-     (let [msg# (receive)
-           result# (~f msg# @state)]
-       (if (= :unhandled result#)
-         (debug ~name (str "unhandled msg:" msg#))
-         (set-state! result#))
-       (recur))))

src/narjure/control/general_inference.clj

@@ -0,0 +1,128 @@
+(ns narjure.control.general-inference
+  (:require
+    [onyx.job :refer [add-task]]
+    [onyx.plugin.kafka]
+    [onyx.tasks.kafka :refer [consumer producer]]
+    [narjure.system :refer [inference]]
+    [taoensso.timbre :refer [info]]
+    [narjure.memory.api :as m]
+    [narjure.control.utils :refer [leaf-function intermediate-function
+                                   inject-memory kafka-consumer
+                                   kafka-producer]]))
+
+(def workflow
+  [[:select-active-concepts :select-task-link]
+   [:select-task-link :update-tasklink-budget]
+   [:select-task-link :select-term-link]
+
+   [:select-term-link :update-termlink-budget]
+   [:select-term-link :do-general-inference]
+   [:do-general-inference :write-tasks]
+
+   [:select-term-link :choose-answer]
+   [:choose-answer :write-answer]])
+
+(def flow-conditions
+  [{:flow/from      :select-term-link
+    :flow/to        [:do-general-inference]
+    :flow/predicate [:not ::question-with-query-var?]}
+   {:flow/from      :select-term-link
+    :flow/to        [:choose-answer]
+    :flow/predicate ::question-with-query-var?}])
+
+(defn question-with-query-var? [_ _ segment _]
+  (if (:question-with-query-var segment) true false))
+
+(defn catalog [batch-settings]
+  (mapv #(merge % batch-settings)
+        [(intermediate-function :select-task-link ::select-task-link)
+         (leaf-function :update-tasklink-budget ::update-tasklink-budget batch-settings)
+         (intermediate-function :select-term-link ::select-term-link)
+         (leaf-function :update-termlink-budget ::update-termlink-budget batch-settings)
+         (intermediate-function :do-general-inference ::do-general-inference)
+         (intermediate-function :choose-answer ::choose-answer)]))
+
+(def tasks-with-redis-access
+  (disj (set (flatten workflow))
+        :select-active-concepts
+        :write-tasks
+        :write-answer
+        :do-general-inference))
+
+(def lifecycles
+  (concat
+    (map #(hash-map :lifecycle/task %
+                    :lifecycle/calls :narjure.control.utils/memory-call)
+         tasks-with-redis-access)
+    [{:lifecycle/task  :do-general-inference
+      :lifecycle/calls ::inference-call}]))
+
+(defn inject-inference
+  [{params :onyx.core/params} _]
+  {:onyx.core/params (conj params inference)})
+
+(def inference-call
+  {:lifecycle/before-task-start inject-inference})
+
+(defn build-job
+  [zk-address concepts-topic tasks-topic ansers-topic batch-size batch-timeout]
+  (let [batch-settings {:onyx/batch-size    batch-size
+                        :onyx/batch-timeout batch-timeout}
+        base-job (merge {:workflow        workflow
+                         :catalog         (catalog batch-settings)
+                         :lifecycles      lifecycles
+                         :windows         []
+                         :triggers        []
+                         :flow-conditions flow-conditions
+                         :task-scheduler  :onyx.task-scheduler/balanced})]
+    (-> base-job
+        (add-task (kafka-consumer :select-active-concepts concepts-topic
+                                  zk-address batch-settings 1))
+        (add-task (kafka-producer :write-tasks tasks-topic zk-address
+                                  batch-settings))
+        (add-task (kafka-producer :write-answer ansers-topic zk-address
+                                  batch-settings)))))
+
+;-------------------------------------------------------------------------------
+;functions
+
+(defn select-task-link [mem {:keys [concept] :as segment}]
+  (let [task (m/select-task mem concept)]
+    (merge segment {:task    task
+                    :concept concept})))
+
+(defn update-tasklink-budget [mem segment]
+  (info :update-tasklink-budget))
+
+(defn select-term-link
+  [mem {:keys [concept task] :as segment}]
+  (let [{linked-concept :concept} (m/select-termlink mem concept)
+        occurrence (:occurrence task)
+        belief (m/select-belief mem linked-concept occurrence)]
+    (info :belief belief)
+    (assoc segment :belief belief)))
+
+(defn update-termlink-budget [mem segment]
+  (info :update-termlink-budget))
+
+(defn do-general-inference
+  [inference {:keys [task belief]}]
+  (let [belief (:task belief)
+        {:keys [frequency confidence plausibility statement
+                desirability task-type occurrence]} (:task task)
+
+        task {:statement  statement
+              :desire     [plausibility desirability]
+              :truth      [frequency confidence]
+              :task-type  task-type
+              :occurrence occurrence}
+
+        {:keys [confidence frequency]} belief
+        belief (assoc belief :truth [frequency confidence])]
+    (info :inference task belief)
+    (mapv (fn [conclusion] {:message conclusion})
+          (inference task belief))))
+
+(defn choose-answer [mem segment]
+  (info :choose-answer)
+  {:message {:some-answer true}})

src/narjure/control/local_inference/beliefs.clj

@@ -0,0 +1,129 @@
+(ns narjure.control.local-inference.beliefs
+  (:require
+    [onyx.plugin.kafka]
+    [narjure.memory.api :as m]
+    [taoensso.timbre :refer [info]]
+    [narjure.control.local-inference.utils :as u]))
+
+(def workflow
+  [[:read-beliefs :check-satisfaction]
+   [:check-satisfaction :revise-anticipations]
+   [:revise-anticipations :revise-beliefs]
+   [:revise-beliefs :check-questions]
+
+   [:check-questions :add-tasklink]
+   [:check-questions :add-revised-tasklink]
+   [:check-questions :update-questions-budgets]
+   [:check-questions :update-goal-budget]
+   [:check-questions :prepare-answers]
+   [:prepare-answers :write-answers]
+   [:check-questions :add-anticipation-tasklink]])
+
+(def flow-conditions
+  [{:flow/from      :check-questions
+    :flow/to        [:add-revised-tasklink]
+    :flow/predicate :narjure.control.local-inference.utils/has-revised-task?}
+   {:flow/from      :check-questions
+    :flow/to        [:add-anticipation-tasklink]
+    :flow/predicate ::observable?}
+   {:flow/from      :check-questions
+    :flow/to        [:add-tasklink]
+    :flow/predicate :narjure.control.local-inference.utils/constantly-true}
+   {:flow/from      :check-questions
+    :flow/to        [:update-questions-budgets :prepare-answers]
+    :flow/predicate :narjure.control.local-inference.utils/has-answers?}
+   {:flow/from      :check-questions
+    :flow/to        [:update-goal-budget]
+    :flow/predicate ::satisfied-goal?}])
+
+(def kafka-io #{:read-beliefs :write-answers})
+(def leaves
+  #{:add-tasklink :add-revised-tasklink :add-anticipation-tasklink
+    :update-questions-budgets :update-goal-budget})
+
+(def build-job
+  (u/get-job-builder (namespace ::k) workflow kafka-io leaves flow-conditions))
+;-------------------------------------------------------------------------------
+;predicates
+
+(defn observable? [_ _ {:keys [revised-task]} _]
+  ;TODO implement
+  false)
+
+(defn satisfied-goal? [_ _ {:keys [satisfied-goal]} _]
+  satisfied-goal)
+
+;-------------------------------------------------------------------------------
+;functions
+(defn check-satisfaction
+  [mem {{:keys [statement] :as task} :task :as segment}]
+  (if-let [goals (m/goals mem statement)]
+    (let [goal-tasklink (u/rank goals task)
+          satisfaction (u/satisfaction (:task goal-tasklink) task)]
+      (-> segment
+          (update-in [:task :durability] u/increase-durability satisfaction)
+          (assoc :satisfied-goal
+                 {:goal          goal-tasklink
+                  :priority-diff (u/priority-diff goal-tasklink satisfaction)})))
+    segment))
+
+;TODO implement
+(defn revise-anticipations [_ segment]
+  segment)
+
+(defn revise-beliefs
+  [mem {{:keys [statement] :as task} :task :as segment}]
+  (let [beliefs (m/beliefs mem statement)]
+    (if-let [revised-task (u/revise beliefs task)]
+      (assoc segment :revised-task (dissoc revised-task :id))
+      segment)))
+
+(defn answer-question
+  [question-tasklink answer]
+  (let [satisfaction (u/q-satisfaction answer)]
+    {:question      question-tasklink
+     :satisfaction  satisfaction
+     :priority-diff (u/priority-diff question-tasklink satisfaction)}))
+
+(defn check-questions
+  [mem {{:keys [statement] :as task} :task
+        revised-task                 :revised-task
+        :as                          segment}]
+  (if-let [questions (m/questions mem statement)]
+    (let [answer (or revised-task task)
+          results (mapv #(answer-question % answer) questions)
+          answer (reduce
+                   (fn [answer {:keys [satisfaction]}]
+                     (update answer :durability u/increase-durability satisfaction))
+                   answer
+                   results)]
+      (assoc segment
+        :answers results
+        (if revised-task :revised-task :task) answer))
+    segment))
+
+(defn prepare-answers [_ {:keys [answers]}]
+  (mapv (fn [answer] {:message answer}) answers))
+
+(defn add-tasklink
+  [mem {:keys [task]}]
+  (u/add-tasklink* mem (:statement task) task "belief"))
+
+(defn add-revised-tasklink
+  [mem {:keys [revised-task]}]
+  (let [id (m/add-task mem revised-task)
+        revised-task' (assoc revised-task :id id)]
+    (u/add-tasklink* mem (:statement revised-task) revised-task' "belief")))
+
+(defn update-questions-budgets
+  [mem {:keys [answers]}]
+  (mapv (fn [{:keys [question priority-diff]}]
+          (m/increment-value mem (question :id) :priority priority-diff))
+        answers))
+
+(defn update-goal-budget
+  [mem {{:keys [goal priority-diff]} :satisfied-goal}]
+  (m/increment-value mem (goal :id) :priority priority-diff))
+
+;TODO implement
+(defn add-anticipation-tasklink [mem segment])

src/narjure/control/local_inference/goals.clj

@@ -0,0 +1,135 @@
+(ns narjure.control.local-inference.goals
+  (:require
+    [onyx.plugin.kafka]
+    [narjure.memory.api :as m]
+    [taoensso.timbre :refer [info]]
+    [narjure.control.local-inference.utils :as u]))
+
+(def workflow
+  [[:read-goals :check-solution]
+   [:check-solution :revise-goals]
+   [:revise-goals :check-quests]
+   [:check-quests :check-operator]
+
+   [:check-operator :add-tasklink]
+   [:check-operator :add-revised-tasklink]
+   [:check-operator :update-quests-budgets]
+   [:check-operator :update-belief-budget]
+   [:check-operator :prepare-answers]
+   [:prepare-answers :write-answers]
+   [:check-operator :send-operator]])
+
+(def flow-conditions
+  [{:flow/from      :check-operator
+    :flow/to        [:add-revised-tasklink]
+    :flow/predicate ::narjure.control.local-inference.utils/has-revised-task?}
+   {:flow/from      :check-operator
+    :flow/to        [:send-operator]
+    :flow/predicate ::has-operator-to-execute?}
+   {:flow/from      :check-operator
+    :flow/to        [:add-tasklink]
+    :flow/predicate :narjure.control.local-inference.utils/constantly-true}
+   {:flow/from      :check-operator
+    :flow/to        [:update-quests-budgets :prepare-answers]
+    :flow/predicate :narjure.control.local-inference.utils/has-answers?}
+   {:flow/from      :check-operator
+    :flow/to        [:update-belief-budget]
+    :flow/predicate ::has-solution?}])
+
+(def io #{:read-goals :write-answers})
+(def leaves
+  #{:add-tasklink :add-revised-tasklink :send-operator
+    :update-quests-budgets :update-belief-budget})
+
+(def build-job
+  (u/get-job-builder (namespace ::k) workflow io leaves flow-conditions))
+;-------------------------------------------------------------------------------
+;predicates
+(defn has-operator-to-execute? [_ _ _ _]
+  ;TODO implement
+  false)
+
+(defn has-solution? [_ _ {:keys [belief-solution]} _]
+  belief-solution)
+
+;-------------------------------------------------------------------------------
+;functions
+
+(defn durability-diff
+  [{:keys [durability]} satisfaction]
+  (-> durability
+      (u/increase-durability satisfaction)
+      (- durability)))
+
+(defn check-solution
+  [mem {{:keys [statement] :as task} :task :as segment}]
+  (if-let [beliefs (m/beliefs mem statement)]
+    (let [belief-tasklink (u/rank beliefs task)
+          satisfaction (u/satisfaction task (:task belief-tasklink))]
+      (-> segment
+          (update-in [:task :priority] u/reduce-priority satisfaction)
+          (assoc :belief-solution
+                 {:belief          belief-tasklink
+                  :durability-diff (durability-diff belief-tasklink
+                                                    satisfaction)})))
+    segment))
+
+(defn revise-goals
+  [mem {{:keys [statement] :as task} :task :as segment}]
+  (let [goals (m/goals mem statement)]
+    (if-let [revised-task (u/revise goals task)]
+      (assoc segment :revised-task (dissoc revised-task :id))
+      segment)))
+
+(defn answer-question
+  [quest-tasklink answer]
+  (let [satisfaction (u/q-satisfaction answer)]
+    {:quest         quest-tasklink
+     :satisfaction  satisfaction
+     :priority-diff (u/priority-diff quest-tasklink satisfaction)}))
+
+(defn check-quests
+  [mem {{:keys [statement] :as task} :task
+        revised-task                 :revised-task
+        :as                          segment}]
+  (if-let [quests (m/quests mem statement)]
+    (let [answer (or revised-task task)
+          results (mapv #(answer-question % answer) quests)
+          answer (reduce
+                   (fn [answer {:keys [satisfaction]}]
+                     (update answer :durability u/increase-durability satisfaction))
+                   answer
+                   results)]
+      (assoc segment
+        :answers results
+        (if revised-task :revised-task :task) answer))
+    segment))
+
+;TODO implement
+(defn check-operator [_ segment]
+  segment)
+
+(defn prepare-answers [_ {:keys [answers]}]
+  (mapv (fn [answer] {:message answer}) answers))
+
+(defn add-tasklink
+  [mem {:keys [task]}]
+  (u/add-tasklink* mem (:statement task) task "goal"))
+
+(defn add-revised-tasklink
+  [mem {:keys [revised-task]}]
+  (let [id (m/add-task mem revised-task)
+        revised-task' (assoc revised-task :id id)]
+    (u/add-tasklink* mem (:statement revised-task) revised-task' "goal")))
+
+(defn update-quests-budgets
+  [mem {:keys [answers]}]
+  (mapv (fn [{:keys [quest priority-diff]}]
+          (m/increment-value mem (quest :id) :priority priority-diff))
+        answers))
+
+(defn update-belief-budget
+  [mem {{:keys [belief durability-diff]} :belief-solution}]
+  (m/increment-value mem (belief :id) :durability durability-diff))
+
+(defn send-operator [mem segment])

src/narjure/control/local_inference/questions.clj

@@ -0,0 +1,57 @@
+(ns narjure.control.local-inference.questions
+  (:require
+    [narjure.memory.api :as m]
+    [onyx.job :refer [add-task]]
+    [taoensso.timbre :refer [info]]
+    [narjure.control.local-inference.utils :as u]))
+
+(def workflow
+  [[:read-questions :check-answer]
+   [:check-answer :add-tasklink]
+   [:check-answer :update-belief-budget]
+   [:check-answer :prepeare-answer]
+   [:prepeare-answer :write-answer]])
+
+(def flow-conditions
+  [{:flow/from      :check-answer
+    :flow/to        [:update-belief-budget :prepeare-answer]
+    :flow/predicate :narjure.control.local-inference.utils/has-answer?}
+   {:flow/from      :check-answer
+    :flow/to        [:add-tasklink]
+    :flow/predicate :narjure.control.local-inference.utils/constantly-true}])
+
+(def kafka-io #{:read-questions :write-answer})
+(def leaves #{:add-tasklink :update-belief-budget})
+
+(def build-job
+  (u/get-job-builder (namespace ::k) workflow kafka-io leaves flow-conditions))
+
+;-------------------------------------------------------------------------------
+;functions
+
+(defn check-answer
+  [mem {{:keys [statement] :as task} :task
+        :as                          segment}]
+  (if-let [beliefs (m/beliefs mem statement)]
+    (let [belief-tasklink (u/rank beliefs task)
+          satisfaction (u/q-satisfaction (:task belief-tasklink))
+          task' (update task :priority u/reduce-priority satisfaction)]
+      (assoc segment
+        :task task'
+        :answer {:belief          belief-tasklink
+                 :question        task'
+                 :durability-diff (u/durability-diff belief-tasklink
+                                                     satisfaction)}))
+    segment))
+
+(defn add-tasklink
+  [mem {:keys [task]}]
+  (u/add-tasklink* mem (:statement task) task "question"))
+
+(defn prepeare-answer [_ {:keys [answer]}]
+  ;TODO check if input question
+  {:message answer})
+
+(defn update-belief-budget
+  [mem {{:keys [belief durability-diff]} :answer}]
+  (m/increment-value mem (belief :id) :durability durability-diff))

src/narjure/control/local_inference/quests.clj

@@ -0,0 +1,57 @@
+(ns narjure.control.local-inference.quests
+  (:require
+    [narjure.memory.api :as m]
+    [onyx.job :refer [add-task]]
+    [taoensso.timbre :refer [info]]
+    [narjure.control.local-inference.utils :as u]))
+
+(def workflow
+  [[:read-quests :check-answer]
+   [:check-answer :add-tasklink]
+   [:check-answer :update-goal-budget]
+   [:check-answer :prepeare-answer]
+   [:prepeare-answer :write-answer]])
+
+(def flow-conditions
+  [{:flow/from      :check-answer
+    :flow/to        [:update-goal-budget :prepeare-answer]
+    :flow/predicate :narjure.control.local-inference.utils/has-answer?}
+   {:flow/from      :check-answer
+    :flow/to        [:add-tasklink]
+    :flow/predicate :narjure.control.local-inference.utils/constantly-true}])
+
+(def kafka-io #{:read-quests :write-answer})
+(def leaves #{:add-tasklink :update-goal-budget})
+
+(def build-job
+  (u/get-job-builder (namespace ::k) workflow kafka-io leaves flow-conditions))
+
+;-------------------------------------------------------------------------------
+;functions
+
+(defn check-answer
+  [mem {{:keys [statement] :as task} :task
+        :as                          segment}]
+  (if-let [goals (m/goals mem statement)]
+    (let [goal-tasklink (u/rank goals task)
+          satisfaction (u/q-satisfaction (:task goal-tasklink))
+          task' (update task :priority u/reduce-priority satisfaction)]
+      (assoc segment
+        :task task'
+        :answer {:goal            goal-tasklink
+                 :quest           task'
+                 :durability-diff (u/durability-diff goal-tasklink
+                                                     satisfaction)}))
+    segment))
+
+(defn add-tasklink
+  [mem {:keys [task]}]
+  (u/add-tasklink* mem (:statement task) task "quest"))
+
+(defn prepeare-answer [_ {:keys [answer]}]
+  ;TODO check if input question
+  {:message answer})
+
+(defn update-goal-budget
+  [mem {{:keys [goal durability-diff]} :answer}]
+  (m/increment-value mem (goal :id) :durability durability-diff))

src/narjure/control/local_inference/utils.clj

@@ -0,0 +1,197 @@
+(ns narjure.control.local-inference.utils
+  (:require
+    [onyx.plugin.kafka]
+    [narjure.memory.api :as m]
+    [nal.deriver.truth :as t]
+    [onyx.job :refer [add-task]]
+    [narjure.control.utils :refer [leaf-function intermediate-function
+                                   kafka-consumer kafka-producer]]
+    [clojure.set :as s]))
+
+(defn has-answers? [_ _ {:keys [answers]} _] (seq answers))
+
+(defn has-answer? [_ _ {:keys [answer]} _] answer)
+
+(defn has-revised-task? [_ _ {:keys [revised-task]} _] revised-task)
+
+(def constantly-true (constantly true))
+
+(defn add-tasklink* [mem concept task type]
+  (let [link (-> (select-keys task [:priority :durability])
+                 (assoc :task (:id task)))
+        id (m/add-tasklink mem concept link (or type "task"))]
+    id))
+
+(defn get-frequency [{:keys [frequency plausibility]}]
+  [(if frequency :frequency :plausibility)
+   (or frequency plausibility)])
+
+(defn get-confidence [{:keys [confidence desirability]}]
+  [(if confidence :confidence :desirability)
+   (or confidence desirability)])
+
+(defn revision
+  [revised task2]
+  (let [[f1k f1] (get-frequency revised)
+        [_ f2] (get-frequency task2)
+        [c1k c1] (get-confidence revised)
+        [_ c2] (get-confidence task2)
+        c2' (- 1 c2)
+        c1' (- 1 c1)
+        c1-c2' (* c1 c2')
+        c2-c1' (* c2 c1')
+        x (+ c1-c2' c2-c1')
+        f (/ (+ (* f1 c1-c2') (* f2 c2-c1'))
+             x)
+        c (/ x (+ x (* c1' c2')))]
+    {f1k f
+     c1k c}))
+
+(defn overlaps? [evidences1 evidences2]
+  (seq (s/intersection (set evidences1)
+                       (set evidences2))))
+
+(defn merge-evidences
+  [ev1 ev2]
+  (vec (s/union (set ev1) (set ev2))))
+
+(defn eternalize
+  [{:keys [confidence desirability] :as task}]
+  (let [k (if confidence :confidence :desirability)
+        val (or confidence desirability)]
+    (assoc task k (t/w2c val))))
+
+(defn project-confidence
+  [source-time target-time current-time confidence]
+  (let [kc (/ (Math/abs (- source-time target-time))
+              (+ (Math/abs (- source-time current-time))
+                 (Math/abs (- target-time current-time))))]
+    (* (- 1 kc) confidence)))
+
+(defn project
+  [{source         :occurrence
+    eternal-source :eternal
+    :as            projected}
+   {target         :occurrence
+    eternal-target :eternal
+    creation       :creation-time}]
+  (case [eternal-target eternal-source]
+    [true false] (eternalize projected)
+    [false false]
+    (if (= source target)
+      projected
+      (let [[k value] (get-confidence projected)
+            new-value (project-confidence source target creation value)]
+        (assoc projected k new-value)))
+    :else projected))
+
+(defn revise [tasklinks task]
+  (let [revised (reduce (fn [{:keys [evidences] :as input}
+                             {:keys [task]}]
+                          (if (overlaps? evidences (:evidences task))
+                            input
+                            (let [
+                                  evidences (merge-evidences evidences
+                                                             (:evidences task))
+                                  projected (project task input)
+                                  revised-tv (revision input projected)]
+                              (-> input
+                                  (assoc :evidences evidences)
+                                  (merge revised-tv)))))
+                        task tasklinks)]
+    (when-not (= revised task) revised)))
+
+(defn rank [tasklinks input]
+  (reduce (fn [{ac-task :task :as ac}
+               {:keys [task] :as tasklink}]
+            (let [projected (project task input)
+                  [_ p-confidence] (get-confidence projected)
+                  [_ ac-confidence] (get-confidence ac-task)]
+              (if (and (not (nil? ac)) (> ac-confidence p-confidence))
+                ac
+                (assoc tasklink :task projected))))
+          nil
+          tasklinks))
+
+(defn satisfaction* [d t]
+  (- 1 (Math/abs (- (t/expectation d) (t/expectation t)))))
+
+(defn satisfaction
+  [{:keys [plausibility desirability]}
+   {:keys [frequency confidence]}]
+  (satisfaction* [plausibility desirability]
+                 [frequency confidence]))
+
+(defn q-satisfaction [{:keys [confidence desirability]}]
+  (- 1 (or confidence desirability)))
+
+(defn reduce-priority [priority satisfaction]
+  (t/t-and priority (- 1 satisfaction)))
+
+(defn priority-diff
+  [{:keys [priority]} satisfaction]
+  (-> priority
+      (reduce-priority satisfaction)
+      (- priority)))
+
+(defn increase-durability [durability satisfaction]
+  ;TODO define k somewhere
+  (let [k 1]
+    (t/t-or durability (* k satisfaction))))
+
+(defn durability-diff
+  [{:keys [durability]} satisfaction]
+  (-> durability
+      (increase-durability satisfaction)
+      (- durability)))
+
+(defn save-task
+  [mem {:keys [task] :as segment}]
+  (assoc-in segment [:task :id] (m/add-task mem task)))
+
+(defn get-catalog-builder
+  [functions-ns all leaves io]
+  (fn [batch-settings]
+    (let [add-ns #(keyword (str functions-ns "/" (name %)))
+          intermediates (s/difference all leaves io)
+          leaf-tasks (map #(leaf-function % (add-ns %) batch-settings) leaves)
+          inter-tasks (map #(intermediate-function % (add-ns %)) intermediates)]
+      (mapv #(merge % batch-settings) (concat leaf-tasks inter-tasks)))))
+
+(defn job-builder
+  [workflow catalog-f lifecycles flow-conditions io]
+  (fn [zk-address {:keys [input output]} batch-size batch-timeout]
+    (let [batch-settings {:onyx/batch-size    batch-size
+                          :onyx/batch-timeout batch-timeout}
+          base-job (merge {:workflow        workflow
+                           :catalog         (catalog-f batch-settings)
+                           :lifecycles      lifecycles
+                           :windows         []
+                           :triggers        []
+                           :flow-conditions flow-conditions
+                           :task-scheduler  :onyx.task-scheduler/balanced})]
+      (let [parameters (s/union (set (keys input)) (set (keys output)))]
+        (assert
+          (= parameters io)
+          (format "All consumers/producers must be specified, %s are missed."
+                  (s/difference io parameters))))
+      (reduce
+        add-task
+        base-job
+        (concat
+          (map (fn [[task topic]]
+                 (kafka-consumer task topic zk-address batch-settings 1)) input)
+          (map (fn [[task topic]]
+                 (kafka-producer task topic zk-address batch-settings)) output))))))
+
+(defn get-job-builder
+  [functions-ns workflow io leaves flow-conditions]
+  (let [all (set (flatten workflow))
+        catalog (get-catalog-builder functions-ns all leaves io)
+        tasks-with-redis-access (s/difference all io)
+        lifecycles
+        (mapv #(hash-map :lifecycle/task %
+                         :lifecycle/calls :narjure.control.utils/memory-call)
+              tasks-with-redis-access)]
+    (job-builder workflow catalog lifecycles flow-conditions io)))
+

src/narjure/control/task_preprocessing.clj

@@ -0,0 +1,79 @@
+(ns narjure.control.task-preprocessing
+  (:require [narjure.control.local-inference.utils :as u]
+            [narjure.memory.api :as m]
+            [taoensso.timbre :refer [info]]
+            [clojure.set :as s]))
+
+(def workflow
+  [[:read-task :save-task]
+
+   [:save-task :prepare-task]
+   [:save-task :add-tasklinks]
+
+   [:prepare-task :write-belief]
+   [:prepare-task :write-goal]
+   [:prepare-task :write-question]
+   [:prepare-task :write-quest]])
+
+(def flow-conditions
+  [{:flow/from      :prepare-task
+    :flow/to        [:write-belief]
+    :flow/predicate ::belief?}
+   {:flow/from      :prepare-task
+    :flow/to        [:write-goal]
+    :flow/predicate ::goal?}
+   {:flow/from      :prepare-task
+    :flow/to        [:write-question]
+    :flow/predicate ::question?}
+   {:flow/from      :prepare-task
+    :flow/to        [:write-quest]
+    :flow/predicate ::quest?}])
+
+(def kafka-io
+  #{:read-task :write-belief :write-goal :write-question :write-quest})
+(def leaves #{:add-tasklinks})
+
+(def build-job
+  (u/get-job-builder (namespace ::k) workflow kafka-io leaves flow-conditions))
+
+;-------------------------------------------------------------------------------
+;predicates
+
+(defn goal? [_ _ {{:keys [task-type]} :message} _]
+  (= :goal task-type))
+
+(defn belief? [_ _ {{:keys [task-type]} :message} _]
+  (= :belief task-type))
+
+(defn question? [_ _ {{:keys [task-type]} :message} _]
+  (= :question task-type))
+
+(defn quest? [_ _ {{:keys [task-type]} :message} _]
+  (= :quest task-type))
+
+;-------------------------------------------------------------------------------
+;functions
+
+(defn save-task [mem task]
+  (info :tsk task)
+  (let [id (m/add-task mem task)]
+    (assoc task :id id)))
+
+(defn prepare-task [_ task]
+  (info :prep task)
+  {:message task})
+
+(defn children-terms
+  ([statement] (children-terms statement 0))
+  ([statement level]
+   (if (and (> 2 level) (coll? statement))
+     (let [[f & tail] statement
+           next-level (if (= 'conj f) level (inc level))
+           children (map #(children-terms % next-level) tail)]
+       (apply s/union (set tail) children))
+     [statement])))
+
+(defn add-tasklinks [mem {:keys [statement occurrence] :as task}]
+  (doseq [term (conj (children-terms statement) occurrence)]
+    (m/add-term mem term)
+    (u/add-tasklink* mem term task "link")))

src/narjure/control/utils.clj

@@ -0,0 +1,52 @@
+(ns narjure.control.utils
+  (:require [narjure.system :refer [mem inference]]
+            [onyx.tasks.kafka :refer [consumer producer]]))
+
+(defn intermediate-function
+  [name function]
+  {:onyx/name name
+   :onyx/fn   function
+   :onyx/type :function})
+
+(defn leaf-function
+  [name function batch-settings]
+  (merge {:onyx/name       name
+          :onyx/fn         function
+          :onyx/plugin     :onyx.peer.function/function
+          :onyx/medium     :function
+          :onyx/type       :output
+          :onyx/batch-size 20}
+         batch-settings))
+
+(defn inject-memory
+  [{params :onyx.core/params} _]
+  {:onyx.core/params (conj params mem)})
+
+(defn kafka-consumer
+  [name topic zk-address batch-settings n-peers]
+  (consumer
+    name
+    (merge {:kafka/topic           topic
+            :kafka/group-id        "onyx-consumer"
+            :kafka/zookeeper       zk-address
+            :kafka/offset-reset    :smallest
+            :kafka/force-reset?    true
+            :kafka/deserializer-fn :onyx.tasks.kafka/deserialize-message-edn
+            :onyx/max-peers        n-peers
+            :onyx/min-peers        n-peers}
+           batch-settings)))
+
+(def default-producer-config
+  {:kafka/serializer-fn :onyx.tasks.kafka/serialize-message-edn
+   :kafka/request-size  307200})
+
+(defn kafka-producer
+  [name topic zk-address batch-settings]
+  (producer name
+            (merge {:kafka/topic     topic
+                    :kafka/zookeeper zk-address}
+                   default-producer-config
+                   batch-settings)))
+
+(def memory-call
+  {:lifecycle/before-task-start inject-memory})

src/narjure/core.clj

@@ -1,144 +1,8 @@
 (ns narjure.core
-  (:require
-    [co.paralleluniverse.pulsar
-     [core :refer :all]
-     [actors :refer :all]]
-    [immutant.scheduling :refer :all]
-    [narjure.actor
-     [active-concept-collator :refer [active-concept-collator]]
-     [anticipated-event :refer [anticipated-event]]
-     [concept-creator :refer [concept-creator]]
-     [cross-modal-integrator :refer [cross-modal-integrator]]
-     [derived-task-creator :refer [derived-task-creator]]
-     [forgettable-concept-collator :refer [forgettable-concept-collator]]
-     [general-inferencer :refer [general-inferencer]]
-     [operator-executor :refer [operator-executor]]
-     [persistence-manager :refer [persistence-manager]]
-     [sentence-parser :refer [sentence-parser]]
-     [system-time :refer [system-time]]
-     [task-dispatcher :refer [task-dispatcher]]]
-    [taoensso.timbre :refer [info set-level!]])
-  (:refer-clojure :exclude [promise await])
-  (:import (ch.qos.logback.classic Level)
-           (org.slf4j LoggerFactory))
-  (:gen-class))
+    (:require [instaparse.core :as insta])
+    (:gen-class))
 
-(set-level! :info)
-(doseq [logger ["co.paralleluniverse.actors.JMXActorMonitor"
-                "org.quartz.core.QuartzScheduler"
-                "co.paralleluniverse.actors.LocalActorRegistry"
-                "co.paralleluniverse.actors.ActorRegistry"
-                "org.projectodd.wunderboss.scheduling.Scheduling"]]
-  (.setLevel (LoggerFactory/getLogger logger) Level/OFF))
-
-;co.paralleluniverse.actors.JMXActorMonitor
-(def actors-names
-  #{:active-concept-collator
-    :anticipated-event
-    :concept-creator
-    :cross-modal-integrator
-    :derived-task-creator
-    :forgettable-concept-collator
-    :general-inferencer
-    :operator-executor
-    :persistence-manager
-    :sentence-parser
-    :system-time
-    :task-dispatcher})
-
-(defn create-system-actors
-  "Spawns all actors which self register!"
-  []
-  (spawn active-concept-collator)
-  (spawn anticipated-event)
-  (spawn concept-creator)
-  (spawn cross-modal-integrator)
-  (spawn derived-task-creator)
-  (spawn forgettable-concept-collator)
-  (spawn general-inferencer)
-  (spawn operator-executor)
-  (spawn persistence-manager :state)
-  (spawn sentence-parser)
-  (spawn system-time)
-  (spawn task-dispatcher))
-
-(defn check-actor [actor-name]
-  (info (if (whereis actor-name) "\t[OK]" "\t[FAILED]") (str actor-name)))
-
-(defn check-actors-registered []
-  (info "Checking all services are registered...")
-  (doseq [actor-name actors-names]
-    (check-actor actor-name))
-  (info "All services registered."))
-
-(def inference-tick-interval 2500)
-(def forgetting-tick-interval 3000)
-(def system-tick-interval 2000)
-
-(defn inference-tick []
-  (! :active-concept-collator [:inference-tick-msg]))
-
-(defn forgetting-tick []
-  (! :forgettable-concept-collator [:forgetting-tick-msg]))
-
-(defn system-tick []
-  (! :system-time [:system-time-tick-msg]))
-
-(defn prn-ok [msg] (info (format "\t[OK] %s" msg)))
-
-(defn start-timers []
-  (info "Initialising system timers...")
-  (schedule inference-tick {:in    inference-tick-interval
-                            :every inference-tick-interval})
-  (prn-ok :system-timer)
-
-  (schedule forgetting-tick {:in    forgetting-tick-interval
-                             :every forgetting-tick-interval})
-  (prn-ok :forgetting-timer)
-
-  (schedule system-tick {:every system-tick-interval})
-  (prn-ok :inference-timer)
-
-  (info "System timer initialisation complete."))
-
-(defn start-nars [& _]
-  (info "NARS initialising...")
-
-  ; spawn all actors except concepts
-  (create-system-actors)
-  ; allow delay for all actors to be initialised
-  (sleep 1 :sec)
-  (check-actors-registered)
-  (start-timers)
-
-  ; update user with status
-  (info "NARS initialised.")
-
-  ; *** Test code
-  (let [task-dispatcher (whereis :task-dispatcher)]
-    (info "Beginning test...")
-    (time
-      (loop [n 0]
-        (when (< n 1000000)
-          ; select approximately 90% from existing concepts
-          (let [n1 (if (< (rand) 0.01) n (rand-int (/ n 10)))]
-            (! task-dispatcher [:task-msg {:term  (format "a --> %d" n1)
-                                           :other "other"}])
-            (when (== (mod n 100000) 0)
-              (info (format "processed [%s] messages" n))))
-          (recur (inc n))))))
-  ; allow delay for all actors to process their queues
-  (Thread/sleep 100)
-  (info "Test complete.")
-  ; *** End test code
-
-  ; join all actors so the terminate cleanly
-  (doseq [actor-name actors-names]
-    (join (whereis actor-name)))
-
-  ; cancel schedulers
-  (stop))
-
-; call main function
-(defn run []
-  (future (start-nars)))
+(defn -main
+  "I don't do a whole lot ... yet."
+  [& args]
+  ((insta/parser (clojure.java.io/resource "narsese.bnf") :auto-whitespace :standard) "<bird --> swimmer>. %0.10;0.60%"))

src/narjure/cycle.clj

@@ -1,7 +1,6 @@
 (ns narjure.cycle
   (:require [narjure.bag :refer :all]
             [narjure.narsese :refer [parse]]
-            [clojure.core.logic :as l]
             [nal.core :as c]
             [clojure.set :refer [intersection union]]))
 
@@ -34,8 +33,9 @@
    ;here will be the map with patterns for possible questions
    :answers  {}})
 
-(defn get-concept [concepts term]
+(defn get-concept
   "Check for concept in database, creates new in case in didn't find it."
+  [concepts term]
   (if-let [concept (get-el concepts term)]
     concept
     (default-concept term)))
@@ -61,13 +61,9 @@
   [{:keys [statement truth]}]
   [statement truth])
 
-(defn raw-choice [b t]
-  (first (l/run* [q] (c/choice b t q))))
-
 (defn choice [belief task]
-  (let [b (inf-statement belief)
-        t (inf-statement task)
-        [statement truth] (raw-choice b t)]
+  (let [statement (:statement belief)
+        truth (c/choice (:truth belief) (:truth task))]
     {:statement      statement
      :key            statement
      :truth          truth
@@ -84,9 +80,8 @@
   ; because the other ranking params, truth expectation and originality are in
   ; both cases the same, so complexity is the determining factor
   ; in this case
-  (let [b (inf-statement belief)
-        t (inf-statement task)
-        [statement truth] (first (l/run* [q] (c/revision b t q)))]
+  (let [statement (:statement belief)
+        truth (c/revision (:truth belief) (:truth task))]
     {:statement      statement
      :key            statement
      :truth          truth
@@ -117,14 +112,13 @@
       (update-in c [:answers q] choice-with-nil belief))
     concept questions))
 
-(defmulti task->concept (fn [& args] (:task-type (first args))))
+(defmulti task->concept (fn [& args] (:action (first args))))
 
 (defmethod task->concept :question
   [{:keys [statement] :as task} {:keys [concepts] :as m} term]
   (let [concept (get-concept concepts term)
         answer (get-in concept [:answers statement])
-        upd-concept (-> concept
-                        (update :tasks put-el task))
+        upd-concept (update concept :tasks put-el task)
         upd-m (update m :concepts put-el upd-concept)]
     (if answer
       (update upd-m :answers conj [task answer])
@@ -173,7 +167,7 @@
 (defn forward-inference [task belief]
   (let [t (inf-statement task)
         b (inf-statement belief)
-        conclusions (l/run* [q] (c/inference t b q))
+        conclusions (c/inference t b)
         total-ev-base (total-ev-base belief task)]
     (map (fn [[statement truth]]
            {:statement      statement
@@ -233,8 +227,7 @@
   (let [by-question (group-by first answers)]
     (assoc m :answers
              (map (fn [[q ans]]
-                    [q (reduce raw-choice (map inf-statement
-                                               (map second ans)))])
+                    [q (map inf-statement (map second ans))])
                   by-question))))
 
 (defn do-cycle
@@ -266,8 +259,7 @@
   "Put task into the buffer."
   [{:keys [cycles-cnt tasks-cnt] :as m} t]
   (let [n-task (inc tasks-cnt)]
-    (assoc (->> (pack-task t cycles-cnt n-task)
-                (update m :buffer put-el))
+    (assoc (update m :buffer put-el (pack-task t cycles-cnt n-task))
       :tasks-cnt n-task)))
 
 (defn fill-memory [& expression]

src/narjure/defaults.clj

@@ -29,3 +29,7 @@
 (def budgets
   {:judgement judgement-budget
    :question question-budget})
+
+(def ^{:type double} horizon 1)
+
+(def temporal-window-duration 80)

src/narjure/memory/api.clj

@@ -0,0 +1,24 @@
+(ns narjure.memory.api)
+
+(defprotocol Memory
+  (term [mem concept])
+  (beliefs [mem concept])
+  (goals [mem concept])
+  (questions [mem concept])
+  (quests [mem concept])
+  (tasklinks [mem concept])
+  (termlinks [mem concept])
+  (budget [mem concept])
+
+  (select-task [mem concept])
+  (select-termlink [mem concept])
+  (select-belief [mem concept occurrence])
+
+  (add-term [mem concept])
+  (add-task [mem task])
+  (add-tasklink [mem concept link type])
+  (add-termlink [mem concept link])
+
+  (remove-tasklink [mem concept id])
+  (remove-termlink [mem concept id])
+  (increment-value [mem id name value]))

src/narjure/memory/redis.clj

@@ -0,0 +1,183 @@
+(ns narjure.memory.redis
+  (:require [taoensso.carmine :as c]
+            [narjure.memory.api :refer [Memory] :as m]
+            [taoensso.timbre :refer [info]])
+  (:import (java.util UUID)))
+
+;postfixes for keys
+(def tasklinks-pf "_tkl")
+(def termlinks-pf "_tml")
+(def budget-pf "_bg")
+(def task-pf "_tsk")
+
+(def parse-float #(Float/parseFloat %))
+(def parse-int #(Integer/parseInt %))
+(defn parse-boolean
+  [val]
+  (info :opopop val (type val))
+  (Boolean/parseBoolean val))
+
+(def task-schema
+  {:task-type     :keyword
+   :evidences     :vector
+   :eternal       :boolean
+   :occurrence    :int
+   :frequency     :float
+   :confidence    :float
+   :plausibility  :float
+   :desirability  :float
+   :statement     :any
+   :creation-time :int})
+
+(def termlink-schema
+  {:priority   :float
+   :durability :float
+   :quality    :float
+   :concept    :string})
+
+(def tasklink-schema
+  {:priority   :float
+   :durability :float
+   :quality    :float
+   :task       :string})
+
+(def deserialization-fn
+  {:float   parse-float
+   :int     parse-int
+   :keyword keyword})
+
+(defn apply-schema [val]
+  (->> val
+       (map (fn [[k v]]
+              [k (get deserialization-fn v identity)]))
+       (into {})))
+
+(def deserial-map
+  (reduce (fn [ac [key val]] (assoc ac key (apply-schema val)))
+          {}
+          {task-pf      task-schema
+           tasklinks-pf tasklink-schema
+           termlinks-pf termlink-schema}))
+
+(defn- check-hash [val]
+  (if (or (integer? val) (string? val)) val (hash val)))
+
+(defn get-key [concept postfix]
+  (str (check-hash concept) postfix))
+
+(defn- get-maps-ids-from-set [conn concept postfix]
+  (->> (get-key concept postfix)
+       c/smembers
+       (c/wcar conn)))
+
+(defn- get-maps-ids-from-hash [conn concept postfix]
+  (->> (get-key concept postfix)
+       c/hgetall
+       (c/wcar conn)
+       (apply hash-map)))
+
+(defn xf [trans-map]
+  (comp (partition-all 2)
+        (map (fn [[k v]]
+               (let [k (keyword k)
+                     tf (get trans-map k identity)]
+                 [k (tf v)])))))
+
+(defn- get-map-by-key [conn trans-map k]
+  (into {} (xf trans-map) (c/wcar conn (c/hgetall k))))
+
+(defn- get-maps-from-set [conn concept postfix]
+  (map (partial get-map-by-key conn (deserial-map postfix))
+       (get-maps-ids-from-set conn concept postfix)))
+
+(defn- get-tasklinks [conn concept pred]
+  (let [links (->> (get-maps-ids-from-hash conn concept tasklinks-pf)
+                   (filter (fn [[_ v]] (pred v)))
+                   keys
+                   (mapv (partial get-map-by-key conn (deserial-map tasklinks-pf))))]
+    (seq (mapv (fn [{:keys [task] :as link}]
+                 (let [task (get-map-by-key conn (deserial-map task-pf) task)]
+                   (assoc link :task task)))
+               links))))
+
+(defn- get-map [conn concept postfix]
+  (get-map-by-key conn (deserial-map postfix) (get-key concept postfix)))
+
+(defn- add-map [conn concept postfix data]
+  (let [id (str (UUID/randomUUID) postfix)]
+    (c/wcar conn (c/sadd (get-key concept postfix) id))
+    (c/wcar conn (c/hmset* id (assoc data :id id)))))
+
+(defn- remove-map [conn concept postfix id]
+  (c/wcar conn (c/srem (get-key concept postfix) id))
+  (c/wcar conn (c/del id)))
+
+(defn remove-tasklink* [conn concept id]
+  (c/wcar conn (c/hdel (get-key concept tasklinks-pf) id))
+  (c/wcar conn (c/del id)))
+
+(defn- add-task* [conn task]
+  (let [id (str (UUID/randomUUID) task-pf)]
+    (c/wcar conn (c/hmset* id task))
+    id))
+
+(defn- select-link [conn concept prefix]
+  (let [id (->> prefix
+                (get-key concept)
+                c/srandmember
+                (c/wcar conn))]
+    (get-map-by-key conn (deserial-map prefix) id)))
+
+(defn- select-task [conn concept]
+  (let [link (->> (c/wcar conn (c/hkeys (get-key concept tasklinks-pf)))
+                  (mapv (partial get-map-by-key conn (deserial-map tasklinks-pf)))
+                  rand-nth)
+        task-id (:task link)]
+    (assoc link :task (get-map-by-key conn (deserial-map task-pf) task-id))))
+
+(defn get-task [conn id]
+  (get-map-by-key conn (deserial-map task-pf) id))
+
+(defn belief? [s] (= "belief" s))
+(defn goal? [s] (= "goal" s))
+(defn question? [s] (= "question" s))
+(defn quest? [s] (= "quest" s))
+
+(defn add-term* [conn concept]
+  (c/wcar conn (c/set (hash concept) concept)))
+
+(defn add-tasklink* [conn concept link type]
+  (let [id (str (UUID/randomUUID) tasklinks-pf)]
+    (c/wcar conn (c/hset (get-key concept tasklinks-pf) id type))
+    (c/wcar conn (c/hmset* id (assoc link :id id)))
+    id))
+
+(defn increment-value* [conn id name value]
+  (c/wcar conn (c/hincrbyfloat id name value)))
+
+(defrecord RedisMemory
+  [conn]
+  Memory
+  (term [_ concept] (c/wcar conn (c/get (check-hash concept))))
+  (beliefs [_ concept] (get-tasklinks conn concept belief?))
+  (goals [_ concept] (get-tasklinks conn concept goal?))
+  (questions [_ concept] (get-tasklinks conn concept question?))
+  (quests [_ concept] (get-tasklinks conn concept quest?))
+  (tasklinks [_ concept] (get-tasklinks conn concept (constantly true)))
+  (termlinks [_ concept] (get-maps-from-set conn concept termlinks-pf))
+  (budget [_ concept] (get-map conn concept budget-pf))
+
+  (select-task [_ concept] (select-task conn concept))
+  (select-termlink [_ concept] (select-link conn concept termlinks-pf))
+  (select-belief [mem concept occurrence]
+    (let [beliefs (m/beliefs mem concept)]
+      (when (sequential? beliefs) (rand-nth beliefs))))
+
+  (add-term [_ concept] (add-term* conn concept))
+  (add-task [_ task] (add-task* conn task))
+  (add-tasklink [_ concept link type] (add-tasklink* conn concept link type))
+  (add-termlink [_ concept link] (add-map conn concept termlinks-pf link))
+
+  (remove-tasklink [_ concept id] (remove-tasklink* conn concept id))
+  (remove-termlink [_ concept id] (remove-map conn concept termlinks-pf id))
+  (increment-value [_ id name value] (increment-value* conn id name value)))

src/narjure/narsese.clj

@@ -40,23 +40,16 @@
    "&/" 'sequential-events
    "&|" 'parallel-events})
 
-(def tenses
-  {":|:"  :present
-   ":/:"  :future
-   ":\\:" :past})
-
 (defn get-compound-term [[_ operator-srt]]
   (compound-terms operator-srt))
 
-(def task-types {"." :judgement
-                 "?" :question})
+(def actions {"." :judgement
+              "?" :question})
 
-(def ^:dynamic *task-type* (atom nil))
+(def ^:dynamic *action* (atom nil))
 (def ^:dynamic *lvars* (atom []))
 (def ^:dynamic *truth* (atom []))
 (def ^:dynamic *budget* (atom []))
-(def ^:dynamic *tense* (atom :present))
-(def ^:dynamic *syntactic-complexity* nil)
 
 (defn keep-cat [fun col]
   (into [] (comp (mapcat fun) (filter (complement nil?))) col))
@@ -71,20 +64,16 @@
 
 (defmethod element :sentence [[_ & data]]
   (let [filtered (group-by string? data)]
-    (reset! *task-type* (task-types (first (filtered true))))
+    (reset! *action* (actions (first (filtered true))))
     (let [cols (filtered false)
           last-el (last cols)]
       (when (= :truth (first last-el))
         (element last-el))
-      (when-let [tense (some #(when (= :tense (first %)) %) data)]
-        (element tense))
       (element (first cols)))))
 
 (defmethod element :statement [[_ & data]]
   (if-let [copula (get-copula data)]
-    (do
-      (swap! *syntactic-complexity* inc)
-      `[~copula ~@(keep-cat element data)])
+    `[~copula ~@(keep-cat element data)]
     (keep-cat element data)))
 
 (defmethod element :task [[_ & data]]
@@ -131,18 +120,14 @@
 (double-element :quality *budget*)
 
 (defmethod element :task [[_ & data]]
-  (when (= :budget (first (first data)))
+  (when (= :budget (ffirst data))
     (element (first data)))
   (element (last data)))
 
 (defmethod element :term [[_ & data]]
-  (swap! *syntactic-complexity* inc)
   (when (seq? data)
     (keep element data)))
 
-(defmethod element :tense [[_ key]]
-  (reset! *tense* (tenses key)))
-
 (defmethod element :default [_])
 
 ;TODO check for variables in statemnts, ignore subterm if it contains variable
@@ -163,20 +148,16 @@
   [narsese-str]
   (let [data (parser narsese-str)]
     (if-not (i/failure? data)
-      (binding [*task-type* (atom nil)
+      (binding [*action* (atom nil)
                 *lvars* (atom [])
                 *truth* (atom [])
-                *budget* (atom [])
-                *tense* (atom :present)
-                *syntactic-complexity* (atom 0)]
+                *budget* (atom [])]
         (let [statement (element data)
-              act @*task-type*]
-          {:task-type            act
-           :lvars                @*lvars*
-           :truth                (check-truth-value @*truth*)
-           :budget               (check-budget @*budget* act)
-           :statement            statement
-           :tense                @*tense*
-           :syntactic-complexity @*syntactic-complexity*
-           :terms                (terms statement)}))
+              act @*action*]
+          {:action    act
+           :lvars     @*lvars*
+           :truth     (check-truth-value @*truth*)
+           :budget    (check-budget @*budget* act)
+           :statement statement
+           :terms     (terms statement)}))
       data)))

src/narjure/repl.clj

@@ -1,11 +1,7 @@
 (ns narjure.repl
-  (:require [clojure.string :as s]
-            [narjure.narsese :refer [parse]]
+  (:require [narjure.narsese :refer [parse]]
             [instaparse.core :as i]
-            [nal.core :as c]
-            [clojure.core.logic :as l]
             [clojure.string :refer [trim]]
-            [clojure.pprint :as p]
             [clojure.tools.nrepl.middleware :refer [set-descriptor!]]
             [narjure.cycle :as cycle]))
 
@@ -42,7 +38,7 @@
 
 (defn- get-result [code]
   (let [result (parse code)]
-    (if (and (not (i/failure? result)))
+    (if-not (i/failure? result)
       (collect! result)
       result)))
 

src/narjure/system.clj

@@ -0,0 +1,24 @@
+(ns narjure.system
+  (:require [mount.core :refer [defstate start]]
+            [narjure.memory.redis :as r]
+            [nal.deriver.rules :refer [compile-rules]]
+            [nal.rules :refer [all-rules]]
+            [nal.core :as c]
+            [aero.core :refer [read-config]]))
+
+(declare mem inference)
+
+(def config
+  (read-config (clojure.java.io/resource "config.edn") {:profile :dev}))
+
+(defn get-config [path]
+  (get-in config path))
+
+(def redis-config
+  {:spec {:uri (get-config [:redis-config :uri])}})
+
+(defstate mem :start (r/->RedisMemory redis-config))
+(defstate inference :start (let [rules (compile-rules all-rules)]
+                             (partial c/inference rules)))
+
+(start)

test/nal/test/args_processing.clj

@@ -1,35 +0,0 @@
-(ns nal.test.args-processing
-  (:refer-clojure :exclude [== reduce replace])
-  (:require [clojure.test :refer :all]
-            [nal.args-processing :refer :all]
-            [clojure.core.logic :refer [run run* ==]]))
-
-(deftest test-replace
-  (is (= '([1 (nil 2 3 4)]
-            [2 (1 nil 3 4)]
-            [3 (1 2 nil 4)]
-            [4 (1 2 3 nil)])
-         (run* [q1 q2] (replaceo [1 2 3 4] q1 q2))))
-  (is (= '([1 (_0 2 3) _0] [2 (1 _0 3) _0] [3 (1 2 _0) _0])
-         (run* [q1 q2 q3] (replaceo [1 2 3] q1 q2 q3))))
-  (is (= '((nil 2)) (run* [q] (replaceo [1 2] 1 q))))
-  (is (= '((1 2 nil 4)) (run* [q] (replaceo [1 2 3 4] 3 q))))
-  (is (= '(4) (run* [q] (replaceo [1 2] 1 [4 2] q))))
-  (is (= '() (run* [q] (replaceo [1 2] 2 [4 2] q)))))
-
-(deftest test-include1
-  (is (= '(true) (run 1 [q] (== true q) (include1o [1 3] [1 2 3 4]))))
-  (is (= '() (run 1 [q] (== true q) (include1o [1 3 5] [1 2 3 4])))))
-
-(deftest test-include
-  (is (= '(_0) (run* [q] (includeo [1 2 3] [1 2 3 4]))))
-  (is (= '() (run* [q] (includeo [1 2 5] [1 2 3 4]))))
-  (is (= '() (run* [q] (includeo [1 2 5] q)))))
-
-(deftest test-same-set
-  (is (= '((1 3 2) (2 1 3) (3 1 2) (2 3 1) (3 2 1))
-         (run* [q] (same-seto [1 2 3] q)))))
-
-(deftest test-same
-  (is (= '((1 2 3) (1 3 2) (2 1 3) (3 1 2) (2 3 1) (3 2 1))
-         (run* [q] (sameo [1 2 3] q)))))

test/nal/test/core.clj

@@ -0,0 +1,271 @@
+(ns nal.test.core
+  (:require [clojure.test :refer :all]
+            [nal.core :as c]
+            [nal.rules :as r]
+            [nal.deriver.rules :refer [compile-rules]]))
+
+(def inference (partial c/inference (compile-rules r/all-rules)))
+
+(deftest test-inference
+  (are [a1 a2] (= (set a1) (set (apply inference a2)))
+    '({:statement  [==>
+                    [&| [--> [ext-set tim] [int-set driving]]]
+                    [--> [ext-set tim] [int-set dead]]]
+       :truth      [1.0 0.81]
+       :task-type  :judgement
+       :occurrence 1})
+
+    '[{:statement  [--> [ext-set tim] [int-set drunk]]
+       :truth      [1 0.9]
+       :task-type  :judgement
+       :occurrence 1}
+
+      {:statement  [==> [&| [--> [ind-var X] [int-set drunk]] [--> [ind-var X] [int-set driving]]]
+                    [--> [ind-var X] [int-set dead]]]
+       :truth      [1 0.9]
+       :occurrence 0}]
+
+    '({:occurrence 1
+       :statement  [&| a1 [--> [* a1 a2 a3] m]]
+       :task-type  :judgement
+       :truth      [1.0
+                    0.81]}
+       {:occurrence 1
+        :statement  [--> a1 [ext-image m _ a2 a3]]
+        :task-type  :judgement
+        :truth      [1
+                     0.9]}
+       {:occurrence 1
+        :statement  [<|> a1 [--> [* a1 a2 a3] m]]
+        :task-type  :judgement
+        :truth      [1.0
+                     0.44751381215469616]}
+       {:occurrence 1
+        :statement  [=|> [--> [* a1 a2 a3] m] a1]
+        :task-type  :judgement
+        :truth      [1
+                     0.44751381215469616]}
+       {:occurrence 1
+        :statement  [=|> a1 [--> [* a1 a2 a3] m]]
+        :task-type  :judgement
+        :truth      [1
+                     0.44751381215469616]})
+    '[{:statement  [--> [* a1 a2 a3] m]
+       :truth      [1 0.9]
+       :task-type  :judgement
+       :occurrence 1}
+
+      {:statement  a1
+       :truth      [1 0.9]
+       :occurrence 0}]
+
+    '[{:statement  [=|> [--> [* a1 a2 a3] m] a1],
+       :task-type  :judgement,
+       :occurrence 1,
+       :truth      [1 0.44751381215469616]}
+      {:statement  [<|> a1 [--> [* a1 a2 a3] m]],
+       :task-type  :judgement,
+       :occurrence 1,
+       :truth      [1.0 0.44751381215469616]}
+      {:statement  [&| [--> [* a1 a2 a3] m] a1],
+       :task-type  :judgement,
+       :occurrence 1,
+       :truth      [1.0 0.81]}
+      {:statement  [=|> a1 [--> [* a1 a2 a3] m]],
+       :task-type  :judgement,
+       :occurrence 1,
+       :truth      [1 0.44751381215469616]}]
+    '[{:statement  a1
+       :truth      [1 0.9]
+       :task-type  :judgement
+       :occurrence 1}
+
+      {:statement  [--> [* a1 a2 a3] m]
+       :truth      [1 0.9]
+       :occurrence 0}]
+
+    '({:occurrence 1
+       :statement  [&| a1 [conj a1 a2 a3]]
+       :task-type  :judgement
+       :truth      [1.0 0.81]}
+       {:occurrence 1
+        :statement  [<|> a1 [conj a1 a2 a3]]
+        :task-type  :judgement
+        :truth      [1.0 0.44751381215469616]}
+       {:occurrence 1
+        :statement  [=|> [conj a1 a2 a3] a1]
+        :task-type  :judgement
+        :truth      [1
+                     0.44751381215469616]}
+       {:occurrence 1
+        :statement  [=|> a1 [conj a1 a2 a3]]
+        :task-type  :judgement
+        :truth      [1
+                     0.44751381215469616]}
+       {:occurrence 1
+        :statement  a1
+        :task-type  :judgement
+        :truth      [1 0.44751381215469616]})
+    '[{:statement  [conj a1 a2 a3]
+       :truth      [1 0.9]
+       :task-type  :judgement
+       :occurrence 1}
+
+      {:statement  a1
+       :truth      [1 0.9]
+       :occurrence 0}]
+
+    '[{:statement  [=|> [--> M S] [[--> M S] [--> M P]]],
+       :task-type  :judgement,
+       :occurrence 1,
+       :truth      [1 0.44751381215469616]}
+      {:statement  [<|> [--> M S] [[--> M S] [--> M P]]],
+       :task-type  :judgement,
+       :occurrence 1,
+       :truth      [1.0 0.44751381215469616]}
+      {:statement  [&| [--> M S] [[--> M S] [--> M P]]],
+       :task-type  :judgement,
+       :occurrence 1,
+       :truth      [1.0 0.81]}
+      {:statement  [=|> [[--> M S] [--> M P]] [--> M S]],
+       :task-type  :judgement,
+       :occurrence 1,
+       :truth      [1 0.44751381215469616]}]
+    '[{:statement  [[--> M S] [--> M P]]
+       :truth      [1 0.9]
+       :task-type  :judgement
+       :occurrence 1}
+
+      {:statement  [--> M S]
+       :truth      [1 0.9]
+       :occurrence 0}]
+
+    '({:statement  [conj [--> [dep-var Y] [int-set B]]
+                    [==> [--> [ext-set A] [int-set Y]] [--> [dep-var Y] P]]]
+       :truth      [1.0 0.81]
+       :task-type  :judgement
+       :occurrence 1}
+       {:statement  [==>
+                     [conj [--> [ext-set A] [int-set Y]] [--> [ind-var X] [int-set B]]]
+                     [--> [ind-var X] P]]
+        :truth      [1 0.44751381215469616]
+        :task-type  :judgement
+        :occurrence 1})
+    '[{:statement  [==> [--> [ext-set A] [int-set Y]] [--> [ext-set A] P]]
+       :truth      [1 0.9]
+       :task-type  :judgement
+       :occurrence 1}
+
+      {:statement  [--> [ext-set A] [int-set B]]
+       :truth      [1 0.9]
+       :occurrence 1}]
+    '({:statement  [</>
+                    [seq-conj [--> chess competition] [:interval 1000]]
+                    [--> sport competition]],
+       :task-type  :judgement,
+       :occurrence 1000,
+       :truth      [1.0 0.44751381215469616]}
+       {:statement  [seq-conj
+                     [--> chess competition]
+                     [:interval 1000]
+                     [--> sport competition]],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1.0 0.81]}
+       {:statement  [pred-impl
+                     [seq-conj [--> chess competition] [:interval 1000]]
+                     [--> sport competition]],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1 0.44751381215469616]}
+       {:statement  [retro-impl
+                     [--> sport competition]
+                     [seq-conj [--> chess competition] [:interval 1000]]],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1 0.44751381215469616]}
+       {:statement  [--> sport chess],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1 0.44751381215469616]}
+       {:statement  [--> chess sport],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1 0.44751381215469616]}
+       {:statement  [<=> [--> chess [ind-var X]] [--> sport [ind-var X]]],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1.0 0.44751381215469616]}
+       {:statement  [conj [--> chess [dep-var Y]] [--> sport [dep-var Y]]],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1.0 0.81]}
+       {:statement  [<-> sport chess],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1.0 0.44751381215469616]}
+       {:statement  [==> [--> chess [ind-var X]] [--> sport [ind-var X]]],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1 0.44751381215469616]}
+       {:statement  [==> [--> chess [ind-var X]] [--> sport [ind-var X]]],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1 0.44751381215469616]}
+       {:statement  [==> [--> sport [ind-var X]] [--> chess [ind-var X]]],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1 0.44751381215469616]}
+       {:statement  [==> [--> sport [ind-var X]] [--> chess [ind-var X]]],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1 0.44751381215469616]}
+       {:statement  [--> [int-dif chess sport] competition],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [0.0 0.81]}
+       {:statement  [--> [| chess sport] competition],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1.0 0.81]}
+       {:statement  [--> [int-dif sport chess] competition],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [0.0 0.81]}
+       {:statement  [--> [ext-inter chess sport] competition],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1.0 0.81]}
+       {:statement  [pred-impl
+                     [seq-conj [--> chess [ind-var X]] [:interval 1000]]
+                     [--> sport [ind-var X]]],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1 0.44751381215469616]}
+       {:statement  [</>
+                     [seq-conj [--> chess [ind-var X]] [:interval 1000]]
+                     [--> sport [ind-var X]]],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1.0 0.44751381215469616]}
+       {:statement  [retro-impl
+                     [--> sport [ind-var X]]
+                     [seq-conj [--> chess [ind-var X]] [:interval 1000]]],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1 0.44751381215469616]}
+       {:statement  [seq-conj
+                     [--> chess [dep-var Y]]
+                     [:interval 1000]
+                     [--> sport [dep-var Y]]],
+        :task-type  :judgement,
+        :occurrence 1000,
+        :truth      [1.0 0.81]})
+    ['{:statement  [--> sport competition]
+       :truth      [1 0.9]
+       :task-type  :judgement
+       :occurrence 1000}
+
+     '{:statement  [--> chess competition]
+       :truth      [1 0.9]
+       :occurrence 0}]))

test/nal/test/deriver.clj

@@ -0,0 +1,26 @@
+(ns nal.test.deriver
+  (:require [clojure.test :refer :all]
+            [nal.deriver :refer :all]
+            [nal.deriver.rules :refer [compile-rules]]
+            [nal.rules :as r]))
+
+(def rules
+  (compile-rules '([(P --> M) (S --> M) |- (S <-> P)
+                    :post (:t/comparison :d/weak :allow-backward)
+                    :pre ((:!= S P))])))
+
+(deftest test-generate-conclusions
+  (is (= (set [{:occurrence 1000
+                :statement  '[<-> sport chess]
+                :task-type  :judgement
+                :truth      [1.0 0.44751381215469616]}])
+         (set (generate-conclusions
+                (rules :judgement)
+                '{:statement  [--> sport competition]
+                  :truth      [1 0.9]
+                  :task-type  :judgement
+                  :occurrence 1000}
+
+                '{:statement  [--> chess competition]
+                  :truth      [1 0.9]
+                  :occurrence 0})))))

test/nal/test/deriver/backward_rules.clj

@@ -0,0 +1,42 @@
+(ns nal.test.deriver.backward-rules
+  (:require [clojure.test :refer :all]
+            [nal.deriver.backward-rules :refer :all]))
+
+(deftest test-allow-backward?
+  (are [res] (= res :allow-backward)
+    (allow-backward? {:p1          :ok :p2 :boss
+                      :conclusions [{:conclusion '[--> A B]
+                                     :post       [:allow-backward]}]})
+    (allow-backward? {:p1          :ok :p2 :boss
+                      :conclusions [{:conclusion '[--> A B]
+                                     :post       [:t/ok :another-condition
+                                                  :allow-backward]}]}))
+  (are [res] (nil? res)
+    (allow-backward? {:p1          :ok :p2 :boss
+                      :conclusions [{:conclusion '[--> A B]
+                                     :post       []}]})
+    (allow-backward? {:p1          :ok :p2 :boss
+                      :conclusions [{:conclusion '[--> A B]
+                                     :post       [:something :and-more
+                                                  :t/abduction]}]})))
+
+(def bw-rule
+  '{:p1          (<-> S (ext-set P))
+    :p2          S
+    :conclusions [{:conclusion (--> S (ext-set P))
+                   :post       (:t/identity :d/identity :allow-backward)}]
+    :full-path   [(<-> :any (ext-set :any)) :and :any]
+    :pre         nil})
+
+(deftest test-generate-backward-rule
+  (let [[_ r1 r2 r3 :as rules] (expand-backward-rules bw-rule)]
+    (is (= 4 (count rules)))
+    (are [np1 np2 rule]
+      (let [{:keys [p1 p2]} rule]
+        (and (= p1 np1) (= p2 np2)))
+
+      '(<-> S (ext-set P)) 'S r1
+      '(--> S (ext-set P)) 'S r2
+
+      '(<-> S (ext-set P)) '(--> S (ext-set P)) r3)))
+

test/nal/test/deriver/key_path.clj

@@ -0,0 +1,48 @@
+(ns nal.test.deriver.key-path
+  (:require [clojure.test :refer :all]
+            [nal.deriver.key-path :refer :all]
+            [nal.test.test-utils :refer [both-equal]]))
+
+(deftest test-path
+  (both-equal
+    '(--> :any :any) (path '(--> A B))
+    '(--> (- :any :any) :any) (path '(--> (- B G) S))
+    '(==> (--> :any :any) (--> :any :any)) (path '(==> (--> $X S) (--> $X P)))))
+
+(deftest test-rule-path
+  (both-equal
+    [:any :and :any] (rule-path 'A 'B)
+    '((--> :any :any) :and (--> :any :any)) (rule-path '(--> A B) '(--> B C))))
+
+(deftest test-cart
+  (is (= '((1 2 3) (1 2 4) (2 2 3) (2 2 4)) (cart [[1 2] [2] [3 4]]))))
+
+(deftest test-path-invariants
+  (is (= '((==> (--> :any :any) (--> :any :any))
+            (==> (--> :any :any) :any)
+            (==> :any (--> :any :any))
+            (==> :any :any)
+            :any)
+         (path-invariants '(==> (--> :any :any) (--> :any :any))))))
+
+(deftest test-all-paths
+  (is
+    (= (set
+         '([(==> (--> :any :any) (--> :any :any)) :and (--> (- :any :any) :any)]
+            [(==> (--> :any :any) (--> :any :any)) :and (--> :any :any)]
+            [(==> (--> :any :any) :any) :and (--> (- :any :any) :any)]
+            [(==> :any (--> :any :any)) :and (--> (- :any :any) :any)]
+            [(==> (--> :any :any) :any) :and (--> :any :any)]
+            [(==> :any (--> :any :any)) :and (--> :any :any)]
+            [(==> :any :any) :and (--> (- :any :any) :any)]
+            [(==> (--> :any :any) (--> :any :any)) :and :any]
+            [(==> :any :any) :and (--> :any :any)]
+            [(==> (--> :any :any) :any) :and :any]
+            [(==> :any (--> :any :any)) :and :any]
+            [:any :and (--> (- :any :any) :any)]
+            [(==> :any :any) :and :any]
+            [:any :and (--> :any :any)]
+            [:any :and :any]))
+       (set (all-paths
+              '(==> (--> :any :any) (--> :any :any))
+              '(--> (- :any :any) :any))))))

test/nal/test/deriver/list_expansion.clj

@@ -0,0 +1,139 @@
+(ns nal.test.deriver.list-expansion
+  (:require
+    [clojure.test :refer :all]
+    [nal.deriver.list-expansion :refer :all]))
+
+(deftest test-get-list
+  (are [a1 a2] (= a1 (apply get-list a2))
+    :list/A
+    [":list"
+     '[(W --> (| B :list/A))
+       (W --> B)
+       |-
+       (W --> (| B :list/A))
+       :pre
+       (:question?)
+       :post
+       (:t/belief-structural-deduction :p/judgment)]]
+
+    :from/A
+    [":from"
+     '[(C --> (ext-set :list/A))
+       C
+       |-
+       (C --> (ext-set :from/A))
+       :post
+       (:t/structural-deduction)]]))
+
+
+(deftest test-gen-symbols
+  (are [a1 a2] (= a1 (apply gen-symbols a2))
+    '[A1 A2 A3] ['A 3]
+    '[B1 B2 B3 B4 B5] ['B 5]))
+
+(deftest test-replace-list-elemets
+  (are [a1 a2] (= a1 (apply replace-list-elemets a2))
+    '[(W --> (| B A1 A2 A3 A4))
+      (W --> B)
+      |-
+      (W --> (| B A1 A2 A3 A4))
+      :pre
+      (:question?)
+      :post
+      (:t/belief-structural-deduction :p/judgment)]
+
+    ['[(W --> (| B :list/A))
+       (W --> B)
+       |-
+       (W --> (| B :list/A))
+       :pre
+       (:question?)
+       :post
+       (:t/belief-structural-deduction :p/judgment)]
+     :list/A
+     "A"
+     4]
+
+    '[--> B1 B2 B3 B4 B5]
+    ['[--> :list/B] :list/B "B" 5]))
+
+(deftest test-list-name
+  (are [a1 a2] (= a1 (list-name a2))
+    "A" :list/A
+    "B" :list/B))
+
+(deftest test-expand-:from-element
+  (are [a1 a2] (= a1 (apply expand-:from-element a2))
+    '([--> k A1] [--> k A2] [--> k A3])
+    ['[--> k :from/A] :from/A "A" 3]
+
+    '([--> k [conj d A1]])
+    ['[--> k [conj d :from/A]] :from/A "A" 1]))
+
+(deftest test-generate-all-lists
+  (are [a1 a2] (= a1 (generate-all-lists a2))
+
+    '([(W --> (| B A1))
+       (W --> B)
+       |-
+       (W --> (| B A1))
+       :pre
+       (:question?)
+       :post
+       (:t/belief-structural-deduction :p/judgment)]
+       [(W --> (| B A1 A2))
+        (W --> B)
+        |-
+        (W --> (| B A1 A2))
+        :pre
+        (:question?)
+        :post
+        (:t/belief-structural-deduction :p/judgment)]
+       [(W --> (| B A1 A2 A3))
+        (W --> B)
+        |-
+        (W --> (| B A1 A2 A3))
+        :pre
+        (:question?)
+        :post
+        (:t/belief-structural-deduction :p/judgment)]
+       [(W --> (| B A1 A2 A3 A4))
+        (W --> B)
+        |-
+        (W --> (| B A1 A2 A3 A4))
+        :pre
+        (:question?)
+        :post
+        (:t/belief-structural-deduction :p/judgment)]
+       [(W --> (| B A1 A2 A3 A4 A5))
+        (W --> B)
+        |-
+        (W --> (| B A1 A2 A3 A4 A5))
+        :pre
+        (:question?)
+        :post
+        (:t/belief-structural-deduction :p/judgment)]
+       [(W --> (| B A1 A2 A3 A4 A5 A6))
+        (W --> B)
+        |-
+        (W --> (| B A1 A2 A3 A4 A5 A6))
+        :pre
+        (:question?)
+        :post
+        (:t/belief-structural-deduction :p/judgment)]
+       [(W --> (| B A1 A2 A3 A4 A5 A6 A7))
+        (W --> B)
+        |-
+        (W --> (| B A1 A2 A3 A4 A5 A6 A7))
+        :pre
+        (:question?)
+        :post
+        (:t/belief-structural-deduction :p/judgment)])
+    '[(W --> (| B :list/A))
+      (W --> B)
+      |-
+      (W --> (| B :list/A))
+      :pre
+      (:question?)
+      :post
+      (:t/belief-structural-deduction :p/judgment)]))

test/nal/test/deriver/matching.clj

@@ -0,0 +1,26 @@
+(ns nal.test.deriver.matching
+  (:require [clojure.test :refer :all]
+            [nal.deriver.matching :refer :all]))
+
+(deftest test-quote-operators
+  (are [a1 a2] (= a1 (quote-operators a2))
+    `(let
+        [~'G__57753
+         (nal.deriver.preconditions/abs (- :t-occurrence :b-occurrence))]
+        [:interval ~'G__57753])
+    `(let
+       [~'G__57753
+        (nal.deriver.preconditions/abs (- :t-occurrence :b-occurrence))]
+       [:interval ~'G__57753])
+
+    `(let
+       [~'G__57753
+        (nal.deriver.preconditions/abs (- :t-occurrence :b-occurrence))]
+       [(quote ~'ext-set) ~'G__57753])
+    `(let
+       [~'G__57753
+        (nal.deriver.preconditions/abs (- :t-occurrence :b-occurrence))]
+       [~'ext-set ~'G__57753])
+
+    '[(quote ext-set) x1 x2]
+    '(ext-set x1 x2)))

test/nal/test/deriver/normalization.clj

@@ -0,0 +1,84 @@
+(ns nal.test.deriver.normalization
+  (:require [clojure.test :refer :all]
+            [nal.deriver.normalization :refer :all]
+            [nal.test.test-utils :refer [both-equal]]))
+
+(deftest test-infix->prefix
+  (both-equal
+     '(--> A B) (infix->prefix '(A --> B))
+     '(--> (- B G) S) (infix->prefix '((B - G) --> S))
+     '(==> (--> $X S) (--> $X P)) (infix->prefix '(($X --> S) ==> ($X --> P)))))
+
+(deftest test-neg-symbol?
+  (are [el] (true? el)
+    (#'nal.deriver.normalization/neg-symbol? '--)
+    (#'nal.deriver.normalization/neg-symbol? '--A))
+  (are [el] (false? el)
+    (#'nal.deriver.normalization/neg-symbol? '-->)
+    (#'nal.deriver.normalization/neg-symbol? 'B)))
+
+(deftest test-trim-negation
+  (is (= 'A (#'nal.deriver.normalization/trim-negation '--A))))
+
+(deftest test-neg-el
+  (is (= '(-- A) (neg 'A))))
+
+(deftest test-replace-negation
+  (both-equal
+     '(-- A) (replace-negation '--A)
+     '(A (-- (--> A B))) (replace-negation '(A -- (--> A B)))
+     '(--> A B) (replace-negation '(--> A B))
+     '((-- A)) (replace-negation '[-- A])
+     '(-- A) (replace-negation '(-- A))))
+
+(deftest test-reduce-ops
+  (are [a1 a2] (= a1 (reduce-ops a2))
+    1 '[ext-inter 1]
+    '[ext-inter 1] '[ext-inter [ext-inter 1] [ext-inter 1]]
+    '[ext-inter 2 1] '[ext-inter [ext-inter 1] [ext-inter 2]]
+    '[ext-inter 2 1] '[ext-inter [ext-inter 1] 2]
+    '[ext-inter 2 1] '[ext-inter 1 [ext-inter 2]]
+    '[int-set 2 1] '[ext-inter [int-set 1] [int-set 2]]
+    '[int-set 2 1] '[ext-inter [int-set 1] [int-set 2]]
+    '[ext-inter [ext-set 1] [ext-set 2]]
+    '[ext-inter [ext-set 1] [ext-set 2]]
+
+    2 '[| 2]
+    '[| 1] '[| [| 1] [| 1]]
+    '[| 2 1] '[| [| 1] [| 2]]
+    '[| 2 1] '[| [| 1] 2]
+    '[| 2 1] '[| 1 [| 2]]
+    '[int-set 3 2 1] '[| [int-set 1] [int-set 2 3]]
+    '[ext-set 3 2 1] '[| [ext-set 1] [ext-set 2 3]]
+    '[int-set 2 4 1] '[| [int-set 1 4] [int-set 2]]
+    '[ext-set 2 4 1] '[| [ext-set 1 4] [ext-set 2]]
+
+    '[ext-set 2 4 1] '[- [ext-set 5 6 2 4 1] [ext-set 5 6]]
+    '[int-set 2 4 1] '[int-dif [int-set 5 6 2 4 1] [int-set 5 6]]
+
+    '[<-> 1 2] '[<-> [ext-set 1] [ext-set 2]]
+    '[<-> 1 2] '[<-> [int-set 1] [int-set 2]]
+
+    '[* 1 2] '[* [* 1] 2]
+    '[* 1 3 2] '[* [* 1 3] 2]
+    '[* 1 3 2 4] '[* [* 1 3] 2 4]
+
+    1 '[ext-image [* 1 2] 2]
+    '[ext-image [* 1 2] 3] '[ext-image [* 1 2] 3]
+    1 '[int-image [* 1 2] 2]
+    '[int-image [* 1 2] 2 4] '[int-image [* 1 2] 2 4]
+
+    1 '[-- [-- 1]]
+    '[-- 1] '[-- 1]
+
+    1 '[conj 1]
+    1 '[conj 1 1]
+    '[conj 3 2 4 1] '[conj [conj 2 4] [conj 1 3]]
+    '[conj 3 2 4] '[conj [conj 2 4] 3]
+    '[conj 3 2 4] '[conj 2 [conj 3 4]]
+
+    1 '[|| 1]
+    1 '[|| 1 1]
+    '[|| 3 2 4 1] '[|| [|| 2 4] [|| 1 3]]
+    '[|| 3 2 4] '[|| [|| 2 4] 3]
+    '[|| 3 2 4] '[|| 2 [|| 3 4]]))

test/nal/test/deriver/preconditions.clj

@@ -0,0 +1,34 @@
+(ns nal.test.deriver.preconditions
+  (:require [clojure.test :refer :all]
+            [nal.deriver.preconditions :refer :all]))
+
+(deftest test-compount-precondition
+  (are [c1 c2] (= c1 (compound-precondition c2))
+    `[(and
+        (coll? ~'A)
+        (= ~'ext-set (first ~'A)))]
+    '(:set-ext? A)
+
+    `[(and
+        (coll? ~'A)
+        (= ~'int-set (first ~'A)))]
+    '(:set-int? A)
+
+    '[(clojure.core/not= A B)]
+    '(:!= A B)
+
+    '[(nal.deriver.substitution/munification-map "$" A B)]
+    '(:substitute-if-unifies "$" A B)
+
+    `[(if (coll? ~'A)
+        (nil?
+          (nal.deriver.preconditions/implications-and-equivalences
+            (first ~'A)))
+        true)]
+    '(:not-implication-or-equivalence A)))
+
+(deftest test-sets-preconditions
+  (are [c1 c2] (= c1 (count (compound-precondition c2)))
+    4 '(:difference A B)
+    3 '(:union A B)
+    4 '(:intersection A B)))

test/nal/test/deriver/premises_swapping.clj

@@ -0,0 +1,40 @@
+(ns nal.test.deriver.premises-swapping
+  (:require [clojure.test :refer :all]
+            [nal.deriver.premises-swapping :refer :all]))
+
+(def question-rule
+  '{:p1          (--> P S)
+    :p2          (--> S P)
+    :conclusions [{:conclusion (--> P S)
+                   :post       (:t/conversion :p/judgment)}]
+    :full-path   [(--> :any :any) :and (--> :any :any)]
+    :pre         (:question?)})
+
+(def rule-wth-commutative-term
+  '{:p1          (--> P M),
+    :p2          (--> S M),
+    :conclusions [{:conclusion (<-> S P),
+                   :post       (:t/comparison :d/weak :allow-backward)}],
+    :full-path   [(--> :any :any) :and (--> :any :any)],
+    :pre         ((:!= S P))})
+
+(def rule
+  '{:p1          (--> M P),
+    :p2          (<-> S M),
+    :conclusions [{:conclusion (--> S P),
+                   :post       (:t/analogy :d/strong :allow-backward)}],
+    :full-path   [(--> :any :any) :and (<-> :any :any)],
+    :pre         ((:!= S P))})
+
+(deftest test-allow-swapping?
+  (are [r] (false? (allow-swapping? r))
+    question-rule
+    rule-wth-commutative-term)
+  (is (true? (allow-swapping? rule))))
+
+(deftest test-swap-premises
+  (let [{:keys [p1 p2]} rule
+        swapped (swap-premises rule)]
+    (is (and (= p1 (swapped :p2))
+             (= p2 (swapped :p1))))))
+

test/nal/test/deriver/rules.clj

@@ -0,0 +1,60 @@
+(ns nal.test.deriver.rules
+  (:require [clojure.test :refer :all]
+            [nal.deriver.rules :refer :all]
+            [nal.test.test-utils :refer [both-equal]]))
+
+(deftest test-options
+  (both-equal {:pre [] :post []} (options [:pre [] :post []])
+              {:pre []} (options [:pre [] []])))
+
+(deftest test-get-conclusions
+  (both-equal
+    [{:conclusion '(--> A B), :post nil}] (get-conclusions '(--> A B) {})
+
+    [{:conclusion '(--> A B), :post [:something]}]
+    (get-conclusions '(--> A B) {:post [:something]})
+
+    '({:conclusion (=|> S P), :post (:t/induction :linkage-temporal)}
+       {:conclusion (=|> P S), :post (:t/induction :linkage-temporal)}
+       {:conclusion (<|> S P), :post (:t/comparison :linkage-temporal)}
+       {:conclusion (&| S P), :post (:t/intersection :linkage-temporal)})
+    (get-conclusions
+      '((=|> S P) :post (:t/induction :linkage-temporal)
+         (=|> P S) :post (:t/induction :linkage-temporal)
+         (<|> S P) :post (:t/comparison :linkage-temporal)
+         (&| S P) :post (:t/intersection :linkage-temporal)) {})))
+
+(def trule (rule '[(D pred-impl R) (D --> K) |- ((K pred-impl R) :post (:t/abduction)
+                                                  (R --> K) :post (:t/induction)
+                                                  (K </> R) :post (:t/comparison))
+                   :pre ((:!= R K))]))
+
+(deftest test-rule
+  (both-equal
+    '[{:p1          (--> S P),
+       :p2          (<-> S P),
+       :conclusions [{:conclusion (--> S P), :post (:t/struct-int :p/judgment)}],
+       :full-path   [(--> :any :any) :and (<-> :any :any)],
+       :pre         (:question?)}]
+    (rule '[(S --> P) (S <-> P) |- (S --> P) :post (:t/struct-int :p/judgment)
+            :pre (:question?)])
+
+    '({:conclusions [{:conclusion (pred-impl K R)
+                      :post       (:t/abduction)}]
+       :full-path   [(pred-impl :any :any) :and (--> :any :any)]
+       :p1          (pred-impl D R)
+       :p2          (--> D K)
+       :pre         ((:!= R K))}
+       {:conclusions [{:conclusion (--> R K)
+                       :post       (:t/induction)}]
+        :full-path   [(pred-impl :any :any) :and (--> :any :any)]
+        :p1          (pred-impl D R)
+        :p2          (--> D K)
+        :pre         ((:!= R K))}
+       {:conclusions [{:conclusion (</> K R)
+                       :post       (:t/comparison)}]
+        :full-path   [(pred-impl :any :any) :and (--> :any :any)]
+        :p1          (pred-impl D R)
+        :p2          (--> D K)
+        :pre         ((:!= R K))})
+    trule))

test/nal/test/deriver/substitution.clj

@@ -0,0 +1,55 @@
+(ns nal.test.deriver.substitution
+  (:require [clojure.test :refer :all]
+            [nal.deriver.substitution :refer :all]))
+
+(deftest test-replace-vars
+  (are [a1 a2 a3] (= a1 (replace-vars a2 a3))
+    '[--> ?X a]
+    'ind-var
+    '[--> [ind-var X] a]
+
+    '[--> [ind-var X] a]
+    'dep-var
+    '[--> [ind-var X] a]
+
+    '[==> [--> ?X k] ?Y]
+    'dep-var
+    '[==> [--> [dep-var X] k] [dep-var Y]]
+
+    '[==> [--> ?X k] ?X]
+    'dep-var
+    '[==> [--> [dep-var X] k] [dep-var X]]
+
+    '[==> [--> ?X k] [ind-var Y]]
+    'dep-var
+    '[==> [--> [dep-var X] k] [ind-var Y]]))
+
+(deftest test-unification-map
+  (are [a1 a2] (= a1 (apply unification-map a2))
+    ;successfully unifies
+    '{[ind-var X] tim} ["$" '[--> [ind-var X] alcoholic] '[--> tim alcoholic]]
+
+    ;unifies even if there is no vars
+    {} ["$" '[--> tim alcoholic] '[--> tim alcoholic]]
+
+    ;doesn't unify, var can be binded only once
+    nil ["$" '[==> [--> [ind-var X] a] [--> [ind-var X] b]]
+         '[==> [--> ok a] [--> boss b]]]
+
+    ;unifies, different vars can contain the same values
+    '{[ind-var X] ok [ind-var Y] ok}
+    ["$" '[==> [--> [ind-var X] a] [--> [ind-var Y] b]]
+     '[==> [--> ok a] [--> ok b]]]))
+
+(deftest test-placeholder->symbol
+  (are [a1 a2] (= a1 (placeholder->symbol a2))
+    'X '?X
+    (symbol "1") '?1))
+
+(deftest test-replace-placeholders
+  (are [a1 a2] (= a1 (apply replace-placeholders a2))
+    '{[dep-var X] 1 [dep-var Y] 2}
+    '[dep-var {?X 1 ?Y 2}]
+
+    '{[ind-var X] 1}
+    '[ind-var {?X 1}]))

test/nal/test/deriver/terms_premutation.clj

@@ -0,0 +1,187 @@
+(ns nal.test.deriver.terms-premutation
+  (:require [clojure.test :refer :all]
+            [nal.deriver.terms-permutation :refer :all]
+            [nal.test.test-utils :refer [both-equal]]))
+
+(deftest test-contains-op?
+  (are [res] ((complement nil?) res)
+    (contains-op? '[--> [A B] [<-> C [ext-set D K]]] #{'ext-set})
+    (contains-op? '--> #{'-->})
+    (contains-op? '[--> A B] #{'-->}))
+  (are [res] (or (false? res) (nil? res))
+    (contains-op? '[--> [A B] [<-> C [ext-set D K]]] #{'<=>})
+    (contains-op? '--> '<->)))
+
+(deftest test-replace-op
+  (both-equal
+    '[==> A B] (replace-op '[=|> A B] '=|> '==>)
+    '[==> A B] (replace-op '[=|> A B] '=|> '==>)
+    '[--> A [retro-impl A B]] (replace-op '[=|> A [retro-impl A B]] '=|> '-->)))
+
+(deftest test-premure-op
+  (both-equal
+    '([=|> A B] [retro-impl A B] [==> A B] [pred-impl A B])
+    (permute-op '[==> A B] implications)
+
+    '([=|> A B] [retro-impl A B] [==> A B] [pred-impl A B])
+    (permute-op '[=|> A B] implications)
+
+    '(conj &| seq-conj) (permute-op '&| conjunctions)))
+
+(def rule1
+  '{:p1          (==> M P)
+    :p2          (==> S M)
+    :conclusions [{:conclusion (==> S P)
+                   :post       (:t/deduction :order-for-all-same :allow-backward)}]
+    :full-path   [(==> :any :any) :and (==> :any :any)]})
+
+(def rule2
+  '{:p1          (==> M P)
+    :p2          (==> S M)
+    :conclusions [{:conclusion (==> S P)
+                   :post       (:allow-backward)}]
+    :full-path   [(==> :any :any) :and (==> :any :any)]})
+
+(def rule3
+  '{:p1          (==> S M)
+    :p2          (==> (conj S :list/A) M)
+    :conclusions [{:conclusion (==> (conj :list/A) M)
+                   :post       (:t/decompose-npp
+                                 :order-for-all-same
+                                 :seq-interval-from-premises)}]
+    :full-path   [(==> :any :any) :and (==> (conj :any :any) :any)]})
+
+(deftest test-order-for-all-same?
+  (is ((complement nil?) (order-for-all-same? rule1)))
+  (is (nil? (order-for-all-same? rule2))))
+
+(def res1
+  '({:p1          (=|> M P),
+     :p2          (=|> S M),
+     :conclusions [{:conclusion (=|> S P),
+                    :post       (:t/deduction :order-for-all-same :allow-backward)}],
+     :full-path   [(=|> :any :any) :and (=|> :any :any)],
+     :pre         nil}
+     {:p1          (==> M P),
+      :p2          (==> S M),
+      :conclusions [{:conclusion (==> S P),
+                     :post       (:t/deduction :order-for-all-same :allow-backward)}],
+      :full-path   [(==> :any :any) :and (==> :any :any)],
+      :pre         nil}
+     {:p1          (retro-impl M P),
+      :p2          (retro-impl S M),
+      :conclusions [{:conclusion (retro-impl S P),
+                     :post       (:t/deduction :order-for-all-same :allow-backward)}],
+      :full-path   [(retro-impl :any :any) :and (retro-impl :any :any)],
+      :pre         nil}
+     {:p1          (pred-impl M P),
+      :p2          (pred-impl S M),
+      :conclusions [{:conclusion (pred-impl S P),
+                     :post       (:t/deduction :order-for-all-same :allow-backward)}],
+      :full-path   [(pred-impl :any :any) :and (pred-impl :any :any)],
+      :pre         nil}))
+
+(def res2
+  '({:p1          (pred-impl S M),
+     :p2          (pred-impl (seq-conj S :list/A) M),
+     :conclusions [{:conclusion (pred-impl (seq-conj :list/A) M),
+                    :post       (:t/decompose-npp
+                                  :order-for-all-same
+                                  :seq-interval-from-premises)}],
+     :full-path   [(pred-impl :any :any) :and (pred-impl (seq-conj :any :any) :any)],
+     :pre         nil}
+     {:p1          (retro-impl S M),
+      :p2          (retro-impl (seq-conj S :list/A) M),
+      :conclusions [{:conclusion (retro-impl (seq-conj :list/A) M),
+                     :post       (:t/decompose-npp
+                                   :order-for-all-same
+                                   :seq-interval-from-premises)}],
+      :full-path   [(retro-impl :any :any)
+                    :and
+                    (retro-impl (seq-conj :any :any) :any)],
+      :pre         nil}
+     {:p1          (=|> S M),
+      :p2          (=|> (seq-conj S :list/A) M),
+      :conclusions [{:conclusion (=|> (seq-conj :list/A) M),
+                     :post       (:t/decompose-npp
+                                   :order-for-all-same
+                                   :seq-interval-from-premises)}],
+      :full-path   [(=|> :any :any) :and (=|> (seq-conj :any :any) :any)],
+      :pre         nil}
+     {:p1          (pred-impl S M),
+      :p2          (pred-impl (conj S :list/A) M),
+      :conclusions [{:conclusion (pred-impl (conj :list/A) M),
+                     :post       (:t/decompose-npp
+                                   :order-for-all-same
+                                   :seq-interval-from-premises)}],
+      :full-path   [(pred-impl :any :any) :and (pred-impl (conj :any :any) :any)],
+      :pre         nil}
+     {:p1          (==> S M),
+      :p2          (==> (conj S :list/A) M),
+      :conclusions [{:conclusion (==> (conj :list/A) M),
+                     :post       (:t/decompose-npp
+                                   :order-for-all-same
+                                   :seq-interval-from-premises)}],
+      :full-path   [(==> :any :any) :and (==> (conj :any :any) :any)],
+      :pre         nil}
+     {:p1          (=|> S M),
+      :p2          (=|> (&| S :list/A) M),
+      :conclusions [{:conclusion (=|> (&| :list/A) M),
+                     :post       (:t/decompose-npp
+                                   :order-for-all-same
+                                   :seq-interval-from-premises)}],
+      :full-path   [(=|> :any :any) :and (=|> (&| :any :any) :any)],
+      :pre         nil}
+     {:p1          (retro-impl S M),
+      :p2          (retro-impl (conj S :list/A) M),
+      :conclusions [{:conclusion (retro-impl (conj :list/A) M),
+                     :post       (:t/decompose-npp
+                                   :order-for-all-same
+                                   :seq-interval-from-premises)}],
+      :full-path   [(retro-impl :any :any) :and (retro-impl (conj :any :any) :any)],
+      :pre         nil}
+     {:p1          (==> S M),
+      :p2          (==> (&| S :list/A) M),
+      :conclusions [{:conclusion (==> (&| :list/A) M),
+                     :post       (:t/decompose-npp
+                                   :order-for-all-same
+                                   :seq-interval-from-premises)}],
+      :full-path   [(==> :any :any) :and (==> (&| :any :any) :any)],
+      :pre         nil}
+     {:p1          (=|> S M),
+      :p2          (=|> (conj S :list/A) M),
+      :conclusions [{:conclusion (=|> (conj :list/A) M),
+                     :post       (:t/decompose-npp
+                                   :order-for-all-same
+                                   :seq-interval-from-premises)}],
+      :full-path   [(=|> :any :any) :and (=|> (conj :any :any) :any)],
+      :pre         nil}
+     {:p1          (pred-impl S M),
+      :p2          (pred-impl (&| S :list/A) M),
+      :conclusions [{:conclusion (pred-impl (&| :list/A) M),
+                     :post       (:t/decompose-npp
+                                   :order-for-all-same
+                                   :seq-interval-from-premises)}],
+      :full-path   [(pred-impl :any :any) :and (pred-impl (&| :any :any) :any)],
+      :pre         nil}
+     {:p1          (==> S M),
+      :p2          (==> (seq-conj S :list/A) M),
+      :conclusions [{:conclusion (==> (seq-conj :list/A) M),
+                     :post       (:t/decompose-npp
+                                   :order-for-all-same
+                                   :seq-interval-from-premises)}],
+      :full-path   [(==> :any :any) :and (==> (seq-conj :any :any) :any)],
+      :pre         nil}
+     {:p1          (retro-impl S M),
+      :p2          (retro-impl (&| S :list/A) M),
+      :conclusions [{:conclusion (retro-impl (&| :list/A) M),
+                     :post       (:t/decompose-npp
+                                   :order-for-all-same
+                                   :seq-interval-from-premises)}],
+      :full-path   [(retro-impl :any :any) :and (retro-impl (&| :any :any) :any)],
+      :pre         nil}))
+
+(deftest test-generate-all-orders
+  (both-equal
+    res1 (generate-all-orders rule1)
+    res2 (generate-all-orders rule3)))

test/nal/test/deriver/truth.clj

@@ -0,0 +1,212 @@
+(ns nal.test.deriver.truth
+  (:require [nal.deriver.truth :refer :all]
+            [clojure.test :refer :all]
+            [nal.test.test-utils :refer [both-equal]]))
+
+(deftest test-t-and
+  (both-equal
+    0.7 (t-and 1 0.7)
+    0.8 (t-and 1 1 0.8)
+    0.9 (t-and 1 1 1 0.9)))
+
+(deftest test-t-or
+  (both-equal
+     0.94 (t-or 0.8 0.7)
+     1.0 (t-or 1 0.7)
+     1.0 (t-or 0.7 1)))
+
+(deftest test-w2c
+  (both-equal
+     0.4117647058823529 (w2c 0.7)
+     0.16666666666666669 (w2c 0.2)))
+
+(deftest test-c2w
+  (both-equal
+     0.7241379310344827 (c2w 0.42)
+     0.7241379310344827 (c2w 0.42)
+     0.20048019207683077 (c2w 0.167)))
+
+(deftest test-conversion
+  (both-equal
+     [1 0.4736842105263158] (conversion [1 0.9] [1 0.9])
+     [1 0.4736842105263158] (conversion [0 0.9] [1 0.9])
+     [1 0.3333333333333333] (conversion [1 0.9] [0.6 0.5])))
+
+(deftest test-negation
+  (both-equal
+     [0.0 0.9] (negation [1 0.9] [1 0.9])
+     [0.0 0.9] (negation [1 0.9] [0.6 0.9])
+     [0.6 0.6] (negation [0.4 0.6] [0.6 0.9])))
+
+(deftest test-contraposition
+  (both-equal
+     [0 0.4736842105263158] (contraposition [1 0.9])
+     [0 0.4736842105263158] (contraposition [0 0.9])
+     [0 0.37499999999999994] (contraposition [0 0.6])))
+
+(deftest test-revision
+  (both-equal
+     [1.0 0.9473684210526316] (revision [1 0.9] [1 0.9])
+     [0.95 0.9090909090909091] (revision [1 0.9] [0.5 0.5])
+     [0.95 0.9090909090909091] (revision [0.5 0.5] [1 0.9])))
+
+(deftest tets-deduction
+  (both-equal
+     [1.0 0.81] (deduction [1 0.9] [1 0.9])
+     [1.0 0.45] (deduction [1 0.9] [1 0.5])
+     [1.0 0.45] (deduction [1 0.5] [1 0.9])))
+
+(deftest test-analogy
+  (both-equal
+     [1.0 0.81] (analogy [1 0.9] [1 0.9])
+     [1.0 0.27] (analogy [1 0.9] [1 0.3])
+     [1.0 0.27] (analogy [1 0.3] [1 0.9])
+     [0.54 0.24300000000000002] (analogy [0.6 0.3] [0.9 0.9])))
+
+(deftest test-resemblance
+  (both-equal
+     [1.0 0.81] (resemblance [1 0.9] [1 0.9])
+     [1.0 0.45] (resemblance [1 0.9] [1 0.5])
+     [1.0 0.45] (resemblance [1 0.5] [1 0.9])
+     [0.29700000000000004 0.5224799999999999] (resemblance [0.9 0.8] [0.33 0.7])))
+
+(deftest test-abduction
+  (both-equal
+     [1 0.44751381215469616] (abduction [1 0.9] [1 0.9])
+     [1 0.35064935064935066] (abduction [1 0.9] [1 0.6])
+     [1 0.35064935064935066] (abduction [1 0.6] [1 0.9])
+     [0.67 0.10714285714285712] (abduction [0.67 0.6] [1 0.2])))
+
+(deftest test-induction
+  (both-equal
+     [1 0.44751381215469616] (induction [1 0.9] [1 0.9])
+     [1 0.3103448275862069] (induction [1 0.9] [1 0.5])
+     [1 0.3103448275862069] (induction [1 0.9] [1 0.5])
+     [0.9 0.12280701754385964] (induction [0.4 0.7] [0.9 0.5])))
+
+(deftest test-exemplification
+  (both-equal
+     [1 0.44751381215469616] (exemplification [1 0.9] [1 0.9])
+     [1 0.3865030674846626] (exemplification [1 0.9] [1 0.7])
+     [1 0.3865030674846626] (exemplification [1 0.7] [1 0.9])
+     [1 0.04928506236689991] (exemplification [0.8 0.2] [0.6 0.54])))
+
+(deftest test-comparison
+  (both-equal
+     [1.0 0.44751381215469616] (comparison [1 0.9] [1 0.9])
+     [1.0 0.2647058823529412] (comparison [1 0.9] [1 0.4])
+     [1.0 0.2647058823529412] (comparison [1 0.4] [1 0.9])
+     [0.7346938775510206 0.07270029673590506] (comparison [0.8 0.2] [0.9 0.4])))
+
+(deftest test-union
+  (both-equal
+     [1.0 0.81] (union [1 0.9] [1 0.9])
+     [1.0 0.18000000000000002] (union [1 0.9] [1 0.2])
+     [1.0 0.18000000000000002] (union [1 0.2] [1 0.9])
+     [0.94 0.08000000000000002] (union [0.7 0.4] [0.8 0.2])))
+
+(deftest test-intersection
+  (both-equal
+     [1.0 0.81] (intersection [1 0.9] [1 0.9])
+     [1.0 0.36000000000000004] (intersection [1 0.9] [1 0.4])
+     [1.0 0.36000000000000004] (intersection [1 0.4] [1 0.9])
+     [0.522 0.18000000000000002] (intersection [0.87 0.9] [0.6 0.2])))
+
+(deftest test-anonymous-analogy
+  (both-equal
+     [1.0 0.42631578947368426] (anonymous-analogy [1 0.9] [1 0.9])
+     [1.0 0.14210526315789473] (anonymous-analogy [1 0.9] [1 0.3])
+     [0.16000000000000003 0.04153846153846154] (anonymous-analogy [0.2 0.3] [0.8 0.9])))
+
+(deftest test-decompose-pnn
+  (both-equal
+     [1.0 0.0] (decompose-pnn [1 0.9] [1 0.9])
+     [0.9 0.018] (decompose-pnn [1 0.9] [0.9 0.2])
+     [0.9 0.018] (decompose-pnn [1 0.2] [0.9 0.9])
+     [0.97 0.0053999999999999986] (decompose-pnn [0.3 0.2] [0.9 0.9])))
+
+(deftest test-decompose-npp
+  (both-equal
+     [0.0 0.0] (decompose-npp [1 0.9] [1 0.9])
+     [0.63 0.1134] (decompose-npp [0.3 0.2] [0.9 0.9])
+     [0.029999999999999992 0.0053999999999999986] (decompose-npp [0.9 0.9] [0.3 0.2])))
+
+(deftest test-decompose-pnp
+  (both-equal
+     [0.0 0.0] (decompose-pnp [1 0.9] [1 0.9])
+     [0.07999999999999999 0.0144] (decompose-pnp [0.4 0.9] [0.8 0.2])
+     [0.48 0.0864] (decompose-pnp [0.8 0.2] [0.4 0.9])))
+
+(deftest test-decompose-ppp
+  (both-equal
+     [1.0 0.81] (decompose-ppp [1 0.9] [1 0.9])
+     [1.0 0.54] (decompose-ppp [1 0.9] [1 0.6])
+     [1.0 0.54] (decompose-ppp [1 0.6] [1 0.9])
+     [0.44 0.2376] (decompose-ppp [0.5 0.9] [0.88 0.6])))
+
+(deftest test-decompose-nnn
+  (both-equal
+     [1.0 0.0] (decompose-nnn [1 0.9] [1 0.9])
+     [0.99 0.008099999999999996] (decompose-nnn [0.9 0.9] [0.9 0.9])
+     [0.52 0.3888] (decompose-nnn [0.2 0.9] [0.4 0.9])
+     [0.52 0.3888] (decompose-nnn [0.4 0.9] [0.2 0.9])))
+
+(deftest test-difference
+  (both-equal
+     [0.0 0.81] (difference [1 0.9] [1 0.9])
+     [0.030000000000000006 0.552] (difference [0.1 0.92] [0.7 0.6])
+     [0.63 0.552] (difference [0.7 0.6] [0.1 0.92])))
+
+(deftest test-structual-intersection
+  (both-equal
+     [1.0 0.81] (structual-intersection [1 0.9] [1 0.9])
+     [1.0 0.27] (structual-intersection [1 0.9] [1 0.3])
+     [1.0 0.81] (structual-intersection [1 0.3] [1 0.9])))
+
+(deftest test-structual-deduction
+  (both-equal
+     [1.0 0.81] (structual-deduction [1 0.9] [1 0.9])
+     [0.4 0.09000000000000001] (structual-deduction [0.4 0.1] [1 0.9])
+     [1.0 0.54] (structual-deduction [1 0.6] [0.4 0.1])))
+
+(deftest test-structual-abduction
+  (both-equal
+     [1 0.44751381215469616] (structual-abduction [1 0.9] [1 0.9])
+     [0.7 0.15254237288135597] (structual-abduction [0.7 0.2] [1 0.9])
+     [1 0.44751381215469616] (structual-abduction [1 0.9] [0.7 0.2])))
+
+(deftest test-reduce-conjunction
+  (both-equal
+     [1.0 0.0] (reduce-conjunction [1 0.9] [1 0.9])
+     [0.7989999999999999 0.16281000000000004] (reduce-conjunction [0.7 0.9] [0.67 0.9])
+     [0.769 0.18710999999999997] (reduce-conjunction [0.67 0.9] [0.7 0.9])))
+
+(deftest test-t-identity
+  (both-equal
+     [1 0.6] (t-identity [1 0.6] [1 0.7])
+     [0.3 0.6] (t-identity [0.3 0.6] [0.1 0.8])
+     [0.3 0.6] (t-identity [0.3 0.6] nil)))
+
+(deftest test-belief-identity
+  (both-equal
+     [1 0.6] (belief-identity [1 0.6] [1 0.7])
+     [0.3 0.6] (belief-identity [0.3 0.6] [0.1 0.8]))
+  (is (nil? (belief-identity [0.3 0.6] nil))))
+
+(deftest test-belief-structural-deduction
+  (both-equal
+     [1.0 0.81] (belief-structural-deduction [1 0.9] [1 0.9])
+     [0.3 0.81] (belief-structural-deduction [1 0.6] [0.3 0.9])
+     [0.6 0.20700000000000002] (belief-structural-deduction [0.9 0.67] [0.6 0.23])))
+
+(deftest test-belief-structural-difference
+  (is (nil? (belief-structural-difference [1 0.9] nil)))
+  (both-equal
+     [0.5 0.27] (belief-structural-difference [0.9 0.9] [0.5 0.3])
+     [0.09999999999999998 0.81] (belief-structural-difference [0.5 0.3] [0.9 0.9])))
+
+(deftest test-belief-negation
+  (both-equal
+     [0.0 0.9] (belief-negation [1 0.9] [1 0.9])
+     [0.8 0.1] (belief-negation [0.3 0] [0.2 0.1])
+     [0.7 0.9] (belief-negation [0.2 0.1] [0.3 0.9])))

test/nal/test/nal1.clj

@@ -1,44 +0,0 @@
-(ns nal.test.nal1
-  (:refer-clojure :exclude [== reduce replace])
-  (:require [clojure.test :refer :all]
-            [nal.core :refer :all]
-            [clojure.core.logic :refer [run run*]]
-            [nal.test.test-utils :refer [trun*]]))
-
-(deftest test-revision
-  (trun* [[nil [0.8 0.8333333333333334]]]
-        [R] (revision [nil [1 0.8]] [nil [0 0.5]] R)))
-
-(deftest test-choice
-  (trun* [[nil [1 0.8]]]
-        [R] (choice [nil [1 0.8]] [nil [0 0.5]] R))
-  (trun* [[nil [0.8 0.9]]]
-        [R] (choice [nil [1 0.5]] [nil [0.8 0.9]] R)))
-
-(deftest test-inference-nal1
-  ;deduction
-  (trun* [[1 0.81]]
-        [q1] (inference ['(inheritance bird animal) [1 0.9]]
-                        ['(inheritance robin bird) [1 0.9]]
-                        ['(inheritance robin animal) q1]))
-  ;induction
-  (trun* [[1 0.44751381215469616]]
-        [q1] (inference ['(inheritance robin animal) [1 0.9]]
-                        ['(inheritance robin bird) [1 0.9]]
-                        ['(inheritance bird animal) q1]))
-  ;abduction
-  (trun* [[1 0.44751381215469616]]
-        [q1] (inference ['(inheritance bird animal) [1 0.9]]
-                        ['(inheritance robin animal) [1 0.9]]
-                        ['(inheritance robin bird) q1]))
-  ;examplification
-  (trun* [[1 0.44751381215469616]]
-        [q1] (inference ['(inheritance robin bird) [1 0.9]]
-                        ['(inheritance bird animal) [1 0.9]]
-                        ['(inheritance animal robin) q1]))
-  ;convension
-  (trun*
-    [[1 0.4186046511627907]]
-    [q]
-    (inference '((inheritance swan bird) [0.9 0.8]) 
-               ['(inheritance bird swan) q])))

test/nal/test/nal2.clj

@@ -1,70 +0,0 @@
-(ns nal.test.nal2
-  (:refer-clojure :exclude [== reduce replace])
-  (:require [clojure.test :refer :all]
-            [nal.core :refer :all]
-            [clojure.core.logic :refer [run run*]]
-            [nal.test.test-utils :refer [trun trun*]]))
-
-(deftest test-inference-nal2
-  ;inheritance to similarity
-  (trun* [[0.81 0.6400000000000001]]
-        [q]
-        (inference '((inheritance swan robin) [0.9 0.8])
-                   '((inheritance robin swan) [0.9 0.8])
-                   ['(similarity swan robin) q]))
-  ;comparison
-  (trun* [[1 0.44751381215469616]]
-        [q]
-        (inference ['(inheritance swan swimmer) [1 0.9]]
-                   ['(inheritance swan bird) [1 0.9]]
-                   ['(similarity bird swimmer) q]))
-  (trun* [[1 0.44751381215469616]]
-        [q]
-        (inference ['(inheritance sport competition) [1 0.9]]
-                   ['(inheritance chess competition) [1 0.9]]
-                   ['(similarity chess sport) q]))
-  ;analogy
-  (trun* [[0.9 0.7290000000000001]]
-        [q]
-        (inference ['(inheritance swan swimmer) [1 0.9]]
-                   ['(similarity gull swan) [0.9 0.9]]
-                   ['(inheritance gull swimmer) q]))
-  (trun* [[0.9 0.7290000000000001]]
-        [q]
-        (inference ['(inheritance chess competition) [1 0.9]]
-                   ['(similarity sport competition) [0.9 0.9]]
-                   ['(inheritance chess sport) q]))
-  ;resemblance
-  (trun* [[0.7200000000000001 0.7056000000000001]]
-        [q]
-        (inference ['(similarity swan robin) [0.8 0.9]]
-                   ['(similarity gull swan) [0.9 0.8]]
-                   ['(similarity gull robin) q]))
-  ;instance and property
-  (trun* '([[ext-set [tweety]] bird [1 0.9]])
-        [S P T] (inference ['(instance tweety bird) [1 0.9]]
-                           [['inheritance S P] T]))
-  (trun* '([raven [int-set [black]] [1 0.9]])
-        [S P T] (inference ['(property raven black) [1 0.9]]
-                           [['inheritance S P] T]))
-  (trun* '([[ext-set [tweety]] [int-set [yellow]] [1 0.9]])
-        [S P T] (inference ['(inst-prop tweety yellow) [1 0.9]]
-                           [['inheritance S P] T]))
-  ;set definition
-  (trun* '([[ext-set [tweety]] [ext-set [birdie]] [1 0.8]])
-        [S P T] (inference ['(inheritance (ext-set [tweety]) (ext-set [birdie]))
-                            [1 0.8]]
-                           [['similarity S P] T]))
-  (trun* '([[int-set [smart]] [int-set [bright]] [1 0.8]])
-        [S P T] (inference ['(inheritance (int-set [smart]) (int-set [bright]))
-                            [1 0.8]]
-                           [['similarity S P] T]))
-  ;structure transformation
-  (trun* [[1 0.9]]
-        [T]
-        (inference ['(similarity (ext-set [tweety]) (ext-set [birdie])) [1 0.9]]
-                   ['(similarity tweety birdie) T]))
-  (trun* [[0.8 0.9]]
-        [T]
-        (inference ['(similarity (ext-set [smart]) (ext-set [bright])) [0.8 0.9]]
-                   ['(similarity smart bright) T])))

test/nal/test/nal3.clj

@@ -1,226 +0,0 @@
-(ns nal.test.nal3
-  (:refer-clojure :exclude [== reduce replace])
-  (:require [clojure.test :refer :all]
-            [nal.core :refer :all]
-            [clojure.core.logic :refer [run run*]]
-            [nal.test.test-utils :refer [trun trun*]]))
-
-(deftest test-inference-nal3
-  ;compound construction, two premises
-  (trun* '([[inheritance bird swimmer] [0.9 0.3932038834951457]]
-            [[similarity bird swimmer] [0.7346938775510204 0.4425242501951166]]
-            [[inheritance swan [ext-intersection [swimmer bird]]]
-             [0.7200000000000001 0.81]]
-            [[inheritance swan [int-intersection [swimmer bird]]]
-             [0.9800000000000001 0.81]]
-            [[inheritance swan [ext-difference swimmer bird]]
-             [0.17999999999999997 0.81]]
-            [[implication [inheritance _0 bird] [inheritance _0 swimmer]]
-             [0.9 0.3932038834951457]]
-            [[conjunction
-              [[inheritance [var _0 []] bird] [inheritance [var _0 []] swimmer]]]
-             [0.7200000000000001 0.81]]
-            [[equivalence [inheritance _0 bird] [inheritance _0 swimmer]]
-             [0.7346938775510204 0.4425242501951166]])
-         [R]
-         (inference ['(inheritance swan swimmer) [0.9 0.9]]
-                    ['(inheritance swan bird) [0.8 0.9]] R))
-  (trun* '([[inheritance chess sport] [0.8 0.42163100057836905]]
-            [[similarity chess sport] [0.7346938775510204 0.4425242501951166]]
-            [[inheritance [int-intersection [sport chess]] competition]
-             [0.7200000000000001 0.81]]
-            [[inheritance [ext-intersection [sport chess]] competition]
-             [0.9800000000000001 0.81]]
-            [[inheritance [int-difference sport chess] competition]
-             [0.17999999999999997 0.81]]
-            [[implication [inheritance sport _0] [inheritance chess _0]]
-             [0.8 0.42163100057836905]]
-            [[conjunction
-              [[inheritance chess [var _0 []]] [inheritance sport [var _0 []]]]]
-             [0.7200000000000001 0.81]]
-            [[equivalence [inheritance sport _0] [inheritance chess _0]]
-             [0.7346938775510204 0.4425242501951166]])
-         [R]
-         (inference ['(inheritance sport competition) [0.9 0.9]]
-                    ['(inheritance chess competition) [0.8 0.9]] R))
-  ;compound construction, single premise
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(inheritance swan swimmer) [0.9 0.8]]
-                    ['(inheritance swan [ext-intersection [swimmer bird]]) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance swan swimmer) [0.9 0.8]]
-                    ['(inheritance swan (int-intersection [swimmer bird])) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(inheritance swan swimmer) [0.9 0.8]]
-                    ['(inheritance swan (ext-difference swimmer bird)) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance swan swimmer) [0.9 0.8]]
-                    ['(negation (inheritance swan (ext-difference bird swimmer))) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(inheritance sport competition) [0.9 0.8]]
-                    ['(inheritance (int-intersection [sport chess]) competition) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance sport competition) [0.9 0.8]]
-                    ['(inheritance (ext-intersection [sport chess]) competition) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(inheritance sport competition) [0.9 0.8]]
-                    ['(inheritance (int-difference sport chess) competition) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance sport competition) [0.9 0.8]]
-                    ['(negation (inheritance (int-difference chess sport) competition)) V]))
-  ;compound destruction, single premise
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance swan (ext-intersection [swimmer bird])) [0.9 0.8]]
-                    ['(inheritance swan swimmer) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(inheritance swan (int-intersection [swimmer bird])) [0.9 0.8]]
-                    ['(inheritance swan swimmer) V]))
-
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance swan (ext-difference swimmer bird)) [0.9 0.8]]
-                    ['(inheritance swan swimmer) V]))
-
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance swan (ext-difference swimmer bird)) [0.9 0.8]]
-                    ['(negation (inheritance swan bird)) V]))
-
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance (int-intersection [sport chess]) competition) [0.9 0.8]]
-                    ['(inheritance sport competition) V]))
-
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(inheritance (ext-intersection [sport chess]) competition) [0.9 0.8]]
-                    ['(inheritance sport competition) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance (int-difference sport chess) competition) [0.9 0.8]]
-                    ['(inheritance sport competition) V]))
-
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance (int-difference sport chess) competition) [0.9 0.8]]
-                    ['(negation (inheritance chess competition)) V]))
-  ;operation on both sides of a relation
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance bird animal) [0.9 0.8]]
-                    ['(inheritance (ext-intersection [swimmer bird])
-                                   (ext-intersection [swimmer animal])) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(inheritance (ext-intersection [swimmer bird])
-                                   (ext-intersection [swimmer animal])) [0.9 0.8]]
-                    ['(inheritance bird animal) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance bird animal) [0.9 0.8]]
-                    ['(inheritance (int-intersection [swimmer bird])
-                                   (int-intersection [swimmer animal])) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(inheritance (int-intersection [swimmer bird])
-                                   (int-intersection [swimmer animal])) [0.9 0.8]]
-                    ['(inheritance bird animal) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(similarity bird animal) [0.9 0.8]]
-                    ['(similarity (ext-intersection [swimmer bird])
-                                  (ext-intersection [swimmer animal])) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(similarity (ext-intersection [swimmer bird])
-                                  (ext-intersection [swimmer animal])) [0.9 0.8]]
-                    ['(similarity bird animal) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(similarity bird animal) [0.9 0.8]]
-                    ['(similarity (int-intersection [swimmer bird])
-                                  (int-intersection [swimmer animal])) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(similarity (int-intersection [swimmer bird])
-                                  (int-intersection [swimmer animal])) [0.9 0.8]]
-                    ['(similarity bird animal) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance bird animal) [0.9 0.8]]
-                    ['(inheritance (ext-difference bird swimmer)
-                                   (ext-difference animal swimmer)) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(inheritance (ext-difference bird swimmer)
-                                   (ext-difference animal swimmer)) [0.9 0.8]]
-                    ['(inheritance bird animal) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance bird animal) [0.9 0.8]]
-                    ['(inheritance (int-difference bird swimmer)
-                                   (int-difference animal swimmer)) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(inheritance (int-difference bird swimmer)
-                                   (int-difference animal swimmer)) [0.9 0.8]]
-                    ['(inheritance bird animal) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(similarity bird animal) [0.9 0.8]]
-                    ['(similarity (ext-difference bird swimmer)
-                                  (ext-difference animal swimmer)) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(similarity (ext-difference bird swimmer)
-                                  (ext-difference animal swimmer)) [0.9 0.8]]
-                    ['(similarity bird animal) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(similarity bird animal) [0.9 0.8]]
-                    ['(similarity (int-difference bird swimmer)
-                                  (int-difference animal swimmer)) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(similarity (int-difference bird swimmer)
-                                  (int-difference animal swimmer)) [0.9 0.8]]
-                    ['(similarity bird animal) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance bird animal) [0.9 0.8]]
-                    ['(inheritance (ext-difference swimmer animal)
-                                   (ext-difference swimmer bird)) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(inheritance (ext-difference swimmer animal)
-                                   (ext-difference swimmer bird)) [0.9 0.8]]
-                    ['(inheritance bird animal) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(inheritance bird animal) [0.9 0.8]]
-                    ['(inheritance (int-difference swimmer animal)
-                                   (int-difference swimmer bird)) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(inheritance (int-difference swimmer animal)
-                                   (int-difference swimmer bird)) [0.9 0.8]]
-                    ['(inheritance bird animal) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(similarity bird animal) [0.9 0.8]]
-                    ['(similarity (ext-difference swimmer animal)
-                                  (ext-difference swimmer bird)) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(similarity (ext-difference swimmer animal)
-                                  (ext-difference swimmer bird)) [0.9 0.8]]
-                    ['(similarity bird animal) V]))
-  (trun* [[0.9 0.7200000000000001]] [V]
-         (inference ['(similarity bird animal) [0.9 0.8]]
-                    ['(similarity (int-difference swimmer animal)
-                                  (int-difference swimmer bird)) V]))
-  (trun* [[0.9 0.4444444444444445]] [V]
-         (inference ['(similarity (int-difference swimmer animal)
-                                  (int-difference swimmer bird)) [0.9 0.8]]
-                    ['(similarity bird animal) V]))
-  ;set operations
-  (trun*
-    '([[inheritance (ext-set [pluto saturn]) (ext-set [venus mars pluto])] [0.9 0.3093922651933702]]
-       [[similarity (ext-set [pluto saturn]) (ext-set [venus mars pluto])] [0.6494845360824741 0.38302073050345514]]
-       [[inheritance (ext-set [earth]) [ext-set (pluto)]] [0.63 0.6400000000000001]]
-       [[inheritance (ext-set [earth]) [ext-set (venus mars pluto saturn)]] [0.9700000000000001 0.6400000000000001]]
-       [[inheritance (ext-set [earth]) [ext-set (venus mars)]] [0.2700000000000001 0.6400000000000001]]
-       [[implication [inheritance _0 (ext-set [pluto saturn])] [inheritance _0 (ext-set [venus mars pluto])]] [0.9 0.3093922651933702]]
-       [[conjunction [[inheritance [var _0 []] (ext-set [pluto saturn])] [inheritance [var _0 []] (ext-set [venus mars pluto])]]] [0.63 0.6400000000000001]]
-       [[equivalence [inheritance _0 (ext-set [pluto saturn])] [inheritance _0 (ext-set [venus mars pluto])]] [0.6494845360824741 0.38302073050345514]])
-    [R]
-    (inference ['(inheritance (ext-set [earth])
-                              (ext-set [venus mars pluto])) [0.9 0.8]]
-               ['(inheritance (ext-set [earth])
-                              (ext-set [pluto saturn])) [0.7 0.8]] R))
-  (trun*
-    '([[inheritance (int-set [purple green]) (int-set [red green blue])] [0.7 0.36548223350253817]]
-       [[similarity (int-set [purple green]) (int-set [red green blue])] [0.6494845360824741 0.38302073050345514]]
-       [[inheritance [int-set (green)] (int-set [colorful])] [0.63 0.6400000000000001]]
-       [[inheritance [int-set (red blue purple green)] (int-set [colorful])] [0.9700000000000001 0.6400000000000001]]
-       [[inheritance [int-set (red blue)] (int-set [colorful])] [0.2700000000000001 0.6400000000000001]]
-       [[implication [inheritance (int-set [red green blue]) _0] [inheritance (int-set [purple green]) _0]] [0.7 0.36548223350253817]]
-       [[conjunction [[inheritance (int-set [purple green]) [var _0 []]] [inheritance (int-set [red green blue]) [var _0 []]]]] [0.63 0.6400000000000001]]
-       [[equivalence [inheritance (int-set [red green blue]) _0] [inheritance (int-set [purple green]) _0]] [0.6494845360824741 0.38302073050345514]])
-    [R]
-    (inference ['(inheritance (int-set [red green blue]) (int-set [colorful]))
-                [0.9 0.8]]
-               ['(inheritance (int-set [purple green]) (int-set [colorful]))
-                [0.7 0.8]] R)))

test/nal/test/nal4.clj

@@ -1,100 +0,0 @@
-(ns nal.test.nal4
-  (:refer-clojure :exclude [== reduce replace])
-  (:require [clojure.test :refer :all]
-            [nal.core :refer :all]
-            [clojure.core.logic :refer [run run*]]
-            [nal.test.test-utils :refer [trun trun*]]))
-
-(deftest test-inference-nal4
-  ;extensional image
-  (trun*
-    '([[inheritance reaction (product [acid base])] [1 0.4736842105263158]]
-       [[inheritance acid [ext-image reaction (nil base)]] [1 0.9]]
-       [[inheritance base [ext-image reaction (acid nil)]] [1 0.9]])
-    [C]
-    (inference ['(inheritance (product [acid base]) reaction)
-                [1 0.9]] C))
-  (trun*
-    '([[inheritance (ext-image reaction [nil base]) acid] [1 0.4736842105263158]]
-       [[inheritance [product (acid base)] reaction] [1 0.9]])
-    [C]
-    (inference ['(inheritance acid (ext-image reaction [nil base]))
-                [1 0.9]] C))
-  (trun*
-    '([[inheritance (ext-image reaction [acid nil]) acid] [1 0.4736842105263158]]
-       [[inheritance [product (acid acid)] reaction] [1 0.9]])
-    [C]
-    (inference ['(inheritance acid (ext-image reaction [acid nil]))
-                [1 0.9]] C))
-  ;intensional image
-  (trun*
-    '([[inheritance (product [acid base]) neutralization] [1 0.4736842105263158]]
-       [[inheritance [int-image neutralization (nil base)] acid] [1 0.9]]
-       [[inheritance [int-image neutralization (acid nil)] base] [1 0.9]])
-    [C]
-    (inference ['(inheritance neutralization, (product [acid, base])),
-                [1, 0.9]], C))
-  (trun*
-    '([[inheritance acid (int-image neutralization [nil base])]
-       [1 0.4736842105263158]]
-       [[inheritance neutralization [product (acid base)]] [1 0.9]])
-    [C]
-    (inference ['(inheritance (int-image neutralization, [nil, base]), acid),
-                [1, 0.9]], C))
-  (trun*
-    '([[inheritance base (int-image neutralization [acid nil])]
-       [1 0.4736842105263158]]
-       [[inheritance neutralization [product (acid base)]] [1 0.9]])
-    [C]
-    (inference ['(inheritance (int-image neutralization, [acid, nil]), base),
-                [1, 0.9]], C))
-  ;operation on both sides of a relation
-  (trun* '([0.9 0.8] [0.9 0.8]) [V]
-         (inference ['(inheritance bird animal) [0.9 0.8]]
-                    ['(inheritance (product [bird plant])
-                                   (product [animal plant])) V]))
-
-  (trun* '([0.9 0.8] [0.9 0.8]) [V]
-         (inference ['(inheritance (product [plant bird]) (product [plant animal]))
-                     [0.9 0.8]]
-                    ['(inheritance bird animal) V]))
-
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(inheritance neutralization reaction) [0.9 0.8]]
-                    ['(inheritance (ext-image neutralization [acid nil])
-                                   (ext-image reaction [acid nil])) V]))
-
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(inheritance (ext-image neutralization [acid nil])
-                                   (ext-image reaction [acid nil])) [0.9 0.8]]
-                    ['(inheritance neutralization reaction) V]))
-
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(inheritance neutralization reaction) [0.9 0.8]]
-                    ['(inheritance (int-image neutralization [acid nil])
-                                   (int-image reaction [acid nil])) V]))
-
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(inheritance (int-image neutralization [acid nil])
-                                   (int-image reaction [acid nil])) [0.9 0.8]]
-                    ['(inheritance neutralization reaction) V]))
-
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(inheritance soda base) [0.9 0.8]]
-                    ['(inheritance (ext-image reaction [nil base])
-                                   (ext-image reaction [nil soda])) V]))
-
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(inheritance (ext-image reaction [nil base])
-                                   (ext-image reaction [nil soda])) [0.9 0.8]]
-                    ['(inheritance soda base) V]))
-
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(inheritance soda base) [0.9 0.8]]
-                    ['(inheritance (int-image neutralization [nil base])
-                                   (int-image neutralization [nil soda])) V]))
-
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(inheritance (int-image neutralization [nil base])
-                                   (int-image neutralization [nil soda])) [0.9 0.8]]
-                    ['(inheritance soda base) V])))

test/nal/test/nal5.clj

@@ -1,302 +0,0 @@
-(ns nal.test.nal5
-  (:refer-clojure :exclude [== reduce replace])
-  (:require [clojure.test :refer :all]
-            [nal.core :refer :all]
-            [clojure.core.logic :refer [run run*]]
-            [nal.test.test-utils :refer [trun trun*]]))
-
-(deftest test-inference-nal5
-  ;revision
-  (trun*
-    '([(implication (inheritance robin flyer) (inheritance robin bird))
-       [0.8 0.8333333333333334]])
-    [R]
-    (revision ['(implication (inheritance robin, flyer), (inheritance robin, bird)), [1, 0.8]],
-              ['(implication (inheritance robin, flyer), (inheritance robin, bird)), [0, 0.5]], R))
-  (trun*
-    '([(equivalence (inheritance robin flyer) inheritance (robin bird))
-       [0.8 0.8333333333333334]])
-    [R]
-    (revision ['(equivalence (inheritance robin, flyer), inheritance (robin, bird)), [1, 0.8]],
-              ['(equivalence (inheritance robin, flyer), inheritance (robin, bird)), [0, 0.5]], R))
-  ;choice
-  (trun*
-    '([(implication (inheritance robin flyer) (inheritance robin bird)) [1 0.8]])
-    [R]
-    (choice ['(implication (inheritance robin, flyer), (inheritance robin, bird)), [1, 0.8]],
-            ['(implication (inheritance robin, flyer), inheritance (robin, bird)), [0, 0.5]], R))
-  (trun*
-    '([(implication (inheritance robin flyer) (inheritance robin bird)) [0.8 0.9]])
-    [R]
-    (choice ['(implication (inheritance robin, flyer), (inheritance robin, bird)), [0.8, 0.9]],
-            ['(implication (inheritance robin, swimmer), (inheritance robin, bird)), [1, 0.5]], R))
-  ; deduction
-  (trun* '([[implication (inheritance robin flyer) (inheritance robin animal)]
-            [0.9 0.36000000000000004]])
-         [R]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]]
-                    ['(implication (inheritance robin flyer) (inheritance robin bird)) [1 0.5]] R))
-  (trun* '([[equivalence (inheritance robin flyer) (inheritance robin animal)]
-            [0.9 0.39999999999999997]])
-         [R]
-         (inference ['(equivalence (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]]
-                    ['(equivalence (inheritance robin flyer) (inheritance robin bird)) [1 0.5]] R))
-  ;induction
-  (trun* '([[implication (inheritance robin flyer) (inheritance robin animal)]
-            [0.9 0.28571428571428575]]
-            [[equivalence (inheritance robin flyer) (inheritance robin animal)]
-             [0.9000000000000001 0.2857142857142857]]
-            [[implication
-              (inheritance robin bird)
-              [conjunction [(inheritance robin animal) (inheritance robin flyer)]]]
-             [0.9 0.4]]
-            [[implication
-              (inheritance robin bird)
-              [disjunction [(inheritance robin animal) (inheritance robin flyer)]]]
-             [0.9999999999999999 0.4]])
-         [R]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]]
-                    ['(implication (inheritance robin bird) (inheritance robin flyer)) [1 0.5]] R))
-  ;abduction
-  (trun* '([[implication (inheritance robin flyer) (inheritance robin bird)]
-            [1 0.2647058823529412]]
-            [[equivalence (inheritance robin flyer) (inheritance robin bird)]
-             [0.9000000000000001 0.2857142857142857]]
-            [[implication
-              [disjunction [(inheritance robin bird) (inheritance robin flyer)]]
-              (inheritance robin animal)]
-             [0.9 0.4]]
-            [[implication
-              [conjunction [(inheritance robin bird) (inheritance robin flyer)]]
-              (inheritance robin animal)]
-             [0.9999999999999999 0.4]])
-         [R]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]]
-                    ['(implication (inheritance robin flyer) (inheritance robin animal)) [1 0.5]] R))
-  ;examplification
-  (trun* '([[implication (inheritance robin animal) (inheritance robin flyer)]
-            [1 0.2647058823529412]])
-         [R]
-         (inference ['(implication (inheritance robin flyer) (inheritance robin bird)) [0.9 0.8]]
-                    ['(implication (inheritance robin bird) (inheritance robin animal)) [1 0.5]] R))
-  ;convension NAL-5
-  (trun* '([[implication (inheritance robin animal) (inheritance robin flyer)]
-            [1 0.4186046511627907]])
-         [R]
-         (inference ['(implication (inheritance robin flyer) (inheritance robin animal))
-                     [0.9 0.8]] R))
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(equivalence (inheritance robin flyer) (inheritance robin bird)) [0.9 0.8]]
-                    ['(implication (inheritance robin flyer) (inheritance robin bird)) V]))
-  (trun* '([[equivalence (inheritance robin flyer) (inheritance robin bird)]
-            [0.81 0.6400000000000001]]) [R]
-         (inference ['(implication (inheritance robin flyer) (inheritance robin bird)) [0.9 0.8]]
-                    ['(implication (inheritance robin bird) (inheritance robin flyer)) [0.9 0.8]] R))
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(similarity swan bird) [0.9 0.8]] ['(inheritance swan bird) V]))
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(inheritance swan bird) [0.9 0.8]] ['(similarity swan bird) V]))
-  (trun* '([[similarity swan bird] [0.1 0.6400000000000001]]) [R]
-         (inference ['(inheritance swan bird) [1 0.8]] ['(inheritance bird swan) [0.1 0.8]] R))
-  ;comparison
-  (trun*
-    '([(inheritance robin flyer) (inheritance robin animal) [0.8181818181818182 0.3878550440744369]])
-    [A B V]
-    (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]]
-               ['(implication (inheritance robin bird) (inheritance robin flyer)) [0.9 0.8]]
-               [['equivalence A B] V]))
-  (trun*
-    '([(inheritance robin flyer) (inheritance robin bird) [0.8181818181818182 0.3878550440744369]])
-    [A B V]
-    (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]]
-               ['(implication (inheritance robin flyer) (inheritance robin animal)) [0.9 0.8]] [['equivalence A B] V]))
-  ; analogy
-  (trun* '([[implication (inheritance robin bird) (inheritance robin flyer)] [0.81 0.5760000000000001]]) [R]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]] ['(equivalence (inheritance robin flyer) (inheritance robin animal)) [0.9 0.8]] R))
-  (trun* '([[implication (inheritance robin flyer) (inheritance robin animal)] [0.81 0.5760000000000001]]) [R]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]] ['(equivalence (inheritance robin flyer) (inheritance robin bird)) [0.9 0.8]] R))
-  ; compound construction two premises
-  (trun* '([[implication (inheritance robin flyer) (inheritance robin animal)] [0.9 0.36548223350253817]]
-            [[equivalence (inheritance robin flyer) (inheritance robin animal)] [0.8181818181818182 0.3878550440744369]]
-            [[implication (inheritance robin bird) [conjunction [(inheritance robin animal) (inheritance robin flyer)]]] [0.81 0.6400000000000001]]
-            [[implication (inheritance robin bird) [disjunction [(inheritance robin animal) (inheritance robin flyer)]]] [0.99 0.6400000000000001]])
-         [R]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]] ['(implication (inheritance robin bird) (inheritance robin flyer)) [0.9 0.8]] R))
-  (trun* '([[implication (inheritance robin flyer) (inheritance robin bird)] [0.9 0.36548223350253817]]
-            [[equivalence (inheritance robin flyer) (inheritance robin bird)] [0.8181818181818182 0.3878550440744369]]
-            [[implication [disjunction [(inheritance robin bird) (inheritance robin flyer)]] (inheritance robin animal)] [0.81 0.6400000000000001]]
-            [[implication [conjunction [(inheritance robin bird) (inheritance robin flyer)]] (inheritance robin animal)] [0.99 0.6400000000000001]])
-         [R]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]]
-                    ['(implication (inheritance robin flyer) (inheritance robin animal)) [0.9 0.8]] R))
-  (trun* '([0.81 0.81]) [V]
-         (inference ['(inheritance robin animal) [0.9 0.9]] ['(inheritance robin flyer) [0.9 0.9]]
-                    ['(conjunction [(inheritance robin animal) (inheritance robin flyer)]) V]))
-  (trun* '([0.99 0.6400000000000001]) [V]
-         (inference ['(inheritance robin animal) [0.9 0.8]] ['(inheritance robin flyer) [0.9 0.8]]
-                    ['(disjunction [(inheritance robin animal) (inheritance robin flyer)]) V]))
-  ; compound construction single premise
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]]
-                    ['(implication (inheritance robin bird) (conjunction [(inheritance robin animal) (inheritance robin flyer)])) V]))
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]]
-                    ['(implication (inheritance robin bird) (disjunction [(inheritance robin animal) (inheritance robin flyer)])) V]))
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]]
-                    ['(implication (disjunction [(inheritance robin bird) (inheritance robin flyer)]) (inheritance robin animal)) V]))
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]]
-                    ['(implication (conjunction [(inheritance robin bird) (inheritance robin flyer)]) (inheritance robin animal)) V]))
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(inheritance robin animal) [0.9 0.8]] ['(conjunction [(inheritance robin animal) (inheritance robin flyer)]) V]))
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(inheritance robin animal) [0.9 0.8]] ['(disjunction [(inheritance robin animal) (inheritance robin flyer)]) V]))
-  ; compound destruction two premises
-  (trun* '([0 0.6400000000000001]) [T]
-         (inference ['(implication (inheritance robin bird) (inheritance robin flyer)) [1 0.8]]
-                    ['(implication (inheritance robin bird) (conjunction [(inheritance robin animal) (inheritance robin flyer)])) [0 0.8]]
-                    ['(implication (inheritance robin bird) (inheritance robin animal)) T]))
-  (trun* '([1 0.6400000000000001]) [T]
-         (inference ['(implication (inheritance robin bird) (inheritance robin flyer)) [0 0.8]]
-                    ['(implication (inheritance robin bird) (disjunction [(inheritance robin animal) (inheritance robin flyer)])) [1 0.8]]
-                    ['(implication (inheritance robin bird) (inheritance robin animal)) T]))
-  (trun* '([0 0.6400000000000001]) [T]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [1 0.8]]
-                    ['(implication (disjunction [(inheritance robin bird) (inheritance robin flyer)]) (inheritance robin animal)) [0 0.8]]
-                    ['(implication (inheritance robin flyer) (inheritance robin animal)) T]))
-  (trun* '([1 0.6400000000000001]) [T]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0 0.8]]
-                    ['(implication (conjunction [(inheritance robin bird) (inheritance robin flyer)]) (inheritance robin animal)) [1 0.8]]
-                    ['(implication (inheritance robin flyer) (inheritance robin animal)) T]))
-  (trun* '([(inheritance robin flyer) [0 0.6400000000000001]])
-         [R]
-         (inference ['(inheritance robin bird) [1 0.8]]
-                    ['(conjunction [(inheritance robin bird) (inheritance robin flyer)]) [0 0.8]] R))
-  (trun* '([(inheritance robin flyer) [1 0.6400000000000001]])
-         [R]
-         (inference ['(inheritance robin bird) [0 0.8]]
-                    ['(disjunction [(inheritance robin bird) (inheritance robin flyer)]) [1 0.8]] R))
-
-  ; compound destruction single premise
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(implication (inheritance robin bird) (conjunction [(inheritance robin animal) (inheritance robin flyer)])) [0.9 0.8]]
-                    ['(implication (inheritance robin bird) (inheritance robin animal)) V]))
-
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(implication (inheritance robin bird) (disjunction [(inheritance robin animal) (inheritance robin flyer)])) [0.9 0.8]]
-                    ['(implication (inheritance robin bird) (inheritance robin animal)) V]))
-
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(implication (disjunction [(inheritance robin bird) (inheritance robin flyer)]) (inheritance robin animal)) [0.9 0.8]]
-                    ['(implication (inheritance robin bird) (inheritance robin animal)) V]))
-
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(implication (conjunction [(inheritance robin bird) (inheritance robin flyer)]) (inheritance robin animal)) [0.9 0.8]]
-                    ['(implication (inheritance robin bird) (inheritance robin animal)) V]))
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(conjunction [(inheritance robin bird) (inheritance robin flyer)]) [0.9 0.8]] ['(inheritance robin bird) V]))
-
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(disjunction [(inheritance robin bird) (inheritance robin flyer)]) [0.9 0.8]] ['(inheritance robin bird) V]))
-
-  ; operation on both sides of a relation
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(implication p q) [0.9 0.8]] ['(implication (conjunction [p r]) (conjunction [q r])) V]))
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(implication (conjunction [p r]) (conjunction [q r])) [0.9 0.8]] ['(implication p q) V]))
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(implication p q) [0.9 0.8]] ['(implication (disjunction [p r]) (disjunction [q r])) V]))
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(implication (disjunction [p r]) (disjunction [q r])) [0.9 0.8]] ['(implication p q) V]))
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(equivalence p q) [0.9 0.8]] ['(equivalence (conjunction [p r]) (conjunction [q r])) V]))
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(equivalence (conjunction [p r]) (conjunction [q r])) [0.9 0.8]] ['(equivalence p q) V]))
-  (trun* '([0.9 0.7200000000000001]) [V]
-         (inference ['(equivalence p q) [0.9 0.8]] ['(equivalence (disjunction [p r]) (disjunction [q r])) V]))
-  (trun* '([0.9 0.4444444444444445]) [V]
-         (inference ['(equivalence (disjunction [p r]) (disjunction [q r])) [0.9 0.8]] ['(equivalence p q) V]))
-  ; negation
-  (trun* '([(inheritance robin bird) [0.09999999999999998 0.8]]) [R]
-         (inference ['(negation (inheritance robin bird)) [0.9 0.8]] R))
-  (trun* '([0.8 0.8]) [T]
-         (inference ['(inheritance robin bird) [0.2 0.8]]
-                    ['(negation (inheritance robin bird)) T]))
-  (trun* '([0 0.4186046511627907]) [T]
-         (inference ['(implication (negation (inheritance penguin flyer)) (inheritance penguin swimmer)) [0.1 0.8]]
-                    ['(implication (negation (inheritance penguin swimmer)) (inheritance penguin flyer)) T]))
-  ; conditional inference
-  (trun* '([(inheritance robin animal) [0.9 0.36000000000000004]]) [R]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]]
-                    ['(inheritance robin bird) [1 0.5]] R))
-
-  (trun* '([(inheritance robin bird) [1 0.2647058823529412]]) [R]
-         (inference ['(implication (inheritance robin bird) (inheritance robin animal)) [0.9 0.8]]
-                    ['(inheritance robin animal) [1 0.5]] R))
-
-  (trun* '([0.9 0.28571428571428575]
-            [0.9 0.28571428571428575]) [V]
-         (inference ['(inheritance robin animal) [0.9 0.8]]
-                    ['(inheritance robin flyer) [1 0.5]]
-                    ['(implication (inheritance robin flyer) (inheritance robin animal)) V]))
-
-  (trun* '([(inheritance robin flyer) [0.9 0.36000000000000004]]) [R]
-         (inference ['(inheritance robin animal) [1 0.5]]
-                    ['(equivalence (inheritance robin flyer) (inheritance robin animal)) [0.9 0.8]] R))
-
-  (trun* '([0.9000000000000001 0.2857142857142857]
-            [0.9000000000000001 0.2857142857142857]) [V]
-         (inference ['(inheritance robin animal) [0.9 0.8]]
-                    ['(inheritance robin flyer) [1 0.5]]
-                    ['(equivalence (inheritance robin flyer) (inheritance robin animal)) V]))
-
-  (trun* '([[implication [conjunction (a1 a3)] c] [0.81 0.6561000000000001]]) [R]
-         (inference ['(implication (conjunction [a1 a2 a3]) c) [0.9 0.9]] ['a2 [0.9 0.9]] R))
-
-  (trun* '([0.9 0.42163100057836905]) [V]
-         (inference ['(implication (conjunction [a1 a2 a3]) c) [0.9 0.9]]
-                    ['(implication (conjunction [a1 a3]) c) [0.9 0.9]] ['a2 V]))
-
-  (trun* '([0.9 0.42163100057836905]) [V]
-         (inference ['(implication (conjunction [a1 a3]) c) [0.9 0.9]] ['a2 [0.9 0.9]]
-                    ['(implication (conjunction [a2 a1 a3]) c) V]))
-
-  (trun* '([[implication [conjunction (a1 b2 a3)] c]
-            [0.81 0.6561000000000001]]) [R]
-         (inference ['(implication (conjunction [a1 a2 a3]) c) [0.9 0.9]]
-                    ['(implication b2 a2) [0.9 0.9]] R))
-  (trun* '([0.9 0.42163100057836905]) [V]
-         (inference ['(implication (conjunction [a1 a2 a3]) c) [0.9 0.9]]
-                    ['(implication (conjunction [a1 b2 a3]) c) [0.9 0.9]]
-                    ['(implication b2 a2) V]))
-  (trun* '([[implication [conjunction (a1 a2 a3)] c] [0.9 0.42163100057836905]]) [R]
-         (inference ['(implication (conjunction [a1 b2 a3]) c) [0.9 0.9]]
-                    ['(implication b2 a2) [0.9 0.9]] R)))
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

test/nal/test/nal6.clj

@@ -1,134 +0,0 @@
-(ns nal.test.nal6
-  (:refer-clojure :exclude [== reduce replace])
-  (:require [clojure.test :refer :all]
-            [nal.core :refer :all]
-            [clojure.core.logic :refer [run run* fresh]]
-            [nal.test.test-utils :refer [trun trun*]]))
-
-(deftest test-inference-nal6
-  ; variable unification
-  (trun* '([[implication [inheritance _0 bird] [inheritance _0 flyer]] [0.9200000000000002 0.8333333333333334]])
-         [R]
-         (fresh [X Y]
-           (revision [['implication ['inheritance X 'bird] ['inheritance X 'flyer]] [0.9 0.8]] [['implication ['inheritance Y 'bird] ['inheritance Y 'flyer]] [1 0.5]] R)))
-  (trun* '([[implication [inheritance _0 robin] [inheritance _0 animal]] [1 0.81]])
-         [R]
-         (fresh [X Y]
-           (inference [['implication ['inheritance X 'bird] ['inheritance X 'animal]] [1 0.9]] [['implication ['inheritance Y 'robin] ['inheritance Y 'bird]] [1 0.9]] R)))
-  (trun* '([[implication [inheritance _0 robin] [inheritance _0 bird]] [1 0.44751381215469616]]
-            [[equivalence [inheritance _0 robin] [inheritance _0 bird]] [1 0.44751381215469616]]
-            [[implication [disjunction [[inheritance _0 bird] [inheritance _0 robin]]] [inheritance _0 animal]] [1 0.81]]
-            [[implication [conjunction [[inheritance _0 bird] [inheritance _0 robin]]] [inheritance _0 animal]] [1 0.81]])
-         [R]
-         (fresh [X Y]
-           (inference [['implication ['inheritance X 'bird] ['inheritance X 'animal]] [1 0.9]] [['implication ['inheritance Y 'robin] ['inheritance Y 'animal]] [1 0.9]] R)))
-  (trun* '([[implication [inheritance _0 bird] [inheritance _0 animal]] [1 0.44751381215469616]]
-            [[equivalence [inheritance _0 bird] [inheritance _0 animal]] [1 0.44751381215469616]]
-            [[implication [inheritance _0 robin] [conjunction [[inheritance _0 animal] [inheritance _0 bird]]]] [1 0.81]]
-            [[implication [inheritance _0 robin] [disjunction [[inheritance _0 animal] [inheritance _0 bird]]]] [1 0.81]])
-         [R]
-         (fresh [X Y]
-           (inference [['implication ['inheritance X 'robin] ['inheritance X 'animal]] [1 0.9]] [['implication ['inheritance Y 'robin] ['inheritance Y 'bird]] [1 0.9]] R)))
-  (trun* '([[implication [inheritance _0 feathered] [inheritance _0 flyer]] [1 0.81]])
-         [R]
-         (fresh [X Y]
-           (inference [['implication ['inheritance X 'feathered] ['inheritance X 'bird]] [1 0.9]] [['equivalence ['inheritance Y 'flyer] ['inheritance Y 'bird]] [1 0.9]] R)))
-  (trun* '([[implication [inheritance _0 bird] [inheritance _0 flyer]] [1 0.44751381215469616]]
-            [[equivalence [inheritance _0 bird] [inheritance _0 flyer]] [1 0.44751381215469616]]
-            [[implication [inheritance _0 feathered] [conjunction [[inheritance _0 flyer] [inheritance _0 bird]]]] [1 0.81]]
-            [[implication [inheritance _0 feathered] [disjunction [[inheritance _0 flyer] [inheritance _0 bird]]]] [1 0.81]])
-         [R]
-         (fresh [X Y]
-           (inference [['implication ['inheritance X 'feathered] ['inheritance X 'flyer]] [1 0.9]] [['implication ['inheritance Y 'feathered] ['inheritance Y 'bird]] [1 0.9]] R)))
-  (trun* '([[implication [conjunction ([inheritance _0 swimmer] [inheritance _0 flyer])] [inheritance _0 bird]] [1 0.81]])
-         [R]
-         (fresh [X Y]
-           (inference [['implication ['conjunction [['inheritance X 'feathered] ['inheritance X 'flyer]]] ['inheritance X 'bird]] [1 0.9]] [['implication ['inheritance Y 'swimmer] ['inheritance Y 'feathered]] [1 0.9]] R)))
-  (trun* '([[implication [conjunction [[inheritance _0 swimmer] [inheritance _0 flyer]]] [conjunction [[inheritance _0 feathered] [inheritance _0 flyer]]]] [1 0.44751381215469616]]
-            [[equivalence [conjunction [[inheritance _0 swimmer] [inheritance _0 flyer]]] [conjunction [[inheritance _0 feathered] [inheritance _0 flyer]]]] [1 0.44751381215469616]]
-            [[implication [disjunction [[conjunction [[inheritance _0 feathered] [inheritance _0 flyer]]] [conjunction [[inheritance _0 swimmer] [inheritance _0 flyer]]]]] [inheritance _0 bird]] [1 0.81]]
-            [[implication [conjunction ([inheritance _0 feathered] [inheritance _0 swimmer] [inheritance _0 flyer])] [inheritance _0 bird]] [1 0.81]]
-            [[implication [inheritance _0 swimmer] [inheritance _0 feathered]] [1 0.44751381215469616]])
-         [R]
-         (fresh [X Y]
-           (inference [['implication ['conjunction [['inheritance X 'feathered] ['inheritance X 'flyer]]] ['inheritance X 'bird]] [1 0.9]] [['implication ['conjunction [['inheritance X 'swimmer] ['inheritance X 'flyer]]] ['inheritance X 'bird]] [1 0.9]] R)))
-  (trun* '([[implication [conjunction ([inheritance _0 feathered] [inheritance _0 flyer])] [inheritance _0 bird]] [1 0.44751381215469616]])
-         [R]
-         (fresh [X Y]
-           (inference [['implication ['conjunction [['inheritance X 'swimmer] ['inheritance X 'flyer]]] ['inheritance X 'bird]] [1 0.9]] [['implication ['inheritance Y 'swimmer] ['inheritance Y 'feathered]] [1 0.9]] R)))
-  (trun* '([[implication [conjunction ([inheritance _0 swimmer] [inheritance _0 flyer])] [inheritance _0 bird]] [1 0.81]])
-         [R]
-         (fresh [X Y]
-           (inference [['implication ['conjunction [['inheritance X 'feathered] ['inheritance X 'flyer]]] ['inheritance X 'bird]] [1 0.9]] [['implication ['inheritance Y 'swimmer] ['inheritance Y 'feathered]] [1 0.9]] R)))
-  ; variable elimination
-  (trun* '([[inheritance robin animal] [1 0.81]])
-         [R]
-         (fresh [X Y]
-           (inference [['implication ['inheritance X 'bird] ['inheritance X 'animal]] [1 0.9]] [['inheritance 'robin 'bird] [1 0.9]] R)))
-  (trun* '([[inheritance robin bird] [1 0.44751381215469616]])
-         [R]
-         (fresh [X Y]
-           (inference [['implication ['inheritance X 'bird] ['inheritance X 'animal]] [1 0.9]] [['inheritance 'robin 'animal] [1 0.9]] R)))
-  (trun* '([[inheritance robin bird] [1 0.81]])
-         [R]
-         (fresh [X Y]
-           (inference [['inheritance 'robin 'animal] [1 0.9]] [['equivalence ['inheritance X 'bird] ['inheritance X 'animal]] [1 0.9]] R)))
-  (trun* '([[implication [inheritance swan flyer] [inheritance swan bird]] [1 0.81]]) [R]
-         (fresh [X Y]
-           (inference [['implication ['conjunction [['inheritance X 'feathered] ['inheritance X 'flyer]]] ['inheritance X 'bird]] [1 0.9]]
-                      [['inheritance 'swan 'feathered] [1 0.9]] R)))
-  (trun* '([1 0.42631578947368426]) [V]
-         (fresh [X Y]
-           (inference [['conjunction [['inheritance ['var X []] 'bird] ['inheritance ['var X []] 'swimmer]]] [1 0.9]] [['inheritance 'swan 'bird] [1 0.9]] [['inheritance 'swan 'swimmer] V])))
-
-  (trun* '([[conjunction ([inheritance swan [var _0 []]] [inheritance [var _1 []] [var _0 []]] [inheritance [var _1 []] flyer] [inheritance [var _1 []] swimmer])] [1 0.81]]
-            [[implication [inheritance swan _0] [conjunction ([inheritance [var _1 (_0)] _0] (inheritance [var _1 (_0)] flyer) (inheritance [var _1 (_0)] swimmer))]] [1 0.44751381215469616]]
-            [[conjunction ([inheritance swan flyer] [inheritance swan swimmer])] [1 0.42631578947368426]])
-         [R]
-         (fresh [X Y]
-           (inference [['conjunction [['inheritance ['var X []] 'flyer] ['inheritance ['var X []] 'bird] ['inheritance ['var X []] 'swimmer]]] [1 0.9]] [['inheritance 'swan 'bird] [1 0.9]] R)))
-  ; variable introduction
-  (trun* '([[inheritance bird animal] [1 0.44751381215469616]]
-            [[similarity bird animal] [1 0.44751381215469616]]
-            [[inheritance robin [ext-intersection [animal bird]]] [1 0.81]]
-            [[inheritance robin [int-intersection [animal bird]]] [1 0.81]]
-            [[inheritance robin [ext-difference animal bird]] [0 0.81]]
-            [[implication [inheritance _0 bird] [inheritance _0 animal]] [1 0.44751381215469616]]
-            [[conjunction [[inheritance [var _0 []] bird] [inheritance [var _0 []] animal]]] [1 0.81]]
-            [[equivalence [inheritance _0 bird] [inheritance _0 animal]] [1 0.44751381215469616]])
-         [R]
-         (fresh [X Y]
-           (inference [['inheritance 'robin 'animal] [1 0.9]] [['inheritance 'robin 'bird] [1 0.9]] R)))
-  (trun* '([[inheritance chess sport] [1 0.44751381215469616]]
-            [[similarity chess sport] [1 0.44751381215469616]]
-            [[inheritance [int-intersection [sport chess]] competition] [1 0.81]]
-            [[inheritance [ext-intersection [sport chess]] competition] [1 0.81]]
-            [[inheritance [int-difference sport chess] competition] [0 0.81]]
-            [[implication [inheritance sport _0] [inheritance chess _0]] [1 0.44751381215469616]]
-            [[conjunction [[inheritance chess [var _0 []]] [inheritance sport [var _0 []]]]] [1 0.81]]
-            [[equivalence [inheritance sport _0] [inheritance chess _0]] [1 0.44751381215469616]])
-         [R]
-         (fresh [X Y]
-           (inference [['inheritance 'sport 'competition] [1 0.9]] [['inheritance 'chess 'competition] [1 0.9]] R)))
-  ; multiple variables
-  (trun* '([[inheritance key [ext-image open [nil lock1]]] [1 0.44751381215469616]]
-            [[similarity key [ext-image open [nil lock1]]] [1 0.44751381215469616]]
-            [[inheritance key1 [ext-intersection [[ext-image open [nil lock1]] key]]] [1 0.81]]
-            [[inheritance key1 [int-intersection [[ext-image open [nil lock1]] key]]] [1 0.81]]
-            [[inheritance key1 [ext-difference [ext-image open [nil lock1]] key]] [0 0.81]]
-            [[implication [inheritance _0 key] [inheritance _0 [ext-image open [nil lock1]]]] [1 0.44751381215469616]]
-            [[conjunction [[inheritance [var _0 []] key] [inheritance [var _0 []] [ext-image open [nil lock1]]]]] [1 0.81]]
-            [[equivalence [inheritance _0 key] [inheritance _0 [ext-image open [nil lock1]]]] [1 0.44751381215469616]])
-         [R]
-         (fresh [X Y]
-           (inference [['inheritance 'key1 ['ext-image 'open [nil 'lock1]]] [1 0.9]] [['inheritance 'key1 'key] [1 0.9]] R)))
-  (trun* '([[implication [conjunction [[inheritance _0 key] [inheritance _1 lock]]] [inheritance _1 [ext-image open [_0 nil]]]] [1 0.44751381215469616]]
-            [[conjunction [[implication [inheritance _0 key] [inheritance [var _1 []] [ext-image open [_0 nil]]]] [inheritance [var _1 []] lock]]] [1 0.81]])
-         [R]
-         (fresh [X Y]
-           (inference [['implication ['inheritance X 'key] ['inheritance 'lock1 ['ext-image 'open [X nil]]]] [1 0.9]] [['inheritance 'lock1 'lock] [1 0.9]] R)))
-  (trun* '([[conjunction ([inheritance [var _0 []] lock] [inheritance [var _0 []] [ext-image open [[var _1 []] nil]]] [inheritance [var _1 []] key])] [1 0.81]]
-            [[implication [inheritance _0 lock] [conjunction ([inheritance _0 (ext-image open ([var _1 (_0)] nil))] (inheritance [var _1 (_0)] key))]] [1 0.44751381215469616]])
-         [R]
-         (fresh [X Y]
-           (inference [['conjunction [['inheritance ['var X []] 'key] ['inheritance 'lock1 ['ext-image 'open [['var X []] nil]]]]] [1 0.9]] [['inheritance 'lock1 'lock] [1 0.9]] R))))

test/nal/test/reader.clj

@@ -0,0 +1,40 @@
+(ns nal.test.reader
+  (:require [nal.reader :refer :all]
+            [clojure.test :refer :all]
+            [nal.test.test-utils :refer [both-equal]]))
+
+(deftest test-replacements
+  (are [s1 s2] (= s1 (replacements s2))
+    "(ext-set a b)" "{a b}"
+    "(int-set a b)" "[a b]"
+    "(retro-impl a b)" "(=\\> a b)"
+    "(pred-impl a b)" "(=/> a b)"
+    "(a int-dif b)" "(a ~ b)"
+    "(seq-conj  a b c)" "(&/ a b c)"
+    "(ext-inter a b)" "(& a b)"
+    "(a ext-inter b)" "(a & b)"
+    "(conj a b)" "(&& a b)"
+    "(inst a b)" "({-- a b)"
+    "(prop a b)" "(--] a b)"
+    "(prop a (int-set b v))" "(--] a [b v])"
+    "(inst-prop a b)" "({-] a b)"
+    "(int-image a b)" "(\\ a b)"
+    "(ext-image a b)" "(/ a b)"
+    "(ind-var X)" "$X"
+    "(dep-var X)" "#X"))
+
+(deftest test-read-rule
+  (are [l s] (= l (read-rule s))
+    '[A --> B] "A --> B"
+    '[(A --> (int-set D C)) (A int-dif B)] "(A --> [D C]) (A ~ B)"
+    '[A --> B] "A --> B"
+
+    '[((int-set A) <-> (int-set B)) (A <-> B) |- ((int-set A) <-> (int-set B))
+      :pre (:question?)
+      :post (:t/belief-identity :p/judgment)]
+    "([A] <-> [B]) (A <-> B) |- ([A] <-> [B]) :pre (:question?) :post (:t/belief-identity :p/judgment)"
+
+    '[(M retro-impl P) (M retro-impl S) |- ((M retro-impl (P &| S)) :post (:t/intersection)
+                                             (M retro-impl (P || S)) :post (:t/union))
+      :pre ((:!= S P))]
+    "(M =\\> P) (M =\\> S) |- ((M =\\> (P &| S)) :post (:t/intersection) (M =\\> (P || S)) :post (:t/union)) :pre ((:!= S P))"))

test/nal/test/test_utils.clj

@@ -1,9 +1,5 @@
 (ns nal.test.test-utils
-  (:require [clojure.test :refer [is]]
-            [clojure.core.logic :refer [run run*]]))
+  (:require [clojure.test :refer [is are]]))
 
-(defmacro trun [result lvars & body]
-  `(is (= ~result (run 1 ~lvars ~@body))))
-
-(defmacro trun* [result lvars & body]
-  `(is (= ~result (run* ~lvars ~@body))))
+(defmacro both-equal [& body]
+  `(are [arg1# arg2#] (= arg1# arg2#) ~@body))

test/nal/test/truth_value.clj

@@ -1,69 +0,0 @@
-(ns nal.test.truth-value
-  (:refer-clojure :exclude [== reduce replace])
-  (:require [clojure.test :refer :all]
-            [nal.truth-value :refer :all]
-            [clojure.core.logic :refer [run run*]]))
-
-(deftest test-f-rev
-         (is (= '([1.3 0.588235294117647])
-                (run* [q] (f-rev [1 0.5] [2 0.3] q))))
-         (is (= '()
-                (run* [q] (f-rev [1 2] [2 0.6] q))))
-         (is (= '([1.0138248847926268 0.9601769911504424])
-                (run* [q] (f-rev [4 0.1] [1 0.96] q)))))
-
-(deftest test-f-exp
-         (is (= '(2.75) (run* [Q] (f-exp [1.4, 2.5], Q))))
-         (is (= '(9.5) (run* [Q] (f-exp [2, 6], Q)))))
-
-(deftest test-f-neg
-         (is '([0 2]) (run* [q] (f-neg [1 2] q))))
-
-(deftest test-f-cnv
-         (is '([1 2/3]) (run* [Q] (f-cnv [1 2] Q))))
-
-(deftest test-f-cnt
-         (is '([0 10/9]) (run* [q] (f-cnt [3 5] q))))
-
-(deftest test-f-ded
-         (is '([3 24]) (run* [q] (f-ded [1 2] [3 4] q))))
-
-(deftest test-f-ana
-         (is '([18 210]) (run* [q] (f-ana [3 5] [6 7] q))))
-
-(deftest test-f-res
-         (is '([7 32]) (run* [q] (f-res [7 8] [1 4] q))))
-
-(deftest test-f-abd
-         (is '([3 8/9]) (run* [q] (f-abd [1 2] [3 4] q))))
-
-(deftest test-f-ind
-         (is '([3 42/43]) (run* [q] (f-ind [3, 6], [1, 7], q))))
-
-(deftest test-f-exe
-         (is '([1 126/127]) (run* [q] (f-exe [3, 6], [1, 7], q))))
-
-(deftest test-f-com
-         (is '() (run* [q] (f-com [7 2] [5 4] q)))
-         (is '([5 8/9]) (run* [q] (f-com [1, 2], [5, 4] q))))
-
-(deftest test-f-int
-         (is '([5 8]) (run* [q] (f-int [1 2] [5 4] q))))
-
-(deftest test-f-uni
-         (is '([-9 16]) (run* [Q] (f-uni [3, 4], [6, 4], Q))))
-
-(deftest test-f-dif
-         (is '([-15 16]) (run* [Q] (f-dif [3, 4], [6, 4], Q))))
-
-(deftest test-f-pnn
-         (is '([-5 12]) (run* [Q] (f-dif [1, 6], [6, 2], Q))))
-
-(deftest test-f-npp
-         (is '([-5 -10]) (run* [Q] (f-npp [2, 1], [5, 2], Q))))
-
-(deftest test-f-pnp
-         (is '([-1 -10]) (run* [Q] (f-pnp [1, 5], [2, 2], Q))))
-
-(deftest test-f-nnn
-         (is '([3 -6]) (run* [Q] (f-pnp [-3, 2], [2, -1], Q))))

test/nal/test/utils.clj

@@ -1,22 +0,0 @@
-(ns nal.test.utils
-  (:refer-clojure :exclude [== reduce replace])
-  (:require [clojure.test :refer :all]
-            [nal.utils :refer :all]
-            [clojure.core.logic :refer [run run*]]))
-
-(deftest test-u-not
-  (is (= '(-2) (run* [q] (u-not 3 q)))))
-
-(deftest test-u-and
-  (is (= '(6) (run* [q] (u-and [1 2 3] q))))
-  (is (= '(1) (run* [q] (u-and [1] q)))))
-
-(deftest test-u-or
-  (is (= '(1) (run* [q] (u-or [7 1] q)))))
-
-(deftest test-u-w2c
-  (is (= '(3/4) (run* [q] (u-w2c 3 q)))))
-
-(deftest test-subtract
-  (is (= '([2 4]) (run* [q] (subtracto [1 1 2 3 4] [1 3 5] q))))
-  (is (= '([]) (run* [q] (subtracto [] [] q)))))

test/narjure/test/control/general_inference.clj

@@ -0,0 +1,88 @@
+(ns narjure.test.control.general-inference
+  (:require [aero.core :refer [read-config]]
+            [clojure.test :refer [deftest is]]
+            [com.stuartsierra.component :as component]
+            [onyx api
+             [test-helper :refer [with-test-env]]]
+            [narjure.control.general-inference :as gi]
+            [narjure.system :refer [mem]]
+            [narjure.memory.api :as m]
+            [taoensso.carmine :refer [wcar] :as c]
+            [narjure.test.control.utils :refer [mock-kafka rand-id
+                                                take-values-from-topic]]))
+
+(defn load-redis-data
+  []
+  (wcar {} (c/flushall))
+  (let [concept1 '[--> P S]
+        concept2 '[--> K P]]
+    (m/add-term mem concept1)
+    (let [task {:task-type    :goal
+                :occurrence   1
+                :plausibility 1
+                :desirability 0.9
+                :statement    concept1}
+          task-id (m/add-task mem task)
+          tasklink {:priority   1
+                    :durability 1
+                    :quality    1
+                    :task       task-id}]
+      (m/add-tasklink mem concept1 tasklink "goal"))
+
+    (m/add-term mem concept2)
+    (m/add-termlink mem concept1 {:priority   1
+                                  :durability 1
+                                  :quality    1
+                                  :concept    (hash concept2)})
+
+    (let [task {:frequency  1
+                :confidence 0.9
+                :occurrence 0
+                :statement  concept2}
+          task-id (m/add-task mem task)
+          tasklink {:priority   1
+                    :durability 1
+                    :quality    1
+                    :task       task-id}]
+      (m/add-tasklink mem concept2 tasklink "belief"))))
+
+(def input
+  (let [concept-hash (hash '[--> P S])]
+    [{:question-with-query-var true
+      :concept                 concept-hash}
+     {:concept concept-hash}]))
+
+(def output-answer [{:some-answer true}])
+
+(def output-tasks
+  [{:desire     [1.0 0.8099999570846563]
+    :occurrence 1
+    :statement  '[--> K S]
+    :task-type  :goal}
+   {:desire     [1.0 0.40499997854232817]
+    :occurrence 1
+    :statement  '[--> S K]
+    :task-type  :goal}])
+
+(deftest general-inference-test
+  (let [input-topic (rand-id)
+        tasks-topic (rand-id)
+        answers-topic (rand-id)
+        {:keys [env-config peer-config]}
+        (read-config (clojure.java.io/resource "config.edn")
+                     {:profile :test})
+        zk-address (get-in peer-config [:zookeeper/address])
+        job (gi/build-job zk-address input-topic tasks-topic answers-topic 10 1000)
+        mock (atom {})]
+    (try
+      (load-redis-data)
+      (with-test-env
+        [test-env [9 env-config peer-config]]
+        (onyx.test-helper/validate-enough-peers! test-env job)
+        (reset! mock (mock-kafka zk-address [[input-topic input]]))
+        (onyx.api/submit-job peer-config job)
+        (is (= (set (take-values-from-topic zk-address tasks-topic))
+               (set output-tasks)))
+        (is (= (take-values-from-topic zk-address answers-topic)
+               output-answer)))
+      (finally (swap! mock component/stop)))))

test/narjure/test/control/local_inference/beliefs.clj

@@ -0,0 +1,156 @@
+(ns narjure.test.control.local-inference.beliefs
+  (:require [clojure.test :refer [deftest is]]
+            [aero.core :refer [read-config]]
+            [com.stuartsierra.component :as component]
+            [taoensso.carmine :refer [wcar] :as c]
+            [narjure.system :refer [mem]]
+            [onyx api
+             [test-helper :refer [with-test-env]]]
+            [narjure.test.control.utils :refer [mock-kafka rand-id
+                                                take-values-from-topic]]
+            [narjure.control.local-inference.beliefs :refer [build-job]]
+            [narjure.memory.api :as m]
+            [narjure.test.control.utils :as u]))
+
+(defn input []
+  (let [task {:statement     'cat
+              :occurrence    1
+              :frequency     0.8
+              :confidence    0.7
+              :durability    0.4
+              :eternal       false
+              :creation-time 1
+              :evidences     [1]}
+        id (m/add-task mem task)]
+    [{:task (assoc task :id id)}]))
+
+(def output
+  [{:priority-diff -0.05675676676197694
+    :question      {:durability 0.5
+                    :id         nil
+                    :priority   0.7
+                    :quality    1.0
+                    :task       {:eternal    false
+                                 :occurrence 1
+                                 :statement  'cat
+                                 :task-type  :question}}
+    :satisfaction  0.08108109675505559}])
+
+(def beliefs
+  #{{:durability (float 0.1)
+     :priority   (float 0.3)
+     :quality    (float 1.0)
+     :task       {:eternal    false
+                  :evidences  [2]
+                  :frequency  (float 1.0)
+                  :confidence (float 0.9)
+                  :occurrence 1
+                  :statement  'cat
+                  :task-type  :belief}}
+    {:durability (float 0.856)
+     :task       {:frequency     (float 0.8)
+                  :confidence    (float 0.7)
+                  :creation-time 1
+                  :durability    "0.4"
+                  :eternal       false
+                  :evidences     [1]
+                  :occurrence    1
+                  :statement     'cat}}
+    {:durability (float 0.86767566)
+     :task       {:confidence    (float 0.9189189)
+                  :creation-time 1
+                  :durability    "0.8676756845053482"
+                  :eternal       false
+                  :evidences     [1 2]
+                  :frequency     (float 0.9588235)
+                  :occurrence    1
+                  :statement     'cat}}})
+
+(def questions
+  #{{:durability (float 0.5)
+     :priority   (float 0.64324325)
+     :quality    (float 1.0)
+     :task       {:eternal    false
+                  :occurrence 1
+                  :statement  'cat
+                  :task-type  :question}}})
+
+(def goals
+  #{{:durability (float 0.9)
+     :priority   (float 0.19199999)
+     :quality    (float 1.0)
+     :task       {:desirability (float 0.9)
+                  :occurrence   1
+                  :eternal      false
+                  :evidences    [3]
+                  :plausibility (float 1.0)
+                  :statement    'cat
+                  :task-type    :goal}}})
+
+(defn load-redis-data
+  []
+  (wcar {} (c/flushall))
+  (let [concept1 'cat]
+    (m/add-term mem concept1)
+    (let [task {:task-type  :belief
+                :occurrence 1
+                :frequency  1
+                :confidence 0.9
+                :statement  concept1
+                :eternal    false
+                :evidences  [2]}
+          task2 {:task-type    :goal
+                 :occurrence   1
+                 :plausibility 1
+                 :desirability 0.9
+                 :statement    concept1
+                 :eternal      false
+                 :evidences    [3]}
+          task3 {:task-type  :question
+                 :occurrence 1
+                 :statement  concept1
+                 :eternal    false}
+          task-id (m/add-task mem task)
+          task2-id (m/add-task mem task2)
+          task3-id (m/add-task mem task3)
+          tasklink {:priority   0.3
+                    :durability 0.1
+                    :quality    1
+                    :task       task-id}
+          tasklink2 {:priority   0.8
+                     :durability 0.9
+                     :quality    1
+                     :task       task2-id}
+          tasklink3 {:priority   0.7
+                     :durability 0.5
+                     :quality    1
+                     :task       task3-id}]
+      (m/add-tasklink mem concept1 tasklink "belief")
+      (m/add-tasklink mem concept1 tasklink2 "goal")
+      (m/add-tasklink mem concept1 tasklink3 "question"))))
+
+(deftest beliefs-li-inference-test
+  (let [tasks-topic (rand-id)
+        answers-topic (rand-id)
+        {:keys [env-config peer-config]}
+        (read-config (clojure.java.io/resource "config.edn")
+                     {:profile :test})
+        zk-address (get-in peer-config [:zookeeper/address])
+        kafka-io {:input  {:read-beliefs tasks-topic}
+                  :output {:write-answers answers-topic}}
+        job (build-job zk-address kafka-io 10 1000)
+        mock (atom {})]
+    (try
+      (load-redis-data)
+      (with-test-env
+        [test-env [12 env-config peer-config]]
+        (onyx.test-helper/validate-enough-peers! test-env job)
+        (reset! mock (mock-kafka zk-address [[tasks-topic (input)]]))
+        (onyx.api/submit-job peer-config job)
+        (is (= (-> (take-values-from-topic zk-address answers-topic)
+                   (assoc-in [0 :question :id] nil))
+               output))
+        (is (= beliefs (u/dissoc-ids (m/beliefs mem 'cat))))
+        (is (= questions (u/dissoc-ids (m/questions mem 'cat))))
+        (is (= goals (u/dissoc-ids (m/goals mem 'cat)))))
+      (finally (swap! mock component/stop)))))

test/narjure/test/control/local_inference/goals.clj

@@ -0,0 +1,161 @@
+(ns narjure.test.control.local-inference.goals
+  (:require [clojure.test :refer [deftest is]]
+            [aero.core :refer [read-config]]
+            [com.stuartsierra.component :as component]
+            [taoensso.carmine :refer [wcar] :as c]
+            [narjure.system :refer [mem]]
+            [onyx api
+             [test-helper :refer [with-test-env]]]
+            [narjure.test.control.utils :refer [mock-kafka rand-id
+                                                take-values-from-topic]]
+            [narjure.control.local-inference.goals :refer [build-job]]
+            [narjure.memory.api :as m]
+            [narjure.test.control.utils :as u]))
+
+(defn input []
+  (let [task {:statement     'cat
+              :occurrence    1
+              :plausibility  0.85
+              :desirability  0.5
+              :durability    0.6
+              :priority      0.75
+              :creation-time 1
+              :evidences     [1]
+              :eternal       false}
+        id (m/add-task mem task)]
+    [{:task (assoc task :id id)}]))
+
+(def output
+  [{:priority-diff -0.0636363763454526
+    :quest         {:durability 0.5
+                    :id         nil
+                    :priority   0.7
+                    :quality    1.0
+                    :task       {:eternal    false
+                                 :occurrence 1
+                                 :statement  'cat
+                                 :task-type  :quest}}
+    :satisfaction  0.09090911061310525}])
+
+(def beliefs
+  #{{:durability (float 0.7525)
+     :priority   (float 0.3)
+     :quality    (float 1.0)
+     :task       {:confidence (float 0.9)
+                  :frequency  (float 1.0)
+                  :eternal    false
+                  :evidences  [2]
+                  :occurrence 1
+                  :statement  'cat
+                  :task-type  :belief}}})
+
+(def quests
+  #{{:durability (float 0.5)
+     :priority   (float 0.6363636)
+     :quality    (float 1.0)
+     :task       {:eternal    false
+                  :occurrence 1
+                  :statement  'cat
+                  :task-type  :quest}}})
+
+(def goals
+  #{{:durability (float 0.6)
+     :priority   (float 0.20625)
+     :task       {:creation-time 1
+                  :desirability  (float 0.5)
+                  :durability    "0.6"
+                  :eternal       false
+                  :evidences     [1]
+                  :occurrence    1
+                  :plausibility  (float 0.85)
+                  :priority      "0.75"
+                  :statement     'cat}}
+    {:durability (float 0.6363636)
+     :priority   (float 0.20625)
+     :task       {:creation-time 1
+                  :desirability  (float 0.9090909)
+                  :durability    "0.636363644245242"
+                  :eternal       false
+                  :evidences     [1 3]
+                  :occurrence    1
+                  :plausibility  (float 0.26500002)
+                  :priority      "0.20624999105930325"
+                  :statement     'cat}}
+    {:durability (float 0.9)
+     :priority   (float 0.8)
+     :quality    (float 1.0)
+     :task       {:desirability (float 0.9)
+                  :eternal      false
+                  :evidences    [3]
+                  :occurrence   1
+                  :plausibility (float 0.2)
+                  :statement    'cat
+                  :task-type    :goal}}})
+
+(defn load-redis-data
+  []
+  (wcar {} (c/flushall))
+  (let [concept1 'cat]
+    (m/add-term mem concept1)
+    (let [task {:task-type  :belief
+                :occurrence 1
+                :frequency  1
+                :confidence 0.9
+                :statement  concept1
+                :eternal    false
+                :evidences  [2]}
+          task2 {:task-type    :goal
+                 :occurrence   1
+                 :plausibility 0.2
+                 :desirability 0.9
+                 :statement    concept1
+                 :eternal      false
+                 :evidences    [3]}
+          task3 {:task-type  :quest
+                 :occurrence 1
+                 :statement  concept1
+                 :eternal    false}
+          task-id (m/add-task mem task)
+          task2-id (m/add-task mem task2)
+          task3-id (m/add-task mem task3)
+          tasklink {:priority   0.3
+                    :durability 0.1
+                    :quality    1
+                    :task       task-id}
+          tasklink2 {:priority   0.8
+                     :durability 0.9
+                     :quality    1
+                     :task       task2-id}
+          tasklink3 {:priority   0.7
+                     :durability 0.5
+                     :quality    1
+                     :task       task3-id}]
+      (m/add-tasklink mem concept1 tasklink "belief")
+      (m/add-tasklink mem concept1 tasklink2 "goal")
+      (m/add-tasklink mem concept1 tasklink3 "quest"))))
+
+(deftest goals-li-inference-test
+  (let [tasks-topic (rand-id)
+        answers-topic (rand-id)
+        {:keys [env-config peer-config]}
+        (read-config (clojure.java.io/resource "config.edn")
+                     {:profile :test})
+        zk-address (get-in peer-config [:zookeeper/address])
+        kafka-io {:input  {:read-goals tasks-topic}
+                  :output {:write-answers answers-topic}}
+        job (build-job zk-address kafka-io 10 1000)
+        mock (atom {})]
+    (try
+      (load-redis-data)
+      (with-test-env
+        [test-env [12 env-config peer-config]]
+        (onyx.test-helper/validate-enough-peers! test-env job)
+        (reset! mock (mock-kafka zk-address [[tasks-topic (input)]]))
+        (onyx.api/submit-job peer-config job)
+        (is (= (-> (take-values-from-topic zk-address answers-topic)
+                   (assoc-in [0 :quest :id] nil))
+               output))
+        (is (= beliefs (u/dissoc-ids (m/beliefs mem 'cat))))
+        (is (= quests (u/dissoc-ids (m/quests mem 'cat))))
+        (is (= goals (u/dissoc-ids (m/goals mem 'cat)))))
+      (finally (swap! mock component/stop)))))

test/narjure/test/control/local_inference/questions.clj

@@ -0,0 +1,114 @@
+(ns narjure.test.control.local-inference.questions
+  (:require [clojure.test :refer [deftest is]]
+            [aero.core :refer [read-config]]
+            [com.stuartsierra.component :as component]
+            [taoensso.carmine :refer [wcar] :as c]
+            [narjure.system :refer [mem]]
+            [onyx api
+             [test-helper :refer [with-test-env]]]
+            [narjure.test.control.utils :refer [mock-kafka rand-id
+                                                take-values-from-topic]]
+            [narjure.control.local-inference.questions :refer [build-job]]
+            [narjure.memory.api :as m]
+            [narjure.test.control.utils :as u]))
+
+(def input
+  [{:task {:statement  'cat
+           :occurrence 1
+           :durability 1
+           :priority   1
+           :evidences  [1]
+           :eternal    false}}])
+
+(def output
+  [{:belief          {:durability 0.78
+                      :id         nil
+                      :priority   0.56
+                      :quality    1.0
+                      :task       {:confidence 0.9
+                                   :frequency  0.8
+                                   :eternal    false
+                                   :evidences  [2]
+                                   :occurrence 1
+                                   :statement  'cat
+                                   :task-type  :belief}}
+    :durability-diff 0.02200000810623237
+    :question        {:durability 1
+                      :occurrence 1
+                      :priority   0.8999999761581421
+                      :eternal    false
+                      :evidences  [1]
+                      :statement  'cat}}])
+
+(def beliefs
+  #{{:durability (float 0.802)
+     :priority   (float 0.56)
+     :quality    (float 1.0)
+     :task       {:confidence (float 0.9)
+                  :frequency  (float 0.8)
+                  :occurrence 1
+                  :eternal    false
+                  :evidences  [2]
+                  :statement  'cat
+                  :task-type  :belief}}})
+(def questions
+  #{{:durability (float 1.0)
+     :priority   (float 0.9)
+     :task       {}}})
+
+(defn load-redis-data
+  []
+  (wcar {} (c/flushall))
+  (let [concept1 'cat]
+    (m/add-term mem concept1)
+    (let [task {:task-type  :belief
+                :occurrence 1
+                :frequency  0.8
+                :confidence 0.9
+                :statement  concept1
+                :evidences     [2]
+                :eternal       false}
+          task2 {:task-type    :goal
+                 :occurrence   1
+                 :plausibility 1
+                 :desirability 0.9
+                 :statement    concept1
+                 :evidences     [3]
+                 :eternal       false}
+          task-id (m/add-task mem task)
+          task2-id (m/add-task mem task2)
+          tasklink {:priority   0.56
+                    :durability 0.78
+                    :quality    1
+                    :task       task-id}
+          tasklink2 {:priority   0.65
+                     :durability 0.8
+                     :quality    1
+                     :task       task2-id}]
+      (m/add-tasklink mem concept1 tasklink "belief")
+      (m/add-tasklink mem concept1 tasklink2 "goal"))))
+
+(deftest questions-li-inference-test
+  (let [tasks-topic (rand-id)
+        answers-topic (rand-id)
+        {:keys [env-config peer-config]}
+        (read-config (clojure.java.io/resource "config.edn")
+                     {:profile :test})
+        zk-address (get-in peer-config [:zookeeper/address])
+        kafka-io {:input  {:read-questions tasks-topic}
+                  :output {:write-answer answers-topic}}
+        job (build-job zk-address kafka-io 10 1000)
+        mock (atom {})]
+    (try
+      (load-redis-data)
+      (with-test-env
+        [test-env [6 env-config peer-config]]
+        (onyx.test-helper/validate-enough-peers! test-env job)
+        (reset! mock (mock-kafka zk-address [[tasks-topic input]]))
+        (onyx.api/submit-job peer-config job)
+        (is (= (-> (take-values-from-topic zk-address answers-topic)
+                   (assoc-in [0 :belief :id] nil))
+               output))
+        (is (= beliefs (u/dissoc-ids (m/beliefs mem 'cat))))
+        (is (= questions (u/dissoc-ids (m/questions mem 'cat)))))
+      (finally (swap! mock component/stop)))))

test/narjure/test/control/local_inference/quests.clj

@@ -0,0 +1,123 @@
+(ns narjure.test.control.local-inference.quests
+  (:require [clojure.test :refer [deftest is]]
+            [aero.core :refer [read-config]]
+            [com.stuartsierra.component :as component]
+            [taoensso.carmine :refer [wcar] :as c]
+            [narjure.system :refer [mem]]
+            [onyx api
+             [test-helper :refer [with-test-env]]]
+            [narjure.test.control.utils :refer [mock-kafka rand-id
+                                                take-values-from-topic]]
+            [narjure.control.local-inference.quests :refer [build-job]]
+            [narjure.memory.api :as m]
+            [narjure.test.control.utils :as u]))
+
+(defn input []
+  (let [task {:statement  'cat
+              :occurrence 1
+              :durability 0.95
+              :priority   1
+              :evidences  [1]
+              :eternal    false}
+        id (m/add-task mem task)]
+    [{:task (assoc task :id id)}]))
+
+(def output
+  [{:durability-diff 0.020000003576278402
+    :goal            {:durability 0.8
+                      :id         nil
+                      :priority   0.65
+                      :quality    1.0
+                      :task       {:desirability 0.9
+                                   :occurrence   1
+                                   :eternal    false
+                                   :evidences  [3]
+                                   :plausibility 1.0
+                                   :statement    'cat
+                                   :task-type    :goal}}
+    :quest           {:id         nil
+                      :durability 0.95
+                      :occurrence 1
+                      :priority   0.8999999761581421
+                      :eternal    false
+                      :evidences  [1]
+                      :statement  'cat}}])
+
+(def goals
+  #{{:durability (float 0.82)
+     :priority   (float 0.65)
+     :quality    (float 1.0)
+     :task       {:desirability (float 0.9)
+                  :occurrence   1
+                  :eternal    false
+                  :evidences  [3]
+                  :plausibility (float 1.0)
+                  :statement    'cat
+                  :task-type    :goal}}})
+(def quests
+  #{{:durability (float 0.95)
+     :priority   (float 0.9)
+     :task       {:durability "0.95"
+                  :eternal    false
+                  :evidences  [1]
+                  :occurrence 1
+                  :priority   "1"
+                  :statement  'cat}}})
+
+(defn load-redis-data
+  []
+  (wcar {} (c/flushall))
+  (let [concept1 'cat]
+    (m/add-term mem concept1)
+    (let [task {:task-type  :belief
+                :occurrence 1
+                :frequency  0.8
+                :confidence 0.9
+                :statement  concept1
+                :evidences     [2]
+                :eternal       false}
+          task2 {:task-type    :goal
+                 :occurrence   1
+                 :plausibility 1
+                 :desirability 0.9
+                 :statement    concept1
+                 :evidences     [3]
+                 :eternal       false}
+          task-id (m/add-task mem task)
+          task2-id (m/add-task mem task2)
+          tasklink {:priority   0.56
+                    :durability 0.78
+                    :quality    1
+                    :task       task-id}
+          tasklink2 {:priority   0.65
+                     :durability 0.8
+                     :quality    1
+                     :task       task2-id}]
+      (m/add-tasklink mem concept1 tasklink "belief")
+      (m/add-tasklink mem concept1 tasklink2 "goal"))))
+
+(deftest quests-li-inference-test
+  (let [tasks-topic (rand-id)
+        answers-topic (rand-id)
+        {:keys [env-config peer-config]}
+        (read-config (clojure.java.io/resource "config.edn")
+                     {:profile :test})
+        zk-address (get-in peer-config [:zookeeper/address])
+        kafka-io {:input  {:read-quests tasks-topic}
+                  :output {:write-answer answers-topic}}
+        job (build-job zk-address kafka-io 10 1000)
+        mock (atom {})]
+    (try
+      (load-redis-data)
+      (with-test-env
+        [test-env [6 env-config peer-config]]
+        (onyx.test-helper/validate-enough-peers! test-env job)
+        (reset! mock (mock-kafka zk-address [[tasks-topic (input)]]))
+        (onyx.api/submit-job peer-config job)
+        (is (= (-> (take-values-from-topic zk-address answers-topic)
+                   (assoc-in [0 :goal :id] nil)
+                   (assoc-in [0 :quest :id] nil))
+               output))
+        (is (= goals (u/dissoc-ids (m/goals mem 'cat))))
+        (is (= quests (u/dissoc-ids (m/quests mem 'cat)))))
+      (finally (swap! mock component/stop)))))

test/narjure/test/control/task_preprocessing.clj

@@ -0,0 +1,91 @@
+(ns narjure.test.control.task-preprocessing
+  (:require
+    [clojure.test :refer [deftest is]]
+    [aero.core :refer [read-config]]
+    [com.stuartsierra.component :as component]
+    [taoensso.carmine :refer [wcar] :as c]
+    [narjure.system :refer [mem]]
+    [onyx api
+     [test-helper :refer [with-test-env]]]
+    [narjure.test.control.utils :refer [mock-kafka rand-id
+                                        take-values-from-topic]]
+    [narjure.control.task-preprocessing :refer [build-job]]
+    [narjure.memory.api :as m]
+    [narjure.test.control.utils :as u]))
+
+(def input
+  [{:statement  '[--> cat aimal]
+    :task-type  :belief
+    :occurrence 1}
+   {:statement  '[--> tim cat]
+    :task-type  :question
+    :occurrence 1}
+   {:statement  '[--> computer intelligent]
+    :task-type  :goal
+    :occurrence 1}
+   {:statement  '[<=> wut duck]
+    :task-type  :quest
+    :occurrence 1}])
+
+(def beliefs
+  #{{:occurrence 1
+     :statement  '[--> cat aimal]
+     :task-type  :belief}})
+
+(def questions
+  #{{:statement  '[--> tim cat]
+     :task-type  :question
+     :occurrence 1}})
+
+(def goals
+  #{{:statement  '[--> computer intelligent]
+     :task-type  :goal
+     :occurrence 1}})
+
+(def quests
+  #{{:statement  '[<=> wut duck]
+     :task-type  :quest
+     :occurrence 1}})
+
+(def cat-tasklinks
+  #{{:task {:occurrence 1
+            :statement  '[--> cat aimal]
+            :task-type  :belief}}
+    {:task {:occurrence 1
+            :statement  '[--> tim cat]
+            :task-type  :question}}})
+
+(deftest quests-li-inference-test
+  (let [read-tasks (rand-id)
+        write-beliefs (rand-id)
+        write-goals (rand-id)
+        write-questions (rand-id)
+        write-quests (rand-id)
+        {:keys [env-config peer-config]}
+        (read-config (clojure.java.io/resource "config.edn")
+                     {:profile :test})
+        zk-address (get-in peer-config [:zookeeper/address])
+        kafka-io {:input  {:read-task read-tasks}
+                  :output {:write-belief   write-beliefs
+                           :write-goal     write-goals
+                           :write-question write-questions
+                           :write-quest    write-quests}}
+        job (build-job zk-address kafka-io 10 1000)
+        mock (atom {})]
+    (try
+      (with-test-env
+        [test-env [8 env-config peer-config]]
+        (onyx.test-helper/validate-enough-peers! test-env job)
+        (reset! mock (mock-kafka zk-address [[read-tasks input]]))
+        (onyx.api/submit-job peer-config job)
+        (wcar {} (c/flushall))
+        (is (= (u/dissoc-ids (take-values-from-topic zk-address write-beliefs))
+               beliefs))
+        (is (= (u/dissoc-ids (take-values-from-topic zk-address write-goals))
+               goals))
+        (is (= (u/dissoc-ids (take-values-from-topic zk-address write-questions))
+               questions))
+        (is (= (u/dissoc-ids (take-values-from-topic zk-address write-quests))
+               quests))
+        (is (= (u/dissoc-ids (m/tasklinks mem 'cat)) cat-tasklinks)))
+      (finally (swap! mock component/stop)))))

test/narjure/test/control/utils.clj

@@ -0,0 +1,42 @@
+(ns narjure.test.control.utils
+  (:require [onyx.kafka.embedded-server :as ke]
+            [com.stuartsierra.component :as component]
+            [clj-kafka
+             [admin :as kadmin]
+             [producer :as kp]]
+            [onyx.kafka.utils :refer [take-until-done]])
+  (:import (java.util UUID)))
+
+(defn rand-id [] (str "onyx-test-" (UUID/randomUUID)))
+
+(defn mock-kafka
+  [zookeeper inputs]
+  (let [log-dir (str "/tmp/embedded-kafka" (UUID/randomUUID))
+        kafka-server (component/start
+                       (ke/map->EmbeddedKafka
+                         {:hostname       "127.0.0.1"
+                          :port           9092
+                          :broker-id      0
+                          :log-dir        log-dir
+                          :zookeeper-addr zookeeper}))
+        producer1 (kp/producer
+                    {"metadata.broker.list" "127.0.0.1:9092"
+                     "serializer.class"     "kafka.serializer.DefaultEncoder"
+                     "partitioner.class"    "kafka.producer.DefaultPartitioner"})]
+
+    (doseq [[topic input] inputs]
+      (do (doseq [x (concat input [:done])]
+            (->> (pr-str x)
+                 .getBytes
+                 (kp/message topic)
+                 (kp/send-message producer1)))))
+    kafka-server))
+
+(defn take-values-from-topic [zk-address topic]
+  (->> (take-until-done zk-address topic #(read-string (String. % "UTF-8")))
+       (sort-by (comp :n :value))
+       (mapv :value)))
+
+(defn dissoc-ids
+  [coll]
+  (set (mapv #(dissoc % :id) coll)))

test/narjure/test/memory/redis.clj

@@ -0,0 +1,67 @@
+(ns narjure.test.memory.redis
+  (:require [clojure.test :refer :all]
+            [narjure.memory.redis :as r]
+            [narjure.memory.api :as m]
+            [taoensso.carmine :as c]))
+
+(def config
+  {:pool {}
+   :spec {:host "127.0.0.1" :port 6379}})
+
+(def mem (r/->RedisMemory config))
+
+(def concept1 '[--> tim cat])
+(def concept2 'tim)
+
+(def belief1 {:frequency  (float 0.9)
+              :confidence (float 0.2)
+              :occurrence 1
+              :term       concept1})
+
+(def belief2 {:frequency  (float 0.5)
+              :confidence (float 0.8)
+              :occurrence 2
+              :term       concept1})
+
+(def goal1 {:frequency  (float 0.5)
+            :confidence (float 0.8)
+            :occurrence 2
+            :term       concept1})
+
+(defn termlink [c]
+  {:priority   (float 0.1)
+   :durability (float 0.1)
+   :quality    (float 0.1)
+   :concept    (str (hash c))})
+
+(defn tasklink [task-id]
+  {:priority   (float 0.1)
+   :durability (float 0.1)
+   :quality    (float 0.1)
+   :task       task-id})
+
+(deftest test-redis
+  (c/wcar config (c/flushall))
+  (m/add-term mem concept1)
+
+  (is (= concept1 (m/term mem (hash concept1))))
+
+  (let [id1 (m/add-task mem belief1)
+        id2 (m/add-task mem belief2)
+        id3 (m/add-task mem goal1)]
+    (m/add-tasklink mem concept1 (tasklink id1) "belief")
+    (m/add-tasklink mem concept1 (tasklink id2) "belief")
+    (m/add-tasklink mem concept1 (tasklink id3) "goal")
+    (is (= (set [belief1 belief2])
+           (set (map :task (m/beliefs mem concept1)))))
+
+    (is (= [goal1]
+           (map :task (m/goals mem concept1)))))
+
+  (is (:task (first (m/beliefs mem concept1))))
+
+  (m/add-term mem concept2)
+  (m/add-termlink mem concept1 (termlink concept2))
+  (is (= [(termlink concept2)]
+         (map #(dissoc % :id) (m/termlinks mem concept1))))
+  (is (= concept2 (m/term mem (:concept (first (m/termlinks mem concept1)))))))