logging

Added najure.actors namespace and tidied up ns declarations

.gitignore

@@ -13,4 +13,5 @@ pom.xml.asc
 *.iml
 *~
 \#*\#
-.\#*
+.\#*
+*experiments.clj

README.md

@@ -1,3 +1,5 @@
+[![Circle CI](https://circleci.com/gh/jarradh/narjure/tree/master.svg?style=svg)](https://circleci.com/gh/jarradh/narjure/tree/master)
+
 # Narjure
 
 A Clojure implementation of the [Non-Axiomatic Reasoning System](https://github.com/opennars/opennars) proposed by Pei Wang.

project.clj

@@ -7,12 +7,18 @@
                  [org.clojure/core.logic "0.8.10"]
                  [instaparse "1.4.1"]
                  [com.rpl/specter "0.9.1"]
-                 [org.clojure/tools.nrepl "0.2.12"]]
+                 [org.clojure/tools.nrepl "0.2.12"]
+                 [org.clojure/data.priority-map "0.0.7"]
+                 [co.paralleluniverse/pulsar "0.7.4"]
+                 [org.immutant/immutant "2.1.2"]
+                 [clj-time "0.11.0"]
+                 [com.taoensso/timbre "4.3.1"]]
+  :java-agents [[co.paralleluniverse/quasar-core "0.7.4"]]
   :main ^:skip-aot narjure.core
   :plugins [[lein-cloverage "1.0.6"]
             [cider/cider-nrepl "0.11.0-SNAPSHOT"]]
   :target-path "target/%s"
-  :repl-options {:init-ns narjure.repl
-                 :nrepl-middleware
-                 [narjure.repl/narsese-handler]}
-  :profiles {:uberjar {:aot :all}})
+  :repl-options {:init-ns          narjure.repl
+                 :nrepl-middleware [narjure.repl/narsese-handler]}
+  :profiles {:uberjar {:aot :all}}
+  :jvm-opts ["-Dco.paralleluniverse.fibers.detectRunawayFibers=false"])

resources/narsese.bnf

