the first steps of implementation of the control cycle

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,81 @@
 (* 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] [truth]            (* 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 *)
+                    | "{--"                                   (* instance *)
+                    | "--]"                                   (* property *)
+                    | "{-]"                                   (* 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 *)
+                    | "(" 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-int-set::= "["                                     (* extensional set *)
+        op-ext-set::= "{"                                     (* intensional set *)
+       op-negation::= "--"                                    (* negation *)
+      op-int-image::= "\\"                                    (* \ intensional image *)
+      op-ext-image::= "/"                                     (* extensional image *)
+         op-multi ::= "&&"                                    (* conjunction *)
+                    | "*"                                     (* product *)
+                    | "||"                                    (* disjunction *)
+                    | "&|"                                    (* parallel events *)
+                    | "&/"                                    (* sequential 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) *)
+           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 *)
+               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,9 +28,15 @@
   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

src/narjure/cycle.clj

@@ -0,0 +1,121 @@
+(ns narjure.cycle
+  (:require [narjure.bag :refer :all]
+            [narjure.narsese :refer [parse]]))
+
+(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})
+
+(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)})
+
+(defn get-concept [concepts term]
+  (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?))))
+
+;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)))
+
+(defn task->concepts
+  [m {:keys [terms] :as task}]
+  (reduce (partial task->concept task) m terms))
+
+(def tasks-to-fetch 1)
+
+(defn buffer->tasks
+  [{: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."
+  ;TODO Should revision/choice be implemented here?
+  [{:keys [tasks] :as m}]
+  (dissoc (reduce task->concepts m tasks) :tasks))
+
+(defn do-inference [task beleife]
+  [])
+
+(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 [[{: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)))
+
+(defn do-cycle
+  "The cycle of NARS."
+  [memory]
+  (-> memory
+      (update :cycles-cnt inc)
+      buffer->tasks
+      filling-tasks
+      inference
+      ;save-results
+      ))
+
+;TODO
+(defn task-priority [_] 0.8)
+
+(defn pack-task [task cycle n]
+  (merge task
+         {:key            (hash task)                       ;TODO to be replaced
+          :priority       (task-priority task)
+          :cycle          cycle
+          :evidental-base [n]}))
+
+(defn task->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)))
+
+(comment
+  (let [task (parse "<a --> b>.")]
+    (def t-m (task->buffer (default-memory) task)))
+  (do-cycle t-m))
+
+

src/narjure/narsese.clj

@@ -23,21 +23,21 @@
    "<|>"  '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})
 
 (defn get-compound-term [[_ operator-srt]]
   (compound-terms operator-srt))
@@ -48,6 +48,7 @@
 (def ^:dynamic *action* (atom nil))
 (def ^:dynamic *lvars* (atom []))
 (def ^:dynamic *truth* (atom []))
+(def ^:dynamic *budget* (atom []))
 
 (defn keep-cat [fun col]
   (into [] (comp (mapcat fun) (filter (complement nil?))) col))
@@ -63,7 +64,11 @@
 (defmethod element :sentence [[_ & data]]
   (let [filtered (group-by string? data)]
     (reset! *action* (actions (first (filtered true))))
-    (keep element (filtered false))))
+    (let [cols (filtered false)
+          last-el (last cols)]
+      (when (= :truth (first last-el))
+        (element last-el))
+      (element (first cols)))))
 
 (defmethod element :statement [[_ & data]]
   (if-let [copula (get-copula data)]
@@ -110,19 +115,32 @@
   [[_ & 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#)))
+
+(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 :default [[_ & data]]
   (when (seq? data)
     (keep element data)))
 
+;TODO check for variables in statemnts, ignore subterm if it contains variable
+(defn terms
+  "Fetch terms from task."
+  [statement]
+  (into #{statement} (rest statement)))
+
 (defn parse
   "Parses a Narsese string into task ready for inference"
   [narsese-str]
@@ -130,10 +148,13 @@
     (if-not (i/failure? data)
       (binding [*action* (atom nil)
                 *lvars* (atom [])
-                *truth* (atom [])]
-        (let [parsed-code (element data)]
-          {:action @*action*
-           :lvars  @*lvars*
-           :truth  @*truth*
-           :data   parsed-code}))
+                *truth* (atom [])
+                *budget* (atom [])]
+        (let [statement (element data)]
+          {:action    @*action*
+           :lvars     @*lvars*
+           :truth     @*truth*
+           :budget    @*budget*
+           :statement statement
+           :terms     (terms statement)}))
       data)))

src/narjure/repl.clj

@@ -4,6 +4,8 @@
             [instaparse.core :as i]
             [nal.core :as c]
             [clojure.core.logic :as l]
+            [clojure.string :refer [trim]]
+            [clojure.pprint :as p]
             [clojure.tools.nrepl.middleware :refer [set-descriptor!]]))
 
 (defonce narsese-repl-mode (atom false))
@@ -35,9 +37,8 @@
 (defn inference [n st1 st2]
   (l/run n [q] (c/inference st1 st2 q)))
 
-(defmethod collect! :judgement [{:keys [truth data]}]
+(defmethod collect! :judgement [{:keys [truth statement]}]
   (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)
@@ -51,9 +52,8 @@
 (defn- wrap-code [code]
   (str "(narjure.repl/handle-narsese \"" code "\")"))
 
-(defn- sentence [{:keys [data]}]
-  (let [statement (first data)]
-    [statement (@db statement)]))
+(defn- sentence [{:keys [statement]}]
+  [statement (@db statement)])
 
 (defn run [n]
   (let [last-two (map sentence (take-last 2 @buffer))
@@ -63,16 +63,21 @@
                    [])]
     (into forward backward)))
 
+(defn- get-result [code]
+  (let [result (parse code)]
+    (if (and (not (i/failure? result)))
+      (do (swap! buffer conj 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) (p/pprint (run n))
+      (= "stop!" (trim code)) (stop-narsese-repl!)
+      (= \* (first code)) (reset! buffer [])
+      (= \/ (first code)) ""
+      :default (get-result code))))
 
 (defn narsese-handler [handler]
   (fn [args & tail]

test/narjure/test/narsese.clj

@@ -3,25 +3,24 @@
             [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>)."))))
 
 (deftest test-numbers-validation
   (is (not (failure? (parse "<bird --> swimmer>. %1;0.9%"))))