api updates

Update Deriver

.travis.yml

@@ -0,0 +1,8 @@
+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

project.clj

@@ -9,7 +9,9 @@
                  [org.clojure/tools.nrepl "0.2.12"]
                  [org.clojure/data.priority-map "0.0.7"]
                  [org.clojure/core.match "0.3.0-alpha4"]
-                 [org.clojure/core.unify "0.5.5"]]
+                 [org.clojure/core.unify "0.5.5"]
+                 [com.taoensso/carmine "2.12.2"]
+                 [mount "0.1.10"]]
   :main ^:skip-aot narjure.core
   :plugins [[lein-cloverage "1.0.6"]
             [jonase/eastwood "0.2.3"]

src/nal/core.clj

@@ -1,18 +1,12 @@
 (ns nal.core
   (:require [nal.deriver.truth :as t]
-            [nal.deriver :refer [generate-conclusions]]
-            [nal.rules :as r]))
+            [nal.deriver :refer [generate-conclusions]]))
 
 (defn choice [[f1 c1] [f2 c2]]
   (if (>= c1 c2) [f1 c1] [f2 c2]))
 
 (defn inference
-  [{:keys [task-type] :as task} belief]
-  (generate-conclusions (r/rules task-type) task belief))
+  [rules {:keys [task-type] :as task} belief]
+  (generate-conclusions (rules task-type) task belief))
 
 (def revision t/revision)
-
-(comment
-  :shift-occurrence-forward                                 ;pre
-  :shift-occurrence-backward                                 ;pre
-  :linkage-temporal)

src/nal/deriver.clj

@@ -8,8 +8,8 @@
 (defn get-matcher [rules p1 p2]
   (let [matchers (->> (mall-paths p1 p2)
                       (filter rules)
-                      (select-keys rules)
-                      (map (fn [el] (:matcher (second el)))))]
+                      (map rules)
+                      (map (fn [el] (:matcher el))))]
     (case (count matchers)
       0 (constantly [])
       1 (first matchers)

src/nal/deriver/matching.clj

@@ -1,7 +1,6 @@
 (ns nal.deriver.matching
   (:require
     [nal.deriver.utils :refer [walk operator? not-operator?]]
-    [clojure.core.match :refer [match]]
     [clojure.core.unify :as u]
     [clojure.set :refer [map-invert intersection]]
     [clojure.string :as s]
@@ -26,6 +25,14 @@
     `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
@@ -93,14 +100,14 @@
     (replace-occurrences
       `(fn [{p1# :statement ~t1 ~truth-kw :t-occurrence :occurrence :as ~task}
             {p2# :statement ~t2 :truth :b-occurrence :occurrence :as ~belief}]
-         (match [p1# p2#] ~(quote-operators pattern)
+         (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)
-           :else nil)))))
+                       rules))))))
 
 (defn find-and-replace-symbols
   "Replaces all terms in statemnt to placeholders that will be used in pattern

src/nal/deriver/preconditions.clj

@@ -5,7 +5,7 @@
             [nal.deriver.substitution :refer [substitute munification-map]]
             [nal.deriver.terms-permutation :refer [implications equivalences]]
             [clojure.set :refer [union intersection]]
-            [narjure.defaults :refer [duration]]
+            [narjure.defaults :refer [temporal-window-duration]]
             [clojure.core.match :as m]
             [nal.deriver.normalization :refer [reduce-seq-conj]]))
 
@@ -88,11 +88,11 @@
   [_]
   [`(not= :eternal :t-occurrence)
    `(not= :eternal :b-occurrence)
-   `(<= ~duration (abs (- :t-occurrence :b-occurrence)))])
+   `(<= ~temporal-window-duration (abs (- :t-occurrence :b-occurrence)))])
 
 (defmethod compound-precondition :concurrent
   [_]
-  [`(> ~duration (abs (- :t-occurrence :b-occurrence)))])
+  [`(> ~temporal-window-duration (abs (- :t-occurrence :b-occurrence)))])
 
 ;-------------------------------------------------------------------------------
 (defmulti precondition-transformation (fn [arg1 _] (first arg1)))
@@ -164,11 +164,11 @@
   (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)