@@ -1,80 +1,86 @@
 (* Narsese Grammar - https://github.com/opennars/opennars/wiki/Input-Output-Format *)
 
-             task ::= [budget] sentence                     (* task to be processed *)
+             task ::= [budget] sentence                       (* task to be processed *)
 
-         sentence ::= statement"." [tense] [truth]          (* judgement to be remembered *)
-                    | statement"?" [tense] [truth]          (* question to be answered, tense added in OpenNARS 1.7 *)
-                    | statement"@" [tense] [truth]          (* question on desire value to be answered, tense added in OpenNARS 1.7 *)
-                    | statement"!" [tense] [truth]          (* goal to be realized, tense added in OpenNARS 1.7 *)
+         sentence ::= statement"." [tense] [truth]            (* judgement to be remembered *)
+                    | statement"?" [tense] [truth]            (* question to be answered, tense added in OpenNARS 1.7 *)
+                    | statement"@" [tense] [truth]            (* question on desire value to be answered, tense added in OpenNARS 1.7 *)
+                    | statement"!" [tense] [desire]           (* goal to be realized, tense added in OpenNARS 1.7 *)
 
-        statement ::= <"<">term copula term<">">            (* two terms related to each other *)
-                    | <"(">term copula term<")">            (* two terms related to each other, new notation *)
-                    | term                                  (* a term can name a statement *)
-                    | "(^"word {","term} ")"                (* an operation to be executed *)
-                    | word"("term {","term} ")"             (* an operation to be executed, new notation *)
+        statement ::= <"<">term copula term<">">              (* two terms related to each other *)
+                    | <"(">term copula term<")">              (* two terms related to each other, new notation *)
+                    | term                                    (* a term can name a statement *)
+                    | "(^"word {","term} ")"                  (* an operation to be executed *)
+                    | word"("term {","term} ")"               (* an operation to be executed, new notation *)
 
-           copula ::= "-->"                                 (* inheritance *)
-                    | "<->"                                 (* similarity *)
-                    | "{--"                                 (* instance *)
-                    | "--]"                                 (* property *)
-                    | "{-]"                                 (* instance-property *)
-                    | "==>"                                 (* implication *)
-                    | "=/>"                                 (* predictive implication *)
-                    | "=|>"                                 (* concurrent implication *)
-                    | "=\\>"                                (* =\> retrospective implication *)
-                    | "<=>"                                 (* equivalence *)
-                    | "</>"                                 (* predictive equivalence *)
-                    | "<|>"                                 (* concurrent equivalence *)
+           copula ::= "-->"                                   (* inheritance *)
+                    | "<->"                                   (* similarity *)
+                    | "{--"                                   (* o-- instance *)
+                    | "--]"                                   (* --o property *)
+                    | "{-]"                                   (* o-o instance-property *)
+                    | "==>"                                   (* implication *)
+                    | "=/>"                                   (* =+> predictive implication *)
+                    | "=|>"                                   (* concurrent implication *)
+                    | "=\\>"                                  (* =-> retrospective implication *)
+                    | "<=>"                                   (* equivalence *)
+                    | "</>"                                   (* <+> predictive equivalence *)
+                    | "<|>"                                   (* concurrent equivalence *)
 
-             term ::= word                                  (* an atomic constant term *)
-                    | variable                              (* an atomic variable term *)
-                    | compound-term                         (* a term with internal structure *)
-                    | statement                             (* a statement can serve as a term *)
-                    | interval                              (* time measure between events *)
+             term ::= word                                    (* an atomic constant term *)
+                    | variable                                (* an atomic variable term *)
+                    | compound-term                           (* a term with internal structure *)
+                    | statement                               (* a statement can serve as a term *)
+                    | interval                                (* time measure between events *)
 
-    compound-term ::= "{" term {","term} "}"                (* extensional set *)
-                    | "[" term {","term} "]"                (* intensional set *)
-                    | "("op-multi","term{","term} ")"       (* compound term with infix operator *)
-                    | "("op-single","term"," term ")"       (* compound term with infix operator *)
-                    | "(" term {","term} ")"                (* product, new notation *)
-                    | "(/," term {","term} ")"              (* extensional image *)
-                    | "(\\," term {","term} ")"             (* \ intensional image *)
-                    | "(--," term ")"                       (* negation *)
-                    | "--"term                              (* negation, new notation *)
+    compound-term ::= op-ext-set term {"," term} "}"          (* extensional set *)
+                    | op-int-set term {"," term} "]"          (* intensional set *)
+                    | "("op-multi"," term {"," term} ")"      (* with prefix operator *)
+                    | "("op-single"," term "," term ")"       (* with prefix operator *)
+                    | "(" term {op-multi term} ")"            (* with infix operator *)
+                    | "(" term op-single term ")"             (* with infix operator *)
+                    | op-product term {","term} ")"           (* product, new notation *)
+                    | "(" op-ext-image "," term {"," term} ")"(* special case, extensional image *)
+                    | "(" op-int-image "," term {"," term} ")"(* special case, \ intensional image *)
+                    | "(" op-negation "," term ")"            (* negation *)
+                    | op-negation term                        (* negation, new notation *)
 
-                    (* new compound-term notation *)
+        op-product::= "("                                     (* product *)
+        op-int-set::= "["                                     (* intensional set *)
+        op-ext-set::= "{"                                     (* extensional set *)
+       op-negation::= "--"                                    (* negation *)
+      op-int-image::= "\\"                                    (* \ intensional image *)
+      op-ext-image::= "/"                                     (* extensional image *)
+         op-multi ::= "&&"                                    (* conjunction *)
+                    | "*"                                     (* product *)
+                    | "||"                                    (* disjunction *)
+                    | "&|"                                    (* parallel conjunction (of events) *)
+                    | "&/"                                    (* sequential conjunction (of events) *)
+                    | "|"                                     (* intensional intersection *)
+                    | "&"                                     (* extensional intersection *)
+        op-single ::= "-"                                     (* extensional difference *)
+                    | "~"                                     (* intensional difference *)
 
-                    | "(" term {op-multi term} ")"    (* compound term with infix operator *)
-                    | "(" term op-single term ")"     (* compound term with infix operator *)
+         variable ::= "$"word                                 (* independent variable *)
+                    | "#"word                                 (* dependent variable *)
+                    | "?"word                                 (* query variable in question *)
 
-         op-multi ::= "&&"                                  (* conjunction *)
-                    | "*"                                   (* product *)
-                    | "||"                                  (* disjunction *)
-                    | "&|"                                  (* parallel events *)
-                    | "&/"                                  (* sequential events *)
-                    | "|"                                   (* intensional intersection *)
-                    | "&"                                   (* extensional intersection *)
+            tense ::= ":/:"                                   (* future event *)
+                    | ":|:"                                   (* present event *)
+                    | ":\\:"                                  (* :\: past event *)
+                    | <":">#"\d+"<":">                        (* defined event, output only *)
 
-        op-single ::= "-"                                   (* extensional difference *)
-                    | "~"                                   (* intensional difference *)
+         interval ::= <"/">#"\d+"                             (* integer *)
 
-         variable ::= "$"word                               (* independent variable *)
-                    | "#"[word]                             (* dependent variable *)
-                    | "?"[word]                             (* query variable in question *)
+            truth ::= <"%">frequency[<";">confidence]<"%">    (* two numbers in [0,1]x(0,1) *)
+           desire ::= <"%">plausibility[<";">desirability]<"%"> (* two numbers in [0,1]x(0,1) *)
+           budget ::= <"$">priority[<";">durability][<";">quality]<"$"> (* three numbers in [0,1]x(0,1)x[0,1] *)
 
-            tense ::= ":/:"                                 (* future event *)
-                    | ":|:"                                 (* present event *)
-                    | ":\\:"                                (* :\: past event *)
-                    | <":">#"\d+"<":">                      (* defined event, output only *)
+               word : #"\w+"                                  (* unicode string *)    
+           priority : #"([0]?\.[0-9]+|1\.[0]*|1|0)"           (* 0 <= x <= 1 *)
+         durability : #"[0]?\.[0]*[1-9]{1}[0-9]*"             (* 0 <  x <  1 *)
+            quality : #"([0]?\.[0-9]+|1\.[0]*|1|0)"           (* 0 <= x <= 1 *)
+          frequency : #"([0]?\.[0-9]+|1\.[0]*|1|0)"           (* 0 <= x <= 1 *)
+         confidence : #"[0]?\.[0]*[1-9]{1}[0-9]*"             (* 0 <  x <  1 *)
+       plausibility : #"([0]?\.[0-9]+|1\.[0]*|1|0)"           (* 0 <= x <= 1 *)
+       desirability : #"[0]?\.[0]*[1-9]{1}[0-9]*"             (* 0 <  x <  1 *)
 
-         interval ::= <"/">#"\d+"                           (* integer *)
-
-            truth ::= <"%">frequency[<";">confidence]<"%">  (* two numbers in [0,1]x(0,1) *)
-           budget ::= <"$">priority[<";">durability][<";">quality]<"$">   (* three numbers in [0,1]x(0,1)x[0,1] *)
-
-               word : #"\w+"                                (* unicode string *)    
-           priority : #"([0]?\.[0-9]+|1|0)"                 (* 0 <= x <= 1 *)
-         durability : #"[0]?\.[0]*[1-9]{1}[0-9]*"           (* 0 <  x <  1 *)
-            quality : #"([0]?\.[0-9]+|1|0)"                 (* 0 <= x <= 1 *)
-          frequency : #"([0]?\.[0-9]+|1|0)"                 (* 0 <= x <= 1 *)
-         confidence : #"[0]?\.[0]*[1-9]{1}[0-9]*"           (* 0 <  x <  1 *)

src/nal/core.clj

@@ -14,7 +14,7 @@
          instance property ext-set int-set product negation
          inst-prop ext-difference revision inference equivalence
          inference2 inference3 equivalence-list reduceo replace-var
-         replace-all implication)
+         replace-all implication choice)
 
 ;===============================================================================
 ;revision

