add desire value with plausibility and desirability

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

@@ -3,7 +3,7 @@
   :url "https://github.com/jarradh/narjure"
   :license {:name "GNU General Public License 2.0"
             :url  "http://www.gnu.org/licenses/old-licenses/gpl-2.0.html"}
-  :dependencies [[org.clojure/clojure "1.7.0"]
+  :dependencies [[org.clojure/clojure "1.8.0"]
                  [org.clojure/core.logic "0.8.10"]
                  [instaparse "1.4.1"]
                  [com.rpl/specter "0.9.1"]
@@ -13,7 +13,6 @@
   :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]}
+  :repl-options {:init-ns          narjure.repl
+                 :nrepl-middleware [narjure.repl/narsese-handler]}
   :profiles {:uberjar {:aot :all}})

resources/narsese.bnf

@@ -1,81 +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 ::= op-ext-set term {","term} "}"                (* extensional set *)
-                    | op-int-set term {","term} "]"                (* intensional set *)
-                    | "("op-multi","term{","term} ")"       (* compound term with prefix operator *)
-                    | "("op-single","term"," term ")"       (* compound term with prefix operator *)
-                    | "(" term {op-multi term} ")"          (* compound term with infix operator *)
-                    | "(" term op-single term ")"           (* compound term with infix operator *)
-                    | "(" term {","term} ")"                (* product, new notation *)
-                    | "(" op-ext-image "," term {","term} ")" (* extensional image *)
-                    | "(" op-int-image "," term {","term} ")" (* \ intensional image *)
-                    | "(" op-negation "," term ")"          (* negation *)
-                    | op-negation term                      (* negation, new notation *)
-        op-int-set::= "["
-        op-ext-set::= "{"
-       op-negation::= "--"
-      op-int-image::= "\\"
-      op-ext-image::= "/"
-         op-multi ::= "&&"                                  (* conjunction *)
-                    | "*"                                   (* product *)
-                    | "||"                                  (* disjunction *)
-                    | "&|"                                  (* parallel events *)
-                    | "&/"                                  (* sequential events *)
-                    | "|"                                   (* intensional intersection *)
-                    | "&"                                   (* extensional intersection *)
+    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 *)
 
-        op-single ::= "-"                                   (* extensional difference *)
-                    | "~"                                   (* intensional difference *)
+        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 *)
 
-         variable ::= "$"word                               (* independent variable *)
-                    | "#"[word]                             (* dependent variable *)
-                    | "?"[word]                             (* query variable in question *)
+         variable ::= "$"word                                 (* independent variable *)
+                    | "#"word                                 (* dependent variable *)
+                    | "?"word                                 (* query variable in question *)
 
-            tense ::= ":/:"                                 (* future event *)
-                    | ":|:"                                 (* present event *)
-                    | ":\\:"                                (* :\: past event *)
-                    | <":">#"\d+"<":">                      (* defined event, output only *)
+            tense ::= ":/:"                                   (* future event *)
+                    | ":|:"                                   (* present event *)
+                    | ":\\:"                                  (* :\: past event *)
+                    | <":">#"\d+"<":">                        (* defined event, output only *)
 
-         interval ::= <"/">#"\d+"                           (* integer *)
+         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] *)
+            truth ::= <"%">frequency[<";">confidence]<"%">    (* two numbers in [0,1]x(0,1) *)
+           desire ::= <"%">plausibility[<";">desirability]<"%"> (* two numbers in [0,1]x(0,1) *)
+           budget ::= <"$">priority[<";">durability][<";">quality]<"$"> (* three numbers in [0,1]x(0,1)x[0,1] *)
+
+               word : #"\w+"                                  (* unicode string *)    
+           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 *)
 
-               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 *)

src/narjure/bag.clj

@@ -1,12 +1,12 @@
 (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])
+  (get-el [this] [this k])
   (remove-el [this k])
+  (take-el [this] [this k])
   (count-els [this]))
 
 ;TODO must be discussed
@@ -28,12 +28,26 @@
   Bag
   (put-el [_ item]
     (DefaultBag. capacity (assoc-to-bag queue item capacity)))
-  (get-el [_] (peek queue))
-  (get-el [_ key] (when (contains? queue key) [key (queue key)]))
+  (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/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,31 +24,39 @@
    "<|>"  'concurrent-equivalence})
 
 (def compound-terms
-  {"{"    '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})
+  {"{"  '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})
+
+(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))
@@ -62,12 +71,20 @@
 
 (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]]
@@ -76,7 +93,8 @@
 ;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])
+    (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))))
 
@@ -85,16 +103,7 @@
     `[~(get-compound-term comp-operator)
       ~@(keep-cat element (remove string? data))]))
 
-(defmethod element :copula [_])
-(defmethod element :op-multi [_])
-(defmethod element :op-single [_])
-(defmethod element :op-negation [_])
-(defmethod element :op-ext-set [_])
-(defmethod element :op-int-set [_])
-(defmethod element :op-ext-image [_])
-(defmethod element :op-int-image [_])
-
-(def var-prefixes {"#" "d_" "?" "q_"})
+(def var-prefixes {"#" "d_" "?" "?"})
 (defmethod element :variable [[_ type [_ v]]]
   (let [v (symbol (str (var-prefixes type) v))]
     (swap! *lvars* conj v)
@@ -110,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

@@ -19,7 +19,4 @@
                       (put-el {:key :a :priority 0.7})
                       :queue))))
   (is (= 2 (count-els (abc-bag 2))))
-
-  (is (= :a (-> a-bag get-el first)))
-  (is (= :a (-> a-bag (get-el :a) first)))
   (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,25 +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 (= '[[[negation bird]]] (:data (parse "--bird."))))
-  (is (= '[[[negation bird]]] (:data (parse "(--,bird)."))))
-  (is (= '[[[int-image bird animal]]] (:data (parse "(\\,bird,animal)."))))
-  (is (= '[[[conjunction [inheritance d_1 [int-set red]] [inheritance d_1 apple]]]]
-         (:data (parse "(&&,<#1 --> [red]>,<#1 --> apple>)."))))
-  )
+  (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%"))))