+    ['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 duration)
-    [sym 'retro-impl] (shift-forward-let sym `- concl duration)))
+    [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))
@@ -190,7 +190,7 @@
 
 (defmethod conclusion-transformation :shift-occurrence-backward
   [args concl]
-  (let [duration (- duration)]
+  (let [duration (- temporal-window-duration)]
     (m/match (mapv #(if (and (coll? %) (= 'quote (first %)))
                      (second %) %) (rest args))
       [(:or '=|> '==>)] concl

src/nal/deriver/rules.clj

@@ -59,7 +59,7 @@
 
 (defn goal?
   "Return true if rule allows only goal as task."
-  [{pre :pre [{post :post} :as concls] :conclusions}]
+  [{pre :pre [{post :post}] :conclusions}]
   (or (some #{:goal?} pre)
       (some (fn [el] (and (keyword? el)
                           (s/starts-with? (str el) ":d/")))
@@ -79,9 +79,9 @@
   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 starts-with]}]]
+  [ac [k {:keys [all]}]]
   (let [rules (mapcat :rules (vals (select-keys ac all)))]
-    ac #_(-> ac
+    (-> ac
         (update-in [k :rules] concat rules)
         (update-in [k :rules] set))))
 
@@ -102,7 +102,7 @@
   values from the premises, rules will be used to generate deriver."
   [ruleset task-type]
   (let [rules (reduce rule->map {} ruleset)]
-    (generate-matching (reduce add-possible-paths rules rules) task-type)))
+    (generate-matching rules task-type)))
 
 ;---------------------------------------------------------------------------
 
