async flow last updates

Update Deriver

.gitignore

@@ -12,8 +12,6 @@ pom.xml.asc
 .idea
 *.iml
 *~
-/onyx.log
-/profiles.clj
 \#*\#
 .\#*
 /src/nal/experiments.clj

.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

circle.yml

@@ -1,3 +0,0 @@
-machine:
-  java:
-    version: oraclejdk8

profiles.clj

@@ -1,11 +0,0 @@
-{:dev  {:env {:db-uri "datomic:dev://localhost:4334/nars"
-              :zookeeper    {:env-config  {:zookeeper/address     "127.0.0.1:2188"
-                                           :zookeeper/server?     true
-                                           :zookeeper.server/port 2188}
-                             :peer-config {:zookeeper/address        "127.0.0.1:2188"
-                                           :onyx.peer/job-scheduler  :onyx.job-scheduler/balanced
-                                           :onyx.messaging/impl      :aeron
-                                           :onyx.messaging/peer-port 40200
-                                           :onyx.messaging/bind-addr "localhost"}}}}
-
- :test {:env {:db-uri "datomic:dev://localhost:4334/nars_test"}}}

project.clj

@@ -11,38 +11,15 @@
                  [org.clojure/core.match "0.3.0-alpha4"]
                  [org.clojure/core.unify "0.5.5"]
                  [org.clojure/core.async "0.2.374"]
-                 [org.onyxplatform/onyx "0.8.11"]
-                 [org.onyxplatform/onyx-datomic "0.8.11.1"]
-                 [datomic-schema "1.3.0"]
-                 [org.danielsz/system "0.2.0"]
-                 [environ "1.0.2"]
-                 [com.datomic/datomic-free "0.9.5350"]]
+                 [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"]
             [lein-kibit "0.1.2"]
-            [cider/cider-nrepl "0.11.0-SNAPSHOT"]
-            [lein-environ "1.0.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]}
-  :env {:db-uri      "datomic:dev://localhost:4334/nars"
-        :db-uri-onyx "datomic:dev://localhost:4334/nars_input"
-        :zookeeper   {:env-config  {:zookeeper/address     "127.0.0.1:2188"
-                                    :zookeeper/server?     true
-                                    :zookeeper.server/port 2188}
-                      :peer-config {:zookeeper/address        "127.0.0.1:2188"
-                                    :onyx.peer/job-scheduler  :onyx.job-scheduler/balanced
-                                    :onyx.messaging/impl      :aeron
-                                    :onyx.messaging/peer-port 40200
-                                    :onyx.messaging/bind-addr "localhost"}}}
-  :profiles {:uberjar {:aot :all}
-             ;local configuration can be redefined on profiles.clj
-             ;https://github.com/technomancy/leiningen/blob/master/doc/PROFILES.md#declaring-profiles
-             :dev     {:dependencies [[com.datomic/datomic-pro "0.9.5350"]]}
-             :test    {:dependencies [[com.datomic/datomic-free "0.9.5350"]]
-                       :env          {:db-uri      "datomic:mem://localhost:4334/nars"
-                                      :db-uri-onyx "datomic:mem://localhost:4334/nars_input"}}}
-  :repositories {"my.datomic.com" {:url   "https://my.datomic.com/repo"
-                                   :creds :gpg}})
+  :profiles {:uberjar {:aot :all}})

src/nal/core.clj

@@ -14,5 +14,5 @@
 
 (comment
   :shift-occurrence-forward                                 ;pre
-  :shift-occurrence-backward                                 ;pre
+  :shift-occurrence-backward                                ;pre
   :linkage-temporal)

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]
@@ -24,7 +23,7 @@
     `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})
+    `n/reduce-seq-conj `clojure.core.match/match})
 
 (defn operators->placeholders
   [statement]

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

@@ -118,23 +118,23 @@
             pairs)))
 
 (defmacro defrules [name & rules]
-  "Define rules. Rules must be #R statements."
-  ;TODO exception on duplication of the rule
   `(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#))]
+    (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#))

src/nal/rules.clj

@@ -229,7 +229,7 @@
      :pre ((:!= S P))]
   #R[(P =/> M) (S =/> M) |- (((P || S) =/> M) :post (:t/intersection)
                               ((P &| S) =/> M) :post (:t/union))
-     :pre ((:!= S P))]
+     :pre ((:!= S P)) ]
   #R[(P =\> M) (S =\> M) |- (((P || S) =\> M) :post (:t/intersection)
                                 ((P &| S) =\> M) :post (:t/union))
      :pre ((:!= S P))]
