:goal and :quest task types

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.

resources/narsese.bnf

@@ -5,7 +5,7 @@
          sentence ::= statement"." [tense] [truth]            (* judgement to be remembered *)
                     | statement"?" [tense] [truth]            (* question to be answered, tense added in OpenNARS 1.7 *)
                     | statement"@" [tense] [truth]            (* question on desire value to be answered, tense added in OpenNARS 1.7 *)
-                    | statement"!" [tense] [truth]            (* goal to be realized, 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 *)
@@ -15,15 +15,15 @@
 
            copula ::= "-->"                                   (* inheritance *)
                     | "<->"                                   (* similarity *)
-                    | "{--"                                   (* instance *)
-                    | "--]"                                   (* property *)
-                    | "{-]"                                   (* instance-property *)
+                    | "{--"                                   (* o-- instance *)
+                    | "--]"                                   (* --o property *)
+                    | "{-]"                                   (* o-o instance-property *)
                     | "==>"                                   (* implication *)
-                    | "=/>"                                   (* predictive implication *)
+                    | "=/>"                                   (* =+> predictive implication *)
                     | "=|>"                                   (* concurrent implication *)
-                    | "=\\>"                                  (* =\> retrospective implication *)
+                    | "=\\>"                                  (* =-> retrospective implication *)
                     | "<=>"                                   (* equivalence *)
-                    | "</>"                                   (* predictive equivalence *)
+                    | "</>"                                   (* <+> predictive equivalence *)
                     | "<|>"                                   (* concurrent equivalence *)
 
              term ::= word                                    (* an atomic constant term *)
@@ -38,22 +38,23 @@
                     | "("op-single"," term "," term ")"       (* with prefix operator *)
                     | "(" term {op-multi term} ")"            (* with infix operator *)
                     | "(" term op-single term ")"             (* with infix operator *)
-                    | "(" term {","term} ")"                  (* product, new notation *)
+                    | 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-int-set::= "["                                     (* extensional set *)
-        op-ext-set::= "{"                                     (* intensional set *)
+        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 events *)
-                    | "&/"                                    (* sequential events *)
+                    | "&|"                                    (* parallel conjunction (of events) *)
+                    | "&/"                                    (* sequential conjunction (of events) *)
                     | "|"                                     (* intensional intersection *)
                     | "&"                                     (* extensional intersection *)
         op-single ::= "-"                                     (* extensional difference *)
@@ -71,6 +72,7 @@
          interval ::= <"/">#"\d+"                             (* integer *)
 
             truth ::= <"%">frequency[<";">confidence]<"%">    (* two numbers in [0,1]x(0,1) *)
+           desire ::= <"%">plausibility[<";">desirability]<"%"> (* two numbers in [0,1]x(0,1) *)
            budget ::= <"$">priority[<";">durability][<";">quality]<"$"> (* three numbers in [0,1]x(0,1)x[0,1] *)
 
                word : #"\w+"                                  (* unicode string *)    
@@ -79,3 +81,6 @@
             quality : #"([0]?\.[0-9]+|1\.[0]*|1|0)"           (* 0 <= x <= 1 *)
           frequency : #"([0]?\.[0-9]+|1\.[0]*|1|0)"           (* 0 <= x <= 1 *)
          confidence : #"[0]?\.[0]*[1-9]{1}[0-9]*"             (* 0 <  x <  1 *)
+       plausibility : #"([0]?\.[0-9]+|1\.[0]*|1|0)"           (* 0 <= x <= 1 *)
+       desirability : #"[0]?\.[0]*[1-9]{1}[0-9]*"             (* 0 <  x <  1 *)
+

src/narjure/bag.clj

@@ -43,3 +43,11 @@
   ([] (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

@@ -1,15 +1,24 @@
 (ns narjure.cycle
   (:require [narjure.bag :refer :all]
-            [narjure.narsese :refer [parse]]))
+            [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})
+  {:concepts            concepts
+   :cycles-cnt          0
+   :tasks-cnt           0
+   :buffer              buffer
+   :local-inf-results   #{}
+   :forward-inf-results #{}
+   :answers             []})
 
 (defn default-memory
   ([] (default-memory 100 100))
@@ -21,32 +30,130 @@
   {:key      term
    :priority 1
    :tasks    (default-bag 100)
-   :beliefs  (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 local-revision
-  [concept {:keys [statement] :as task}]
-  #_(if-let [old-beleife ()]
-    (if (overlaps?))))
+(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 local inefernce should be somewhere here
-(defn task->concept
-  [task {:keys [concepts] :as m} term]
-  (->> task
-       (update (get-concept concepts term) :tasks put-el)
-       (update m :concepts put-el)))
+;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 1)
+(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] _]
@@ -60,12 +167,20 @@
   "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."