src/narjure/actor/active_concept_collator.clj

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

src/narjure/actor/anticipated_event.clj

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

src/narjure/actor/concept.clj

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

src/narjure/actor/concept_creator.clj

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

src/narjure/actor/cross_modal_integrator.clj

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

src/narjure/actor/derived_task_creator.clj

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

src/narjure/actor/forgettable_concept_collator.clj

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

src/narjure/actor/general_inferencer.clj

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

src/narjure/actor/operator_executor.clj

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

src/narjure/actor/persistence_manager.clj

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

src/narjure/actor/sentence_parser.clj

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

src/narjure/actor/system_time.clj

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

src/narjure/actor/task_dispatcher.clj

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

src/narjure/actor/utils.clj

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

src/narjure/bag.clj

@@ -0,0 +1,53 @@
+(ns narjure.bag
+  (:require [clojure.data.priority-map :refer [priority-map-keyfn-by]]))
+
+;TODO take/get semantic and names to be decided
+(defprotocol Bag
+  (put-el [this item])
+  (get-el [this] [this k])
+  (remove-el [this k])
+  (take-el [this] [this k])
+  (count-els [this]))
+
+;TODO must be discussed
+(defn randomize-priority [priority]
+  (* (rand) priority))
+
+(defn assoc-to-bag
+  "Set some random priority for a new item and slice map."
+  [col {:keys [key priority] :as v} capacity]
+  (let [ncol (->> (randomize-priority priority)
+                  (assoc v :rand-priority)
+                  (assoc col key))]
+    (if (> (count ncol) capacity)
+      (let [[k] (last ncol)]
+        (dissoc ncol k))
+      ncol)))
+
+(defrecord DefaultBag [capacity queue]
+  Bag
+  (put-el [_ item]
+    (DefaultBag. capacity (assoc-to-bag queue item capacity)))
+  (get-el [_] (second (peek queue)))
+  (get-el [_ key] (when-let [el (queue key)] el))
+  (remove-el [_ key] (DefaultBag. capacity (dissoc queue key)))
+  (take-el [bag]
+    (when-let [el (get-el bag)]
+      [el (remove-el bag (:key el))]))
+  (take-el [bag k]
+    (when-let [el (get-el bag k)]
+      [el (remove-el bag k)]))
+  (count-els [_] (count queue)))
+
+(defn default-bag
+  ([] (default-bag 100))
+  ([capacity]
+   (DefaultBag. capacity (priority-map-keyfn-by :rand-priority >))))
+
+(extend-protocol Bag
+  nil
+  (put-el [_ el] (put-el (default-bag) el))
+  (get-el ([_]) ([_ _]))
+  (remove-el [_ _] (default-bag))
+  (take-el ([_]) ([_ _]))
+  (count-els [_] 0))

src/narjure/core.clj

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

src/narjure/cycle.clj