@@ -117,24 +117,27 @@
             `~raw-rules
             pairs)))
 
-(defmacro defrules
+(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
-  [name & rules]
-  `(time
-     (let [rules# (rules->> (quote ~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#))
-       (def ~name {:judgement (rules-map judgement-rules# :judgement)
-                   :question  (rules-map question-rules# :question)
-                   :goal      (rules-map goal-rules# :goal)}))))
+  [& 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/rules.clj

@@ -1,10 +1,10 @@
 (ns nal.rules
-  (:require [nal.deriver.rules :refer [defrules]]
+  (:require [nal.deriver.rules :refer [defrules compile-rules]]
             nal.reader))
 
 (declare --S S --P P <-> |- --> ==> M || && =|> -- A Ai B <=>)
 
-(defrules rules
+(defrules all-rules
   ;Similarity to Inheritance
   #R[(S --> P) (S <-> P) |- (S --> P) :post (:t/struct-int :p/judgement) :pre (:question?)]
   ;Inheritance to Similarity
@@ -450,16 +450,3 @@
   ; compound composition one premise
   #R[(|| B :list/A) B |- (|| B :list/A) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
 )
-
-(defn freq [task-type]
-  "Check frequency"
-  (into {} (map (fn [[k v]] [(str k) (count (:rules v))]) (task-type rules))))
-
-(defn stats [task-type]
-  (let [fr (freq task-type)]
-    (println "Total" (reduce + (vals fr)))
-    (println "Total keys" (count (task-type rules)))
-    (println "Freq" (sort (frequencies (vals fr))))
-    (println "Min" (reduce min (vals fr)))
-    (println "Max" (reduce (fn [[_ v1 :as p] [_ v :as n]]
-                             (if (> v1 v) p n)) fr))))

src/narjure/defaults.clj

@@ -32,4 +32,4 @@
 
 (def ^{:type double} horizon 1)
 
-(def duration 80)
+(def temporal-window-duration 80)

src/narjure/memory/api.clj

@@ -0,0 +1,32 @@
+(ns narjure.memory.api)
+
+(defprotocol Memory
+  (term [mem concept])
+  (select-truth [mem concept occurrence])
+  (truths [mem concept])
+  (desires [mem concept])
+  (tasklinks [mem concept])
+  (select-tasklink [mem concept])
+  (termlinks [mem concept])
+  (select-termlink [mem concept])
+  (budget [mem concept])
+
+  (add-term [mem concept])
+  (add-truth [mem concept truth])
+  (add-desire [mem concept desire])
+  (add-tasklink [mem concept link])
+  (add-termlink [mem concept link])
+
+  (remove-truth [mem concept id])
+  (remove-desire [mem concept id])
+  (remove-tasklink [mem concept id])
+  (remove-termlink [mem concept id])
+
+  (update-budget [mem update-fn])
+
+  (task [mem id])
+  (push-task [mem task])
+  (pop-task [mem])
+
+  (activate-concept [mem concept])
+  (pull-activated-concepts [mem]))

src/narjure/memory/redis.clj

@@ -0,0 +1,174 @@
+(ns narjure.memory.redis
+  (:require [taoensso.carmine :as c]
+            [narjure.memory.api :refer [Memory]])
+  (:import (java.util UUID)))
+
+;postfixes for keys
+(def truths-pr "_t")
+(def desires-pr "_d")
+(def tasklinks-pr "_tkl")
+(def termlinks-pr "_tml")
+(def budget-pr "_bg")
+(def task-pr "_tsk")
+
+(def parse-float #(Float/parseFloat %))
+(def parse-int #(Integer/parseInt %))
+(def parse-boolean #(Boolean/parseBoolean %))
+
+(def truth-schema
+  {:frequency  :float
+   :confidence :float
+   :occurrence :int
+   :evidences  :any})
+
+(def desire-schema
+  {:plausibility :float
+   :desirability :float
+   :occurrence   :int
+   :evidences    :any})
+
+(def task-schema
+  {:task-type    :keyword
+   :evidences    :vector
+   :eternal      :boolean
+   :occurrence   :int
+   :frequency    :float
+   :confidence   :float
+   :plausibility :float
+   :desirability :float
+   :term         :any})
+
+(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
+   :boolean parse-boolean})
+
+(defn apply-schema [val]
+  (->> val
+       (map (fn [[k v]]
+              [k (get deserialization-fn v identity)]))
+       (into {})))
+
+(def deserialization-map
+  (reduce (fn [ac [key val]] (assoc ac key (apply-schema val)))
+          {}
+          {truths-pr    truth-schema
+           desires-pr   desire-schema
+           task-pr      task-schema
+           tasklinks-pr tasklink-schema
+           termlinks-pr 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 [conn concept postfix]
+  (->> (get-key concept postfix)
+       c/smembers
+       (c/wcar conn)))
+
+(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 [conn concept postfix]
+  (map (partial get-map-by-key conn (deserialization-map postfix))
+       (get-maps-ids conn concept postfix)))
+
+(defn- get-map [conn concept postfix]
+  (get-map-by-key conn (deserialization-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- push [conn task]
+  (let [id (str (UUID/randomUUID) "_tsk")]
+    (c/wcar conn (c/lpush "tasks" id))
+    (c/wcar conn (c/hmset* id task))))
+
+(defn- tpop [conn]
+  (let [id (c/wcar conn (c/rpop))]
+    (get-map-by-key conn (deserialization-map task-pr) id)))
+
+(defn pull-concepts [conn]
+  (-> (c/wcar
+        conn
+        (c/multi)
+        (c/smembers :active-concepts)
+        (println val)
+        (c/del :active-concepts)
+        (c/exec))
+      last
+      first))
+
+(defn- activate-concept* [conn concept]
+  (c/wcar conn (c/sadd :active-concepts (check-hash concept))))
+
+(defn- select-link [conn concept prefix]
+  (let [id (->> prefix
+                (get-key concept)
+                c/srandmember
+                (c/wcar conn))]
+    (get-map-by-key conn (deserialization-map prefix) id)))
+
+(defn get-task [conn id]
+  (get-map-by-key conn (deserialization-map task-pr) id))
+
+(defrecord RedisMemory
+  [conn]
+  Memory
+  (term [_ concept] (c/wcar conn (c/get (check-hash concept))))
+  (select-truth [_ concept occurrence] (select-link conn concept truths-pr))
+  (truths [_ concept] (get-maps conn concept truths-pr))
+  (desires [_ concept] (get-maps conn concept desires-pr))
+  (tasklinks [_ concept] (get-maps conn concept tasklinks-pr))
+  (select-tasklink [_ concept] (select-link conn concept tasklinks-pr))
+  (termlinks [_ concept] (get-maps conn concept termlinks-pr))
+  (select-termlink [_ concept] (select-link conn concept termlinks-pr))
+  (budget [_ concept] (get-map conn concept budget-pr))
+
+  (add-term [_ concept] (c/wcar conn (c/set (hash concept) concept)))
+  (add-truth [_ concept truth] (add-map conn concept truths-pr truth))
+  (add-desire [_ concept desire] (add-map conn concept desires-pr desire))
+  (add-tasklink [_ concept link] (add-map conn concept tasklinks-pr link))
+  (add-termlink [_ concept link] (add-map conn concept termlinks-pr link))
+
+  (remove-truth [_ concept id] (remove-map conn concept truths-pr id))
+  (remove-desire [_ concept id] (remove-map conn concept desires-pr id))
+  (remove-tasklink [_ concept id] (remove-map conn concept tasklinks-pr id))
+  (remove-termlink [_ concept id] (remove-map conn concept termlinks-pr id))
+
+  (update-budget [_ update-fn])
+
+  (task [_ id] (get-task conn id))
+  (push-task [_ task] (push conn task))
+  (pop-task [_] (tpop conn))
+
+  (activate-concept [_ concept] (activate-concept* conn concept))
+  (pull-activated-concepts [_] (pull-concepts conn)))

src/narjure/system.clj

@@ -0,0 +1,15 @@
+(ns narjure.system
+  (:require [mount.core :refer [defstate]]
+            [narjure.memory.redis :as r]
+            [nal.deriver.rules :refer [compile-rules]]
+            [nal.rules :refer [all-rules]]
+            [nal.core :as c]))
+
+(declare memory inference)
+
+(def redis-config
+  {:spec {:host "127.0.0.1" :port 6379}})
+
+(defstate memory :start (r/->RedisMemory redis-config))
+(defstate inference :start #(let [rules (compile-rules all-rules)]
+                             (partial c/inference rules)))

test/nal/test/core.clj

@@ -1,25 +1,28 @@
 (ns nal.test.core
   (:require [clojure.test :refer :all]
-            [nal.core :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
+    '({: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
+    '[{: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]
+      {: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
@@ -47,38 +50,38 @@
         :task-type  :judgement
         :truth      [1
                      0.44751381215469616]})
-    '[{:statement [--> [* a1 a2 a3] m]
-       :truth     [1 0.9]
-       :task-type :judgement
+    '[{:statement  [--> [* a1 a2 a3] m]
+       :truth      [1 0.9]
+       :task-type  :judgement
        :occurrence 1}
 
-      {:statement a1
-       :truth     [1 0.9]
+      {:statement  a1
+       :truth      [1 0.9]
        :occurrence 0}]
 
-    '[{:statement [=|> [--> [* a1 a2 a3] m] a1],
-       :task-type :judgement,
+    '[{:statement  [=|> [--> [* a1 a2 a3] m] a1],
+       :task-type  :judgement,
        :occurrence 1,
-       :truth [1 0.44751381215469616]}
-      {:statement [<|> a1 [--> [* a1 a2 a3] m]],
-       :task-type :judgement,
+       :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,
+       :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,
+       :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
+       :truth      [1 0.44751381215469616]}]
+    '[{:statement  a1
+       :truth      [1 0.9]
+       :task-type  :judgement
        :occurrence 1}
 
-      {:statement [--> [* a1 a2 a3] m]
-       :truth     [1 0.9]
+      {:statement  [--> [* a1 a2 a3] m]
+       :truth      [1 0.9]
        :occurrence 0}]
 
     '({:occurrence 1
@@ -103,56 +106,166 @@
         :statement  a1
         :task-type  :judgement
         :truth      [1 0.44751381215469616]})
-    '[{:statement [conj a1 a2 a3]
-       :truth     [1 0.9]
-       :task-type :judgement
+    '[{:statement  [conj a1 a2 a3]
+       :truth      [1 0.9]
+       :task-type  :judgement
        :occurrence 1}
 
-      {:statement a1
-       :truth     [1 0.9]
+      {:statement  a1
+       :truth      [1 0.9]
        :occurrence 0}]
 
-    '[{:statement [=|> [--> M S] [[--> M S] [--> M P]]],
-       :task-type :judgement,
+    '[{: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,
+       :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,
+       :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,
+       :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
+       :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]
+      {: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
+    '({: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
+       {: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
+    '[{: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  [--> [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

@@ -1,116 +1,21 @@
 (ns nal.test.deriver
   (:require [clojure.test :refer :all]
             [nal.deriver :refer :all]
+            [nal.deriver.rules :refer [compile-rules]]
             [nal.rules :as r]))
 
-(def result
-  '({: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]}))
+(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 result)
+  (is (= (set [{:occurrence 1000
+                :statement  '[<-> sport chess]
+                :task-type  :judgement
+                :truth      [1.0 0.44751381215469616]}])
          (set (generate-conclusions
-                (r/rules :judgement)
+                (rules :judgement)
                 '{:statement  [--> sport competition]
                   :truth      [1 0.9]
                   :task-type  :judgement

test/narjure/test/memory/redis.clj

@@ -0,0 +1,50 @@
+(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 truth1 {:frequency  (float 0.9)
+             :confidence (float 0.2)
+             :occurrence 1})
+
+(def truth2 {:frequency  (float 0.5)
+             :confidence (float 0.8)
+             :occurrence 2})
+
+(defn termlink [c]
+  {:priority   (float 0.1)
+   :durability (float 0.1)
+   :quality    (float 0.1)
+   :concept    (str (hash c))})
+
+(deftest test-redis
+  (c/wcar config (c/flushall))
+  (m/add-term mem concept1)
+
+  (is (= concept1 (m/term mem (hash concept1))))
+
+  (m/add-truth mem concept1 truth1)
+  (m/add-truth mem concept1 truth2)
+
+  (is (= (set [truth1 truth2])
+         (set (map #(dissoc % :id) (m/truths mem concept1)))))
+  (m/remove-truth mem concept1 (:id (last (m/truths mem concept1))))
+
+  (is (:id (first (m/truths mem concept1))))
+  (is ((set [truth1 truth2]) (dissoc (first (m/truths mem concept1)) :id)))
+
+  (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)))))))