-  ;TODO Should revision/choice be implemented here?
   [{:keys [tasks] :as m}]
   (dissoc (reduce task->concepts m tasks) :tasks))
 
-(defn do-inference [task beleife]
-  [])
+(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
@@ -73,18 +188,54 @@
   3. Feed the task and the belief to the inference engine
   to produce derived tasks."
   [{:keys [concepts] :as m}]
-  (let [[{:keys [tasks beliefs] :as concept} concepts] (take-el concepts)
-        [task tasks] (take-el tasks)
-        [beleife beleifs] (take-el beliefs)]
-    (if (and task beleife)
-      (let [new-tasks (do-inference task beleife)
-            upd-beleifs (put-el beleifs beleife)
-            uod-concept (assoc concept :beliefs upd-beleifs)
-            upd-concepts (put-el concepts uod-concept)
-            upd-m (assoc m :tasks tasks)]
-        (-> (reduce task->buffer upd-m new-tasks)
-            (assoc :concepts upd-concepts)))
-      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."
@@ -94,28 +245,48 @@
       buffer->tasks
       filling-tasks
       inference
-      ;save-results
-      ))
+      choose-answers))
 
-;TODO
+;TODO what is default priority for the tasks that arrived from the inference?
 (defn task-priority [_] 0.8)
 
-(defn pack-task [task cycle n]
+(defn pack-task
+  "Adds some properties to the task to make usable in Bag"
+  ;TODO should be moved somewhere
+  [task cycle n]
   (merge task
-         {:key            (hash task)                       ;TODO to be replaced
+         {;TODO hash to be replaced
+          :key            (hash task)
           :priority       (task-priority task)
           :cycle          cycle
-          :evidental-base [n]}))
+          ;TODO data structure for evidental base should be discussed
+          :evidental-base #{n}}))
 
-(defn task->buffer [{:keys [cycles-cnt tasks-cnt] :as m} t]
+(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
-  (let [task (parse "<a --> b>.")]
-    (def t-m (task->buffer (default-memory) task)))
-  (do-cycle t-m))
-
-
+  (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")
 
@@ -39,16 +40,25 @@
    "&/" '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
+                 "@" :quest
+                 "!" :goal})
 
-(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))
@@ -63,16 +73,20 @@
 
 (defmethod element :sentence [[_ & data]]
   (let [filtered (group-by string? data)]
-    (reset! *action* (actions (first (filtered true))))
+    (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]]
@@ -81,7 +95,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))))
 
@@ -90,16 +105,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)
@@ -131,30 +137,48 @@
     (element (first data)))
   (element (last data)))
 
-(defmethod element :default [[_ & 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 [])
-                *budget* (atom [])]
-        (let [statement (element data)]
-          {:action    @*action*
-           :lvars     @*lvars*
-           :truth     @*truth*
-           :budget    @*budget*
-           :statement statement
-           :terms     (terms statement)}))
+                *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

@@ -6,7 +6,8 @@
             [clojure.core.logic :as l]
             [clojure.string :refer [trim]]
             [clojure.pprint :as p]
-            [clojure.tools.nrepl.middleware :refer [set-descriptor!]]))
+            [clojure.tools.nrepl.middleware :refer [set-descriptor!]]
+            [narjure.cycle :as cycle]))
 
 (defonce narsese-repl-mode (atom false))
 
@@ -18,33 +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 statement]}]
-  (let [truth (if (empty? truth) [1 0.9] truth)
-        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 _)))
@@ -52,30 +34,24 @@
 (defn- wrap-code [code]
   (str "(narjure.repl/handle-narsese \"" code "\")"))
 
-(defn- sentence [{:keys [statement]}]
-  [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)))
-      (do (swap! buffer conj result)
-          (collect! result))
+      (collect! result)
       result)))
 
 (defn handle-narsese [code]
   (let [n (parse-int (trim code))]
     (cond
-      (integer? n) (p/pprint (run n))
+      (integer? n) (do (run n) nil)
       (= "stop!" (trim code)) (stop-narsese-repl!)
-      (= \* (first code)) (reset! buffer [])
+      (= \* (first code)) (do (clear-db!) nil)
       (= \/ (first code)) ""
       :default (get-result code))))
 

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

@@ -20,7 +20,11 @@
   (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>)."))))
+         (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%"))))