@@ -0,0 +1,292 @@
+(ns narjure.cycle
+  (:require [narjure.bag :refer :all]
+            [narjure.narsese :refer [parse]]
+            [clojure.core.logic :as l]
+            [nal.core :as c]
+            [clojure.set :refer [intersection union]]))
+
+;TODO think about modules
+
+(declare task->buffer)
+
+;TODO create record for memory abstraction, but only after
+;api will become more/less stable
+(defn memory [buffer concepts]
+  {:concepts            concepts
+   :cycles-cnt          0
+   :tasks-cnt           0
+   :buffer              buffer
+   :local-inf-results   #{}
+   :forward-inf-results #{}
+   :answers             []})
+
+(defn default-memory
+  ([] (default-memory 100 100))
+  ([buffer-capacity concepts-capacity]
+   (memory (default-bag buffer-capacity)
+           (default-bag concepts-capacity))))
+
+(defn default-concept [term]
+  {:key      term
+   :priority 1
+   :tasks    (default-bag 100)
+   :beliefs  (default-bag 100)
+   ;here will be the map with patterns for possible questions
+   :answers  {}})
+
+(defn get-concept [concepts term]
+  "Check for concept in database, creates new in case in didn't find it."
+  (if-let [concept (get-el concepts term)]
+    concept
+    (default-concept term)))
+
+(defn overlapping-evidences?
+  [belief task]
+  (let [belief-ev-base (:evidental-base belief)
+        task-ev-base (:evidental-base task)]
+    (not-empty (intersection belief-ev-base task-ev-base))))
+
+;TODO should be configurable
+(def max-ev-base 100)
+
+(defn total-ev-base
+  ;TODO https://github.com/opennars/opennars/wiki/Stamp-In-NARS#evidential-base
+  [b1 b2]
+  (let [b1-ev-base (:evidental-base b1)
+        b2-ev-base (:evidental-base b2)]
+    (set (take max-ev-base (union b1-ev-base b2-ev-base)))))
+
+;TODO bad name for function
+(defn inf-statement
+  [{:keys [statement truth]}]
+  [statement truth])
+
+(defn raw-choice [b t]
+  (first (l/run* [q] (c/choice b t q))))
+
+(defn choice [belief task]
+  (let [b (inf-statement belief)
+        t (inf-statement task)
+        [statement truth] (raw-choice b t)]
+    {:statement      statement
+     :key            statement
+     :truth          truth
+     :evidental-base (total-ev-base belief task)}))
+
+(defn revision [belief task]
+  ;TODO selecting the one with lower complexity here
+  ;<(&/,<tim --> cat>,<tom --> cat>) =/> <sam --> cat>>.
+  ;<<tim --> cat> =/> <sam --> cat>>.
+  ;<?how =/> <sam --> cat>>?
+  ;
+  ;<<tim --> cat> =/> <sam --> cat>>. :12791129: %1.00;0.90%
+  ;
+  ; because the other ranking params, truth expectation and originality are in
+  ; both cases the same, so complexity is the determining factor
+  ; in this case
+  (let [b (inf-statement belief)
+        t (inf-statement task)
+        [statement truth] (first (l/run* [q] (c/revision b t q)))]
+    {:statement      statement
+     :key            statement
+     :truth          truth
+     :evidental-base (total-ev-base belief task)}))
+
+(defn local-inference
+  "Revision/choice"
+  [belief task]
+  (when belief
+    (if (overlapping-evidences? belief task)
+      (choice belief task)
+      (revision belief task))))
+
+(defn possible-questions
+  "Vector of questions that can be answered by the term."
+  [[copula term1 term2 :as term]]
+  [term [copula term1 '_0] [copula '_0 term2]])
+
+(defn choice-with-nil [b t]
+  (if (nil? b)
+    t
+    (choice b t)))
+
+(defn update-answers
+  [concept questions belief]
+  (reduce
+    (fn [c q]
+      (update-in c [:answers q] choice-with-nil belief))
+    concept questions))
+
+(defmulti task->concept (fn [& args] (:task-type (first args))))
+
+(defmethod task->concept :question
+  [{:keys [statement] :as task} {:keys [concepts] :as m} term]
+  (let [concept (get-concept concepts term)
+        answer (get-in concept [:answers statement])
+        upd-concept (-> concept
+                        (update :tasks put-el task))
+        upd-m (update m :concepts put-el upd-concept)]
+    (if answer
+      (update upd-m :answers conj [task answer])
+      (task->buffer upd-m task))))
+
+(defmethod task->concept :default
+  [{:keys [statement] :as task} {:keys [concepts] :as m} term]
+  (let [{:keys [beliefs] :as concept} (get-concept concepts term)
+        belief (get-el beliefs statement)
+        result (local-inference belief task)
+        task (if result (merge task result) (assoc task :key statement))
+        questions (possible-questions statement)
+        upd-concept (-> concept
+                        (update :beliefs put-el task)
+                        (update :tasks put-el task)
+                        (update-answers questions task))
+        upd-m (update m :concepts put-el upd-concept)]
+    (if result
+      (update upd-m :local-inf-results conj result)
+      upd-m)))
+
+(defn task->concepts
+  [m {:keys [terms] :as task}]
+  (reduce (partial task->concept task) m terms))
+
+(def tasks-to-fetch 100)
+
+(defn buffer->tasks
+  "Fetch portion of tasks from the buffer for processing"
+  [{:keys [buffer] :as m}]
+  (let [[buffer tasks]
+        (reduce (fn [[buf tasks] _]
+                  (let [[task buf] (take-el buf)]
+                    [buf (conj tasks task)])) [buffer []]
+                (range tasks-to-fetch))]
+    (assoc m :buffer buffer
+             :tasks tasks)))
+
+(defn filling-tasks
+  "1. Select tasks in the buffer to insert into the corresponding concepts,
+  which may include the creation of new concepts (I'm not sure about the rest)
+  and beliefs, as well as direct processing on the tasks."
+  [{:keys [tasks] :as m}]
+  (dissoc (reduce task->concepts m tasks) :tasks))
+
+(defn forward-inference [task belief]
+  (let [t (inf-statement task)
+        b (inf-statement belief)
+        conclusions (l/run* [q] (c/inference t b q))
+        total-ev-base (total-ev-base belief task)]
+    (map (fn [[statement truth]]
+           {:statement      statement
+            :key            statement
+            :truth          truth
+            :evidental-base total-ev-base})
+         conclusions)))
+
+(defn inference
+  "2. Select a concept from the memory, then select a task and a belief
+  from the concept.
+  3. Feed the task and the belief to the inference engine
+  to produce derived tasks."
+  [{:keys [concepts] :as m}]
+  (let [;select concept
+        [{:keys [tasks beliefs] :as concept} concepts] (take-el concepts)
+        ;select task
+        [{:keys [statement] :as task} tasks] (take-el tasks)
+        same-belief (get-el beliefs statement)
+        ;select belief
+        [belief beliefs] (take-el (remove-el beliefs statement))]
+    (if (and task belief)
+      ;if both task and belief were found start inference
+      ;just return memory otherwise
+      (let [new-tasks (forward-inference task belief)
+            ;update memory, putting tasks/beliefs/concepts back
+            upd-beliefs (-> beliefs
+                            (put-el belief)
+                            (put-el same-belief))
+            upd-concept (assoc concept :beliefs upd-beliefs
+                                       :tasks tasks)
+            upd-concepts (put-el concepts upd-concept)]
+        (->
+          ;filling buffer via new tasks and update memory
+          (reduce task->buffer m new-tasks)
+          (assoc :concepts upd-concepts)
+          (update :forward-inf-results union (set new-tasks))))
+      (update m :concepts put-el (update concept :priority - 0.4)))))
+
+(defn print-results! [{:keys [local-inf-results
+                              forward-inf-results
+                              answers] :as m}]
+  (when (not-empty local-inf-results)
+    (println "Local inference:")
+    (doall (map (fn [r] (println (inf-statement r))) local-inf-results)))
+  (when (not-empty forward-inf-results)
+    (println "Forward inference:")
+    (doall (map (fn [r] (println (inf-statement r))) forward-inf-results)))
+  (when (not-empty answers)
+    (println "Answers:")
+    (doall (map (fn [[q a]]
+                  (println (:statement q) "? " a))
+                answers))))
+
+(defn choose-answers
+  [{:keys [answers] :as m}]
+  (let [by-question (group-by first answers)]
+    (assoc m :answers
+             (map (fn [[q ans]]
+                    [q (reduce raw-choice (map inf-statement
+                                               (map second ans)))])
+                  by-question))))
+
+(defn do-cycle
+  "The cycle of NARS."
+  [memory]
+  (-> memory
+      (update :cycles-cnt inc)
+      buffer->tasks
+      filling-tasks
+      inference
+      choose-answers))
+
+;TODO what is default priority for the tasks that arrived from the inference?
+(defn task-priority [_] 0.8)
+
+(defn pack-task
+  "Adds some properties to the task to make usable in Bag"
+  ;TODO should be moved somewhere
+  [task cycle n]
+  (merge task
+         {;TODO hash to be replaced
+          :key            (hash task)
+          :priority       (task-priority task)
+          :cycle          cycle
+          ;TODO data structure for evidental base should be discussed
+          :evidental-base #{n}}))
+
+(defn task->buffer
+  "Put task into the buffer."
+  [{:keys [cycles-cnt tasks-cnt] :as m} t]
+  (let [n-task (inc tasks-cnt)]
+    (assoc (->> (pack-task t cycles-cnt n-task)
+                (update m :buffer put-el))
+      :tasks-cnt n-task)))
+
+(defn fill-memory [& expression]
+  (reduce #(task->buffer %1 (parse %2)) (default-memory) expression))
+
+(defn do-cycles [m n]
+  (reduce (fn [m _] (do-cycle m)) m (range n)))
+
+(defn do-cycles-no-results [n m]
+  (do (do-cycles n m) nil))
+
+(comment
+  (def m (fill-memory "<sport --> competition>."
+                      "<chess --> competition>. %0.90%"))
+  (def mq (fill-memory "<bird --> swimmer>."
+                       "<bird --> swimmer>?"))
+  (def mqq
+    (-> (default-memory)
+        (task->buffer (parse "<bird --> swimmer>."))
+        do-cycle
+        (task->buffer (parse "<bird --> swimmer>?"))
+        do-cycle)))

src/narjure/defaults.clj

@@ -0,0 +1,31 @@
+(ns narjure.defaults)
+
+(def judgement-frequency 1.0)
+(def judgement-confidence 0.9)
+
+(def truth-value
+  [judgement-frequency judgement-confidence])
+
+(def judgement-priority 0.5)
+(def judgement-durability 0.8)
+;todo clarify this
+(def judgement-quality 0.5)
+
+(def judgement-budget
+  [judgement-priority judgement-durability judgement-quality])
+
+(def question-priority 0.5)
+(def question-durability 0.9)
+;todo clarify this
+(def question-quality 0.5)
+
+(def question-budget
+  [judgement-priority judgement-durability judgement-quality])
+
+(def goal-confidence 0.9)
+(def goal-priority 0.5)
+(def goal-durability 0.8)
+
+(def budgets
+  {:judgement judgement-budget
+   :question question-budget})

src/narjure/narsese.clj

@@ -1,6 +1,7 @@
 (ns narjure.narsese
   (:require [instaparse.core :as i]
-            [clojure.java.io :as io]))
+            [clojure.java.io :as io]
+            [narjure.defaults :refer :all]))
 
 (def bnf-file "narsese.bnf")
 
@@ -23,42 +24,39 @@
    "<|>"  'concurrent-equivalence})
 
 (def compound-terms
-  {"{"    'ext-set
-   "["    'int-set
-   "(&,"  'ext-intersection
-   "&"    'ext-intersection
-   "(|,"  'int-intersection
-   "|"    'int-intersection
-   "(-,"  'ext-difference
-   "-"    'ext-difference
-   "(~,"  'int-difference
-   "~"    'int-difference
-   "(*,"  'product
-   "*"    'product
-   "("    'product
-   "(/,"  'ext-image
-   "(\\," 'int-image
-   "(--," 'negation
-   "--"   'negation
-   "(||," 'disjunction
-   "||"   'disjunction
-   "(&&," 'conjunction
-   "&&"   'conjunction
-   "(&/," 'sequential-events
+  {"{"  'ext-set
+   "["  'int-set
+   "&"  'ext-intersection
+   "|"  'int-intersection
+   "-"  'ext-difference
+   "~"  'int-difference
+   "*"  'product
+   "("  'product
+   "/"  'ext-image
+   "\\" 'int-image
+   "--" 'negation
+   "||" 'disjunction
+   "&&" 'conjunction
    "&/" 'sequential-events
-   "(&|," 'parallel-events
-   "&|" 'parallel-events
-   })
+   "&|" 'parallel-events})
+
+(def tenses
+  {":|:"  :present
+   ":/:"  :future
+   ":\\:" :past})
 
 (defn get-compound-term [[_ operator-srt]]
   (compound-terms operator-srt))
 
-(def actions {"." :judgement
-              "?" :question})
+(def task-types {"." :judgement
+                 "?" :question})
 
-(def ^:dynamic *action* (atom nil))
+(def ^:dynamic *task-type* (atom nil))
 (def ^:dynamic *lvars* (atom []))
 (def ^:dynamic *truth* (atom []))
+(def ^:dynamic *budget* (atom []))
+(def ^:dynamic *tense* (atom :present))
+(def ^:dynamic *syntactic-complexity* nil)
 
 (defn keep-cat [fun col]
   (into [] (comp (mapcat fun) (filter (complement nil?))) col))
@@ -73,29 +71,41 @@
 
 (defmethod element :sentence [[_ & data]]
   (let [filtered (group-by string? data)]
-    (reset! *action* (actions (first (filtered true))))
-    (keep element (filtered false))))
+    (reset! *task-type* (task-types (first (filtered true))))
+    (let [cols (filtered false)
+          last-el (last cols)]
+      (when (= :truth (first last-el))
+        (element last-el))
+      (when-let [tense (some #(when (= :tense (first %)) %) data)]
+        (element tense))
+      (element (first cols)))))
 
 (defmethod element :statement [[_ & data]]
   (if-let [copula (get-copula data)]
-    `[~copula ~@(keep-cat element data)]
+    (do
+      (swap! *syntactic-complexity* inc)
+      `[~copula ~@(keep-cat element data)])
     (keep-cat element data)))
 
 (defmethod element :task [[_ & data]]
   `[~@(keep-cat element data)])
 
-(defmethod element :compound-term [[_ _ & data]]
-  (let [first-el-type (get-in (vec data) [0 0])
-        comp-operator ((if (= :term first-el-type) second first) data)]
+;looks strange but it is because of special syntax for negation --bird.
+(defn get-comp-operator [second-el data]
+  (let [first-el-type (get-in (vec data) [0 0])]
+    (if (some #{(first second-el)} [:op-negation :op-int-set
+                                    :op-ext-set :op-product])
+      second-el
+      ((if (= :term first-el-type) second first) data))))
+
+(defmethod element :compound-term [[_ second-el & data]]
+  (let [comp-operator (get-comp-operator second-el data)]
     `[~(get-compound-term comp-operator)
       ~@(keep-cat element (remove string? data))]))
 
-(defmethod element :copula [_])
-(defmethod element :op-multi [_])
-(defmethod element :op-single [_])
-
-(defmethod element :variable [[_ _ [_ v]]]
-  (let [v (symbol v)]
+(def var-prefixes {"#" "d_" "?" "?"})
+(defmethod element :variable [[_ type [_ v]]]
+  (let [v (symbol (str (var-prefixes type) v))]
     (swap! *lvars* conj v)
     v))
 
@@ -109,30 +119,64 @@
   [[_ & data]]
   `[[~@(mapv element data)]])
 
-(defmethod element :frequency [[_ d]]
-  (let [d (Double/parseDouble d)]
-    (swap! *truth* conj d) d))
-(defmethod element :confidence [[_ d]]
-  (let [d (Double/parseDouble d)]
-    (swap! *truth* conj d) d))
-(defmethod element :priority [[_ d]] (Double/parseDouble d))
-(defmethod element :durability [[_ d]] (Double/parseDouble d))
+(defmacro double-element [n a]
+  `(defmethod element ~n [[t# d#]]
+     (let [d# (Double/parseDouble d#)]
+       (swap! ~a conj d#) d#)))
 
-(defmethod element :default [[_ & data]]
+(double-element :frequency *truth*)
+(double-element :confidence *truth*)
+(double-element :priority *budget*)
+(double-element :durability *budget*)
+(double-element :quality *budget*)
+
+(defmethod element :task [[_ & data]]
+  (when (= :budget (first (first data)))
+    (element (first data)))
+  (element (last data)))
+
+(defmethod element :term [[_ & data]]
+  (swap! *syntactic-complexity* inc)
   (when (seq? data)
     (keep element data)))
 
+(defmethod element :tense [[_ key]]
+  (reset! *tense* (tenses key)))
+
+(defmethod element :default [_])
+
+;TODO check for variables in statemnts, ignore subterm if it contains variable
+(defn terms
+  "Fetch terms from task."
+  [statement]
+  (into #{statement} (rest statement)))
+
+(defn check-truth-value [v]
+  (concat v (nthrest truth-value (count v))))
+
+(defn check-budget [v act]
+  (let [budget (budgets act)]
+    (concat v (nthrest budget (count v)))))
+
 (defn parse
   "Parses a Narsese string into task ready for inference"
   [narsese-str]
   (let [data (parser narsese-str)]
     (if-not (i/failure? data)
-      (binding [*action* (atom nil)
+      (binding [*task-type* (atom nil)
                 *lvars* (atom [])
-                *truth* (atom [])]
-        (let [parsed-code (element data)]
-          {:action @*action*
-           :lvars  @*lvars*
-           :truth  @*truth*
-           :data   parsed-code}))
+                *truth* (atom [])
+                *budget* (atom [])
+                *tense* (atom :present)
+                *syntactic-complexity* (atom 0)]
+        (let [statement (element data)
+              act @*task-type*]
+          {:task-type            act
+           :lvars                @*lvars*
+           :truth                (check-truth-value @*truth*)
+           :budget               (check-budget @*budget* act)
+           :statement            statement
+           :tense                @*tense*
+           :syntactic-complexity @*syntactic-complexity*
+           :terms                (terms statement)}))
       data)))

src/narjure/repl.clj

@@ -4,7 +4,10 @@
             [instaparse.core :as i]
             [nal.core :as c]
             [clojure.core.logic :as l]
-            [clojure.tools.nrepl.middleware :refer [set-descriptor!]]))
+            [clojure.string :refer [trim]]
+            [clojure.pprint :as p]
+            [clojure.tools.nrepl.middleware :refer [set-descriptor!]]
+            [narjure.cycle :as cycle]))
 
 (defonce narsese-repl-mode (atom false))
 
@@ -16,34 +19,14 @@
   (reset! narsese-repl-mode false)
   (println "Narsese repl was stopped."))
 
-(defonce db (atom {}))
-(defonce buffer (atom []))
+(defonce db (atom (cycle/default-memory)))
 
-(defn clear-db! [] (reset! db {}))
-(defn clear-buffer! [] (reset! buffer {}))
+(defn clear-db! [] (reset! db (cycle/default-memory)))
 
-(defmulti collect! :action)
-
-(defn revision! [statement known-truth truth]
-  ;I think that core.logic usage is not necesssary for revision calculation
-  (let [[[_ new-truth]]
-        (l/run* [q]
-          (c/revision [statement known-truth] [statement truth] q))]
-    (swap! db assoc statement new-truth)
-    [statement new-truth]))
-
-(defn inference [n st1 st2]
-  (l/run n [q] (c/inference st1 st2 q)))
-
-(defmethod collect! :judgement [{:keys [truth data]}]
-  (let [truth (if (empty? truth) [1 0.9] truth)
-        statement (first data)
-        known-truth (@db statement)]
-    (cond (nil? known-truth) (do (swap! db assoc statement truth) [statement truth])
-          (not= known-truth truth) (revision! statement known-truth truth)
-          :default [statement known-truth])))
-
-(defmethod collect! :default [_])
+(defn collect!
+  [{:keys [statement truth] :as task}]
+  (swap! db cycle/task->buffer task)
+  [statement truth])
 
 (defn- parse-int [s]
   (try (Integer/parseInt s) (catch Exception _)))
@@ -51,28 +34,26 @@
 (defn- wrap-code [code]
   (str "(narjure.repl/handle-narsese \"" code "\")"))
 
-(defn- sentence [{:keys [data]}]
-  (let [statement (first data)]
-    [statement (@db statement)]))
-
 (defn run [n]
-  (let [last-two (map sentence (take-last 2 @buffer))
-        forward (apply inference n last-two)
-        backward (if (> n (count forward))
-                   (apply inference n (reverse last-two))
-                   [])]
-    (into forward backward)))
+  (swap! db cycle/do-cycles n)
+  (cycle/print-results! @db)
+  (swap! db dissoc :forward-inf-results :local-inf-results :answers)
+  nil)
+
+(defn- get-result [code]
+  (let [result (parse code)]
+    (if (and (not (i/failure? result)))
+      (collect! result)
+      result)))
 
 (defn handle-narsese [code]
-  (if-let [n (parse-int (clojure.string/trim code))]
-    (run n)
-    (if (= "stop!" (clojure.string/trim code))
-      (stop-narsese-repl!)
-      (let [result (parse code)]
-        (if (and (not (i/failure? result)))
-          (do (swap! buffer conj result)
-              (collect! result))
-          result)))))
+  (let [n (parse-int (trim code))]
+    (cond
+      (integer? n) (do (run n) nil)
+      (= "stop!" (trim code)) (stop-narsese-repl!)
+      (= \* (first code)) (do (clear-db!) nil)
+      (= \/ (first code)) ""
+      :default (get-result code))))
 
 (defn narsese-handler [handler]
   (fn [args & tail]

test/narjure/test/bag.clj

@@ -0,0 +1,22 @@
+(ns narjure.test.bag
+  (:require [clojure.test :refer :all]
+            [narjure.bag :refer :all]))
+
+(defn abc-bag
+  ([] (abc-bag 3))
+  ([cap] (-> (default-bag cap)
+             (put-el {:key :a :priority 0.7})
+             (put-el {:key :b :priority 0.7})
+             (put-el {:key :c :priority 0.7}))))
+
+(def a-bag (put-el (default-bag) {:key :a :priority 0.7}))
+
+(deftest test-bag
+  (is (= 3 (count-els (abc-bag))))
+  (is (= 2 (count (-> (default-bag)
+                      (put-el {:key :a :priority 0.7})
+                      (put-el {:key :b :priority 0.7})
+                      (put-el {:key :a :priority 0.7})
+                      :queue))))
+  (is (= 2 (count-els (abc-bag 2))))
+  (is (nil? (get-el a-bag :b))))

test/narjure/test/cycle.clj

@@ -0,0 +1,16 @@
+(ns narjure.test.cycle
+  (:require [clojure.test :refer :all]
+            [narjure.cycle :refer :all]))
+
+(def b1 {:truth          [1.0 0.9]
+         :evidental-base #{1}
+         :statement      '[inheritance bird swimmer]})
+(def b2 {:truth          [0.1 0.6]
+         :evidental-base #{2}
+         :statement      '[inheritance bird swimmer]})
+
+(deftest test-local-inference
+  (is (= [0.8714285714285714 0.9130434782608696]
+         (:truth (local-inference b1 b2))))
+  (is (= [1.0 0.9]
+         (:truth (local-inference b1 (assoc b2 :evidental-base #{1 2}))))))

test/narjure/test/narsese.clj

@@ -3,19 +3,28 @@
             [narjure.narsese :refer :all]
             [instaparse.core :refer [failure?]]))
 
-(defn narsese->clj [s] (:data (parse s)))
+(defn narsese->clj [s] (:statement (parse s)))
 (defn get-truth [s] (:truth (parse s)))
 
 (deftest test-parser
-  (is (= '([[conjunction [inheritance tim fish] [inheritance tom fish]]])
+  (is (= '[[conjunction [inheritance tim fish] [inheritance tom fish]]]
          (narsese->clj "(&&, <tim --> fish>, <tom --> fish>).")))
-  (is (= '([[conjunction [inheritance tim fish] [inheritance tom fish]]])
+  (is (= '[[conjunction [inheritance tim fish] [inheritance tom fish]]]
          (narsese->clj "(<tim --> fish> && <tom --> fish>).")))
-  (is (= '([[conjunction [inheritance tim fish] [inheritance tom fish]]])
+  (is (= '[[conjunction [inheritance tim fish] [inheritance tom fish]]]
          (narsese->clj "((tim --> fish) && (tom --> fish)).")))
-  (is (= '([inheritance bird swimmer])
+  (is (= '[inheritance bird swimmer]
          (narsese->clj "<bird --> swimmer>.")))
-  (is (= [1.0 0.9] (get-truth "<bird --> swimmer>. %1;0.9%"))))
+  (is (= [1.0 0.9] (get-truth "<bird --> swimmer>. %1;0.9%")))
+  (is (= '[[negation bird]] (narsese->clj "--bird.")))
+  (is (= '[[negation bird]] (narsese->clj "(--,bird).")))
+  (is (= '[[int-image bird animal]] (narsese->clj "(\\,bird,animal).")))
+  (is (= '[[conjunction [inheritance d_1 [int-set red]] [inheritance d_1 apple]]]
+         (narsese->clj "(&&,<#1 --> [red]>,<#1 --> apple>).")))
+  (is (= '[retrospective-implication
+           [inheritance [product x room_101] enter]
+           [inheritance [product x door_101] open]]
+         (narsese->clj "<<( $x, room_101) --> enter> =\\> <( $x, door_101) --> open>>. %0.9;0.1%"))))
 
 (deftest test-numbers-validation
   (is (not (failure? (parse "<bird --> swimmer>. %1;0.9%"))))
@@ -30,5 +39,7 @@
   (is (not (failure? (parse "<bird --> swimmer>. %0.1;0.9%"))))
   (is (not (failure? (parse "<bird --> swimmer>. %0.0;0.9%"))))
   (is (not (failure? (parse "<bird --> swimmer>. %0;0.9%"))))
+  (is (not (failure? (parse "<bird --> swimmer>. %1.00;0.9%"))))
+  (is (not (failure? (parse "<bird --> swimmer>. %1.;0.9%"))))
   (is (failure? (parse "<bird --> swimmer>. %5;0.9%")))
   (is (failure? (parse "<bird --> swimmer>. %-1;0.9%"))))