@@ -306,7 +306,7 @@
                               ((S --> $X) ==> (P --> $X)) :post (:t/induction)
                               ((P --> $X) <=> (S --> $X)) :post (:t/comparison)
                               (&& (S --> #Y) (P --> #Y)) :post (:t/intersection))
-                            :pre ((:!= S P))]
+                                  :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)
@@ -324,7 +324,7 @@
                               (($X --> P) ==> ($X --> S)) :post (:t/abduction)
                               (($X --> S) <=> ($X --> P)) :post (:t/comparison)
                               (&& (#Y --> S) (#Y --> P)) :post (:t/intersection))
-     :pre ((:!= S P))]
+     :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)
@@ -348,11 +348,11 @@
      :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))]
+                                       (&& (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))]
+                                                 :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)]
@@ -386,7 +386,7 @@
   #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))]
+                                                      ((&& :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.
@@ -448,4 +448,5 @@
   #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)])
+  #R[(|| B :list/A) B |- (|| B :list/A) :pre (:question?) :post (:t/belief-structural-deduction :p/judgement)]
+)

src/narjure/components/datomic.clj

@@ -1,19 +0,0 @@
-(ns narjure.components.datomic
-  (:require [com.stuartsierra.component :as component]
-            [datomic.api :as d]))
-
-(defrecord Datomic [uri conn schema]
-  component/Lifecycle
-  (start [component]
-    (println "Start Datomic " uri)
-    (let [db (d/create-database uri)
-          conn (d/connect uri)]
-      (d/transact conn schema)
-      (assoc component :conn conn)))
-  (stop [component]
-    (println "Stop Datomic " uri)
-    (assoc component :conn nil)))
-
-(defn new-datomic-db [uri schema]
-  (map->Datomic {:uri uri
-                 :schem schema}))

src/narjure/components/deriver.clj

@@ -1,20 +0,0 @@
-(ns narjure.components.deriver
-  (:require [com.stuartsierra.component :as component]
-            [nal.rules :as r]
-            [nal.deriver.rules :refer [compile-rules]]
-            [nal.core :refer [inference]]))
-
-(defrecord Deriver [inference rules]
-  component/Lifecycle
-  (start [component]
-    (println "Start Deriver")
-    (let [rules (compile-rules r/all-rules)]
-      (assoc component :inference (partial inference rules)
-                       :rules rules)))
-  (stop [component]
-    (println "Stop Deriver")
-    (assoc component :inference nil
-                     :rules nil)))
-
-(defn new-deriver []
-  (map->Deriver {}))

src/narjure/components/onyx.clj

@@ -1,30 +0,0 @@
-(ns narjure.components.onyx
-  (:require [com.stuartsierra.component :as component]
-            [onyx.api :as o])
-  (:import (java.util UUID)))
-
-(defrecord Onyx [env-config peer-config env peer-group]
-  component/Lifecycle
-  (start [component]
-    (println "Start Onyx")
-    (let [id (UUID/randomUUID)
-          env-config (assoc env-config :onyx/id id)
-          peer-config (assoc peer-config :onyx/id id)
-          env (o/start-env env-config)
-          peer-group (o/start-peer-group peer-config)]
-      (assoc component :env-config env-config
-                       :env env
-                       :peer-config peer-config
-                       :peer-group peer-group)))
-  (stop [component]
-    (println "Stop Onyx")
-    (o/shutdown-peer-group peer-group)
-    (o/shutdown-env env)
-    (assoc component :env-config nil
-                     :env nil
-                     :peer-config nil
-                     :peer-group nil)))
-
-(defn new-onyx [{:keys [env-config peer-config]}]
-  (map->Onyx {:env-config env-config
-              :peer-config peer-config}))

src/narjure/components/task_processing_job.clj

@@ -1,25 +0,0 @@
-(ns narjure.components.task-processing-job
-  (:require [com.stuartsierra.component :as component]
-            [narjure.control.task-processing :as tp]
-            [onyx.api :as o]))
-
-(defrecord TaskProcessingJob [db-uri db-uri-onyx onyx]
-  component/Lifecycle
-  (start [component]
-    (println "Start TaskProcessingJob")
-    (let [{:keys [peer-group peer-config]} onyx
-          n-peers (count (set (mapcat identity tp/workflow)))
-          v-peers (o/start-peers n-peers peer-group)
-          job (o/submit-job peer-config (tp/job-config db-uri-onyx db-uri))]
-      (assoc component :v-peers v-peers
-                       :job job)))
-  (stop [{:keys [v-peers] :as component}]
-    (println "Stop TaskProcessingJob")
-    (doseq [v-peer v-peers]
-      (o/shutdown-peer v-peer))
-    (assoc component :v-peers nil
-                     :job nil)))
-
-(defn new-task-processing-job [db-uri db-uri-onyx]
-  (map->TaskProcessingJob {:db-uri      db-uri
-                           :db-uri-onyx db-uri-onyx}))

src/narjure/control/buffer.clj

@@ -0,0 +1,31 @@
+(ns narjure.control.buffer
+  (:require [clojure.core.async.impl.protocols :as impl])
+  (:import [java.util LinkedList]
+           [clojure.lang Fn Counted]))
+
+(deftype PanickingSlidingBuffer
+  [^LinkedList buf ^long n ^Fn warning-callback ^long warning-n]
+  impl/UnblockingBuffer
+  impl/Buffer
+  (full? [this]
+    false)
+  (remove! [this]
+    (.removeLast buf))
+  (add!* [this itm]
+    (let [size (.size buf)]
+      (when (>= size warning-n)
+        (warning-callback size)
+        (when (= size n)
+          (impl/remove! this))))
+    (.addFirst buf itm)
+    this)
+  (close-buf! [this])
+  Counted
+  (count [this]
+    (.size buf)))
+
+(defn panicking-sliding-buffer
+  ([n callback]
+   (panicking-sliding-buffer n callback (Math/round (* 0.9 n))))
+  ([n callback warning-n]
+   (PanickingSlidingBuffer. (LinkedList.) n callback warning-n)))

src/narjure/control/flow.clj

@@ -0,0 +1,110 @@
+(ns narjure.control.flow
+  (:require [clojure.core.async :refer [go-loop <! >! chan]]
+            [clojure.set :as set]))
+
+(defn check-element-in-map
+  "Checks if elements exist in map, if not
+  assocs elements to map with default value."
+  ([s m] (check-element-in-map s 0 m))
+  ([s default m]
+   (reduce (fn [ac k]
+             (if (ac k)
+               ac
+               (assoc ac k default)))
+           m s)))
+
+(defn all
+  "Returns set aff all functions from workflow."
+  [wf]
+  (set (flatten wf)))
+
+(defn kw->fn
+  "Transform function's keyword to var."
+  [kw]
+  (->> (str kw)
+       (drop 1)
+       (apply str)
+       symbol
+       resolve))
+
+(defn vertex
+  "Creates vertex of flow graph. Arguments:
+   - functions: collection of collections, where first element is function
+     and second (optional) is output port
+   - inputs: ports (edges) that should be listened by vertex
+   - p: number of parallelism"
+  [functions inputs p]
+  (doseq [in inputs
+          _ (range (* p (count functions)))]
+    (go-loop []
+      (when-let [val (<! in)]
+        (doseq [[f out] functions]
+          (let [results (f val)]
+            (when out
+              (doseq [res (if (map? results)
+                            [results]
+                            results)]
+                (>! out res)))))
+        (recur)))))
+
+(defn check-output
+  "Creates output port for function if it is necessary."
+  [buffer [function output-cnt]]
+  [function (when (pos? output-cnt) (chan buffer))])
+
+(defn fn-outputs
+  "Generates map where keys are functions and values are ports which
+  will be used to send result of execution of functions."
+  [workflow buffer]
+  (->> (group-by first workflow)
+       (map (fn [[n t]] [n (count t)]))
+       (into {})
+       (check-element-in-map (all workflow))
+       (map #(check-output buffer %))
+       (into {})))
+
+(defn fn-inputs [workflow]
+  "Groups functions to identify vertexes and edges that they should listen.
+  Returns map {vertexes edges ...}
+
+  in: [[:a :b]
+       [:a :c]
+       [:c :d]
+       [:b :d]]
+
+  out: {[:c :b] [:a], [:d] [:b :c]}"
+  (->> workflow
+       (reduce (fn [ac [k v]]
+                 (update ac k conj v))
+               {})
+       (reduce (fn [ac [k v]]
+                 (update ac v conj k))
+               {})))
+
+(defn generate-flow
+  "Generates flow of functions which is discribed by pairs of functions,
+  where result of fisrt function will be sent to input of the second function.
+  Optionally map of configuration params can be passed.
+  Possible configs:
+   - parallelism: map where keys are functions and values
+     are parallelization numbers
+   - default-p: defaulp parallelization number
+   - buffer: capacity of fixed buffer for all channels"
+  ;TODO configuration for custom buffers
+  ([workflow] (generate-flow workflow {}))
+  ([workflow {:keys [parallelism default-p buffer]
+              :or   {parallelism {}
+                     default-p   1
+                     buffer      100}}]
+   (let [in (chan buffer)
+         outputs (assoc (fn-outputs workflow buffer) :in in)
+         inputs (fn-inputs workflow)
+         all-inputs (set (mapcat key inputs))
+         input-tasks (set/difference (all workflow) all-inputs)
+         it2 (assoc inputs input-tasks [:in])]
+     (doseq [[tasks from] it2]
+       (vertex
+         (map (fn [f] [(kw->fn f) (outputs f)]) tasks)
+         (map outputs from)
+         (apply max (map #(parallelism % default-p) tasks))))
+     in)))

src/narjure/control/general_inference.clj

@@ -1,13 +1,69 @@
-(ns narjure.control.general-inference)
+(ns narjure.control.general-inference
+  (:require [narjure.system :refer [memory inference]]
+            [narjure.control.flow :as f]
+            [narjure.memory.api :as m]))
 
+;;  select-concepts
+;;     | | |     |
+;;     v v v ... v
+;;  select-task-link --> update-tasklink-budget
+;;         |
+;;         v
+;;  select-term-link --> update-termlink-budget
+;;         |
+;;         v
+;;   do-inference
 (def workflow
-  [[:general-inference-tick :select-concept]
-   [:select-concept :out-update-concept-budget]
-   [:select-concept :select-tasklink]
+  [[::select-concepts ::select-task-link]
 
-   [:select-tasklink :out-update-tasklink-budget]
-   [:select-tasklink :select-termlink]
+   [::select-task-link ::update-tasklink-budget]
+   [::select-task-link ::select-term-link]
 
-   [:select-termlink :out-update-termlink-budget]
-   [:select-termlink :inference]
-   [:inference :out-conclusions]])
+   [::select-term-link ::update-termlink-budget]
+   [::select-term-link ::do-inference]])
+
+
+(defn select-concept [_]
+  (m/pull-activated-concepts memory))
+
+(defn select-task-link [concept]
+  (let [{task-id :task} (m/select-tasklink memory concept)
+        task (m/task memory task-id)]
+    {:task    task
+     :concept concept}))
+
+;(defn update-concept-budget [data] data)
+
+(defn select-term-link [{:keys [concept task] :as data}]
+  (let [{linked-concept :concept} (m/select-termlink memory concept)
+        occurrence (:occurrence task)
+        truth (m/select-truth memory linked-concept occurrence)]
+    (assoc data :truth truth
+                :term (m/term memory linked-concept))))
+;(defn update-tasklink-budget [data] data)
+;(defn update-termlink-budget [data] data)
+
+(defn do-inference [{:keys [task truth term]}]
+  (let [{statement :term
+         :keys     [frequency confidence plausibility
+                    desirability task-type occurrence]}
+        task
+
+        task {:statement  statement
+              :desire     [plausibility desirability]
+              :truth      [frequency confidence]
+              :task-type  task-type
+              :occurrence occurrence}
+
+        truth (assoc truth :statement term)
+        results (inference task truth)]
+    (doseq [res results]
+      (m/push-task memory res))))
+
+(def default-parallelism {::do-inference 4})
+
+(defn general-inference-flow
+  [{:keys [parallelism]
+    :or   {parallelism default-parallelism}
+    :as   options}]
+  (f/generate-flow workflow options))

src/narjure/control/local_inference.clj

@@ -0,0 +1,37 @@
+(ns narjure.control.local-inference)
+
+(def workflow
+  [[:read-task :answer-yn-question]
+   [:read-task :answer-general-question]
+   [:answer-yn-question :out-answers]
+   [:answer-general-question :out-answers]
+
+   [:read-task :find-related-concepts]
+   [:find-related-concepts :out-update-tasklinks]
+   [:find-related-concepts :out-check-tasklinks-capacity]
+
+   [:read-task :belief-revision]
+   [:belief-revision :out-update-beliefs]
+
+   [:read-task :goal-revision]
+   [:goal-revision :out-update-goals]])
+
+(defn answer-yn-question [{:keys [task] :as segment}]
+  (println :yn)
+  {})
+
+(defn answer-general-question [{:keys [task] :as segment}]
+  (println :general)
+  {})
+
+(defn find-related-concepts [{:keys [task] :as segment}]
+  (println :rel)
+  {})
+
+(defn belief-revision [{:keys [task] :as segment}]
+  (println :bel)
+  {})
+
+(defn goal-revision [{:keys [task] :as segment}]
+  (println :goal)
+  {})

src/narjure/control/task_processing.clj

@@ -1,148 +0,0 @@
-(ns narjure.control.task-processing
-  (:require [clojure.core.async :refer [chan >!! <!! close! alts!!]]
-            [onyx.plugin.core-async :refer [take-segments!]]
-            [onyx.api]
-            [datomic.api :as d]
-            [narjure.control.utils :refer :all]
-            [onyx.plugin.tasks.datomic :as od]))
-
-(def tp-ns :narjure.control.task-processing)
-
-(def workflow
-  [[:read-task :answer-yn-question]
-   [:read-task :answer-general-question]
-   [:answer-yn-question :out-answers]
-   [:answer-general-question :out-answers]
-
-   [:read-task :find-related-concepts]
-   [:find-related-concepts :out-update-tasklinks]
-   [:find-related-concepts :out-check-tasklinks-capacity]
-
-   [:read-task :belief-revision]
-   [:belief-revision :out-update-beliefs]
-
-   [:read-task :goal-revision]
-   [:goal-revision :out-update-goals]])
-
-(defn answer-yn-question [{:keys [task] :as segment}]
-  (println :yn)
-  {})
-
-(defn answer-general-question [{:keys [task] :as segment}]
-  (println :general)
-  {})
-
-(defn find-related-concepts [{:keys [task] :as segment}]
-  (println :rel)
-  {})
-
-(defn belief-revision [{:keys [task] :as segment}]
-  (println :bel)
-  {})
-
-(defn goal-revision [{:keys [task] :as segment}]
-  (println :goal)
-  {})
-
-
-(def input-chan (chan))
-(def output-chan (chan))
-
-(def batch-size 10)
-
-(def task-processing-fn
-  (partial onyx-fn :narjure.control.task-processing batch-size))
-
-(defn catalog [db-uri-in db-uri-out]
-  (concat
-    [(in-datomic :read-task {:batch-size batch-size
-                             :db-uri     db-uri-in})]
-    (map task-processing-fn
-         [:answer-yn-question
-          :answer-general-question
-          :find-related-concepts
-          :belief-revision
-          :goal-revision])
-    (map (fn [task]
-           (out-datomic task :db.part/user {:batch-size batch-size
-                                            :db-uri     db-uri-out}))
-         [:out-answers
-          :out-update-tasklinks
-          :out-check-tasklinks-capacity
-          :out-update-beliefs
-          :out-update-goals])))
-
-(def tp-condition (partial condition :narjure.control.task-processing))
-
-(def flow-conditions
-  [(tp-condition :read-task [:answer-yn-question] :yn-question?)
-   (tp-condition :read-task [:answer-general-question] :general-question?)
-   (tp-condition :read-task [:belief-revision] :judgement?)
-   (tp-condition :read-task [:goal-revision] :goal?)
-   (tp-condition :read-task [:find-related-concepts] :constantly-true)])
-
-(defn judgement? [_ _ {{task-type :task-type} :task} _]
-  (= task-type :judgement))
-
-(defn goal? [_ _ {{task-type :task-type} :task} _]
-  (= task-type :goal))
-
-(defn yn-question? [_ _ {{task-type :task-type} :task} _]
-  (= task-type :yn-question))
-
-(defn general-question? [_ _ {{task-type :task-type} :task} _]
-  (= task-type :general-question))
-
-(def constantly-true (constantly true))
-
-;-------------------------------------------------------------------------------
-
-(defn inject-in-ch [event lifecycle]
-  {:core.async/chan input-chan})
-
-(defn inject-out-ch [event lifecycle]
-  {:core.async/chan output-chan})
-
-(def in-calls
-  {:lifecycle/before-task-start inject-in-ch})
-
-(def out-calls
-  {:lifecycle/before-task-start inject-out-ch})
-
-(def lifecycles
-  [{:lifecycle/task  :read-task
-    :lifecycle/calls (full-fn-name tp-ns :in-calls)}
-   {:lifecycle/task  :read-task
-    :lifecycle/calls :onyx.plugin.core-async/reader-calls}
-
-   {:lifecycle/task  :out-answers
-    :lifecycle/calls (full-fn-name tp-ns :out-calls)}
-   {:lifecycle/task  :out-answers
-    :lifecycle/calls :onyx.plugin.core-async/writer-calls}
-
-   {:lifecycle/task  :out-update-tasklinks
-    :lifecycle/calls (full-fn-name tp-ns :out-calls)}
-   {:lifecycle/task  :out-update-tasklinks
-    :lifecycle/calls :onyx.plugin.core-async/writer-calls}
-
-   {:lifecycle/task  :out-check-tasklinks-capacity
-    :lifecycle/calls (full-fn-name tp-ns :out-calls)}
-   {:lifecycle/task  :out-check-tasklinks-capacity
-    :lifecycle/calls :onyx.plugin.core-async/writer-calls}
-
-   {:lifecycle/task  :out-update-beliefs
-    :lifecycle/calls (full-fn-name tp-ns :out-calls)}
-   {:lifecycle/task  :out-update-beliefs
-    :lifecycle/calls :onyx.plugin.core-async/writer-calls}
-
-   {:lifecycle/task  :out-update-goals
-    :lifecycle/calls (full-fn-name tp-ns :out-calls)}
-   {:lifecycle/task  :out-update-goals
-    :lifecycle/calls :onyx.plugin.core-async/writer-calls}])
-
-(defn job-config [db-uri-in db-uri-out]
-  {:catalog         (catalog db-uri-in db-uri-out)
-   :workflow        workflow
-   :lifecycles      lifecycles
-   :flow-conditions flow-conditions
-   :task-scheduler  :onyx.task-scheduler/balanced})

src/narjure/control/utils.clj

@@ -1,64 +0,0 @@
-(ns narjure.control.utils)
-
-(defn full-fn-name [namespace fn-name]
-  (keyword (str (name namespace) "/" (name fn-name))))
-
-(defn onyx-fn [namespace batch-size fn-name]
-  (let [full-name (full-fn-name namespace fn-name)]
-    {:onyx/name       fn-name
-     :onyx/fn         full-name
-     :onyx/type       :function
-     :onyx/batch-size batch-size}))
-
-(defn in-async
-  ([name] (in-async name {}))
-  ([name {bs :batch-size peers :peers :or {peers 1 bs 1}}]
-   {:onyx/name       name
-    :onyx/plugin     :onyx.plugin.core-async/input
-    :onyx/type       :input
-    :onyx/medium     :core.async
-    :onyx/max-peers  peers
-    :onyx/batch-size bs}))
-
-(defn in-datomic
-  [task-name {:keys [db-uri t batch-size max-peers datoms-per-segment]
-                   :or   {datoms-per-segment 20
-                          max-peers          1
-                          t                  nil}}]
-  {:pre [((complement nil?) db-uri)
-         ((complement nil?) batch-size)]}
-  {:onyx/name                  task-name
-   :onyx/plugin                :onyx.plugin.datomic/read-datoms
-   :onyx/type                  :input
-   :onyx/medium                :datomic
-   :datomic/uri                db-uri
-   :datomic/t                  t
-   :datomic/datoms-index       :eavt
-   :datomic/datoms-per-segment datoms-per-segment
-   :onyx/max-peers             max-peers
-   :onyx/batch-size            batch-size})
-
-(defn out-async
-  ([name] (out-async name {}))
-  ([name {bs :batch-size peers :peers :or {peers 1 bs 1}}]
-   {:onyx/name       name
-    :onyx/plugin     :onyx.plugin.core-async/output
-    :onyx/type       :output
-    :onyx/medium     :core.async
-    :onyx/max-peers  peers
-    :onyx/batch-size bs}))
-
-(defn out-datomic
-  [task-name part {:keys [db-uri batch-size]}]
-  {:onyx/name         task-name
-   :onyx/plugin       :onyx.plugin.datomic/write-bulk-datoms
-   :onyx/type         :output
-   :onyx/medium       :datomic
-   :datomic/uri       db-uri
-   :datomic/partition part
-   :onyx/batch-size   batch-size})
-
-(defn condition [namespace from to predicate]
-  {:flow/from      from
-   :flow/to        to
-   :flow/predicate (full-fn-name namespace predicate)})

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/memory/schema.clj

@@ -1,75 +0,0 @@
-(ns narjure.memory.schema
-  (:require [datomic-schema.schema :as sc]))
-
-(def task
-  (sc/schema task
-    (sc/fields
-      [task-type :enum [:judgement :goal :question :quest]]
-      [evidences :long :many]
-      [eternal :boolean]
-      [occurrence-time :long]
-      [truth-value :ref :one :component]
-      [desire-value :ref :one :component])))
-
-(def truth-value
-  (sc/schema truth-value
-    (sc/fields
-      [frequence :float]
-      [confidence :float])))
-
-(def desire-value
-  (sc/schema desire-value
-    (sc/fields
-      [plausibility :float]
-      [desirability :float])))
-
-(def dbschema
-  [task
-   desire-value
-   truth-value
-   (sc/schema concept
-     (sc/fields
-       [term :string :unique-identity]
-       [belief :ref :many :component]
-       [goal :ref :many :component]
-       [task-link :ref :many :component]
-       [term-link :ref :many :component]
-       [budget :ref :one :component]))
-
-   (sc/schema belief
-     (sc/fields
-       [evidences :long :many]
-       [eternal :boolean]
-       [occurrence-time :long]
-       [truth-value :ref :one :component]))
-
-   (sc/schema goal
-     (sc/fields
-       [evidences :long :many]
-       [eternal :boolean]
-       [occurrence-time :long]
-       [desire-value :ref :one :component]))
-
-   (sc/schema task-link
-     (sc/fields
-       [budget :ref :one :component]
-       [task :ref :one]))
-
-   (sc/schema term-link
-     (sc/fields
-       [budget :ref :one :component]
-       [concept :ref :one]))
-
-   (sc/schema budget
-     (sc/fields
-       [priority :float]
-       [durability :float]
-       [quality :float]))])
-
-(def schema
-  (sc/generate-schema dbschema))
-
-(def schema-onyx
-  (sc/generate-schema [task desire-value truth-value]))
-
-

src/narjure/system.clj

@@ -1,26 +1,15 @@
 (ns narjure.system
-  (:require
-    [system.core :refer [defsystem]]
-    [environ.core :refer [env]]
-    [narjure.components
-     [datomic :refer [new-datomic-db]]
-     [deriver :refer [new-deriver]]
-     [onyx :refer [new-onyx]]
-     [task-processing-job :refer [new-task-processing-job]]]
-    [com.stuartsierra.component :as component]
-    [reloaded.repl :as repl :refer [go system reset]]
-    [clojure.edn :as e]
-    [narjure.memory.schema :as s]))
+  (: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]))
 
-(defsystem dev-system
-  [:datomic (new-datomic-db (env :db-uri) s/schema)
-   :datomic-onyx (new-datomic-db (env :db-uri-onyx) s/schema-onyx)
-   :deriver (new-deriver)
-   :onyx (new-onyx (e/read-string (env :zookeeper)))
-   :task-processing (component/using
-                      (new-task-processing-job (env :db-uri) (env :db-uri-onyx))
-                      [:onyx])])
+(declare memory inference)
 
-(defn init-dev! []
-  (repl/set-init! dev-system)
-  (go))
+(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,31 +1,28 @@
 (ns nal.test.core
   (:require [clojure.test :refer :all]
-            [nal.core :refer :all]
-            [nal.deriver.rules :refer [compile-rules]]
+            [nal.core :as c]
             [nal.rules :as r]
-            [environ.core]
-            [narjure.system :as s]))
+            [nal.deriver.rules :refer [compile-rules]]))
 
-(def rules (compile-rules r/all-rules))
+(def inference (partial c/inference (compile-rules r/all-rules)))
 
 (deftest test-inference
-  (are [a1 a2] (= (set a1) (set (apply inference rules a2)))
-
-    '({:statement [==>
-                   [&| [--> [ext-set tim] [int-set driving]]]
-                   [--> [ext-set tim] [int-set dead]]]
-       :truth     [1.0 0.81]
-       :task-type :judgement
+  (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
+    '[{: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
@@ -33,132 +30,242 @@
        :task-type  :judgement
        :truth      [1.0
                     0.81]}
-      {:occurrence 1
-       :statement  [--> a1 [ext-image m _ a2 a3]]
+       {: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
-       :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]
+      {: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
        :statement  [&| a1 [conj a1 a2 a3]]
        :task-type  :judgement
        :truth      [1.0 0.81]}
-      {:occurrence 1
-       :statement  [<|> a1 [conj a1 a2 a3]]
+       {: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]}
-      {:occurrence 1
-       :statement  [=|> [conj a1 a2 a3] a1]
+      {: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
-       :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]
+      {:statement  [--> M S]
+       :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
+    '({: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 [--> M S]
-       :truth     [1 0.9]
-       :occurrence 0}]
+      {: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 [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  [--> chess competition]
+       :truth      [1 0.9]
+       :occurrence 0}]))

test/nal/test/underiver.clj

@@ -0,0 +1,64 @@
+(ns nal.test.underiver
+  (:require nal.reader
+            [nal.deriver.rules :as r]
+            [nal.deriver.matching :as m]
+            [nal.deriver.utils :as u]
+            [clojure.core.unify :as un]
+            [clojure.core.match :as omg]
+            [clojure.set :as cs]
+            [nal.core :as c]))
+
+(r/defrules rls
+  #R[(P ==> M) (S ==> M) |- (S ==> P) :post (:t/induction :allow-backward) :pre ((:!= S P))])
+
+(def compiled (r/compile-rules rls))
+(def r-map (first (r/rule (first rls))))
+
+(defn sym-map [m p1 p2]
+  (let [vals (set (vals m))
+        all (cs/difference (set (remove u/operator? (flatten [p1 p2])))
+                           vals)]
+    (->> all
+         (map (fn [el] [`(quote ~el) el]))
+         (into {})
+         (merge m))))
+
+(defn underiver [{:keys [p1 p2 conclusions]}]
+  (let [concl (vec (:conclusion (first conclusions)))
+        [m pattern] (m/find-and-replace-symbols concl "x")
+        m (sym-map m p1 p2)
+        p1 (m/replace-symbols p1 m)
+        p2 (m/replace-symbols p2 m)]
+    (eval (m/quote-operators
+            `(fn [xn#] (omg/match xn#
+                         ~pattern [~p1 ~p2]
+                         :else []))))))
+
+(defn deriver [rls]
+  (let [compiled (r/compile-rules rls)]
+    (fn [[p1 p2]]
+      (let [t {:statement  p1
+               :desire     [1 0.9]
+               :task-type  :judgement
+               :occurrence 1}
+            b {:statement  p2
+               :truth      [1 0.9]
+               :occurrence 0}]
+        (c/inference compiled t b)))))
+
+(comment
+  ((underiver r-map) '[==> wut ahh?])
+
+  => [[==> ahh? M] [==> wut M]]
+
+  ((deriver rls) '[[==> ahh? M] [==> wut M]])
+  (let [[{st :statement}] (c/inference compiled
+                                       {:statement  '[==> ahh? M]
+                                        :truth      [1 0.9]
+                                        :task-type  :judgement
+                                        :occurrence 1}
+                                       {:statement  '[==> wut M]
+                                        :truth      [1 0.9]
+                                        :occurrence 0})]
+    ((underiver r-map) st))
+  )

test/narjure/test/control/buffer.clj

@@ -0,0 +1,41 @@
+(ns narjure.test.control.buffer
+  (:require
+    [clojure.test :refer :all]
+    [narjure.control.buffer :refer :all]
+    [clojure.core.async.impl.protocols :refer [full? add! remove! close-buf!]]))
+
+(defmacro throws? [expr]
+  `(try
+     ~expr
+     false
+     (catch Throwable _# true)))
+
+(def warn-cnt (atom 0))
+
+(defn panick! [_]
+  (swap! warn-cnt inc))
+
+(deftest sliding-buffer-tests
+  (let [fb (panicking-sliding-buffer 2 panick! 1)]
+    (reset! warn-cnt 0)
+    (is (= 0 (count fb)))
+
+    (add! fb :1)
+    (is (= 1 (count fb)))
+
+    (add! fb :2)
+    (is (= 2 (count fb)))
+    (is (= 1 @warn-cnt))
+
+    (is (not (full? fb)))
+    (is (not (throws? (add! fb :3))))
+    (is (= 2 (count fb)))
+
+    (is (= :2 (remove! fb)))
+    (is (not (full? fb)))
+
+    (is (= 1 (count fb)))
+    (is (= :3 (remove! fb)))
+
+    (is (= 0 (count fb)))
+    (is (throws? (remove! fb)))))

test/narjure/test/control/flow.clj

@@ -0,0 +1,65 @@
+(ns narjure.test.control.flow
+  (:require
+    [clojure.test :refer :all]
+    [narjure.control.flow :refer :all]
+    [clojure.core.async :as as]))
+
+(deftest test-check-element-in-map
+  (let [m {:a 1 :b 2}]
+    (is (= 0 (:c (check-element-in-map [:c] m))))
+    (is (= [] (:c (check-element-in-map [:c] [] m))))
+    (is (= nil (:k (check-element-in-map [:c] [] m))))))
+
+(deftest test-all
+  (is (= #{:a :b :c :d :e}
+         (all [[:a :b]
+               [:a :c]
+               [:c :d]
+               [:c :e]]))))
+
+(defn some-var [])
+(deftest test-kw->var
+  (is (var? (kw->fn :narjure.control.flow/all)))
+  (is (var? (kw->fn ::some-var)))
+  (is (nil? (kw->fn ::wrong-var))))
+
+(def wf [[:a :b]
+         [:a :c]
+         [:a :d]
+         [:b :d]])
+
+(deftest test-fn-outputs
+  (let [outputs (fn-outputs wf 1)]
+    (is (= 4 (count (keys outputs))))
+    (is (every? nil? (map outputs [:c :d])))))
+
+(deftest test-fn-inputs
+  (is (= {[:d :c :b] [:a]
+          [:d]       [:b]}
+         (fn-inputs wf)))
+  (is (= {[:d :c :b] [:a]
+          [:k :d]    [:c :b]}
+         (fn-inputs (concat wf [[:c :d]
+                                [:c :k]
+                                [:b :k]])))))
+
+(def out (as/chan 2))
+(defn first-fn [data] (assoc data :fn1 :ok))
+(defn second-fn [data] (assoc data :fn2 :ok))
+(defn third-fn [data]
+  (as/>!! out (assoc data :fn3 :ok)))
+
+(def test-flow [[::first-fn ::second-fn]
+                [::second-fn ::third-fn]
+                [::first-fn ::third-fn]])
+
+(deftest test-generate-flow
+  (let [in (generate-flow test-flow {:buffer 2})]
+    (as/>!! in {})
+    (let [res [(as/<!! out) (as/<!! out)]]
+      (is (= #{{:fn1 :ok
+                :fn3 :ok}
+               {:fn1 :ok
+                :fn2 :ok
+                :fn3 :ok}}
+             (set res))))))

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)))))))