repl refactoring

project.clj

@@ -7,7 +7,8 @@
                  [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"]]
   :main ^:skip-aot narjure.core
   :plugins [[lein-cloverage "1.0.6"]
             [cider/cider-nrepl "0.11.0-SNAPSHOT"]]

resources/narsese.bnf

@@ -32,21 +32,22 @@
                     | 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 *)
+    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 *)
-                    | "(/," term {","term} ")"              (* extensional image *)
-                    | "(\\," term {","term} ")"             (* \ intensional image *)
-                    | "(--," term ")"                       (* negation *)
-                    | "--"term                              (* negation, new notation *)
-
-                    (* new compound-term notation *)
-
-                    | "(" term {op-multi term} ")"    (* compound term with infix operator *)
-                    | "(" term op-single term ")"     (* compound term with infix operator *)
-
+                    | "(" 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 *)
@@ -73,8 +74,8 @@
            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 *)
+           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)"                 (* 0 <= x <= 1 *)
-          frequency : #"([0]?\.[0-9]+|1|0)"                 (* 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/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/bag.clj

@@ -0,0 +1,39 @@
+(ns narjure.bag
+  (:require [clojure.data.priority-map :refer [priority-map-keyfn-by]]))
+
+(defprotocol Bag
+  (put-el [this item])
+  (get-el
+    [this]
+    [this k])
+  (remove-el [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 [_] (peek queue))
+  (get-el [_ key] (when (contains? queue key) [key (queue key)]))
+  (remove-el [_ key] (DefaultBag. capacity (dissoc queue key)))
+  (count-els [_] (count queue)))
+
+(defn default-bag
+  ([] (default-bag 100))
+  ([capacity]
+   (DefaultBag. capacity (priority-map-keyfn-by :rand-priority >))))

src/narjure/narsese.clj

@@ -25,30 +25,19 @@
 (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
+   "/"    'ext-image
+   "\\"   'int-image
    "--"   'negation
-   "(||," 'disjunction
    "||"   'disjunction
-   "(&&," 'conjunction
    "&&"   'conjunction
-   "(&/," 'sequential-events
-   "&/" 'sequential-events
-   "(&|," 'parallel-events
-   "&|" 'parallel-events
-   })
+   "&/"   'sequential-events
+   "&|"   'parallel-events})
 
 (defn get-compound-term [[_ operator-srt]]
   (compound-terms operator-srt))
@@ -84,18 +73,30 @@
 (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])
+      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 :op-negation [_])
+(defmethod element :op-ext-set [_])
+(defmethod element :op-int-set [_])
+(defmethod element :op-ext-image [_])
+(defmethod element :op-int-image [_])
 
-(defmethod element :variable [[_ _ [_ v]]]
-  (let [v (symbol v)]
+(def var-prefixes {"#" "d_" "?" "q_"})
+(defmethod element :variable [[_ type [_ v]]]
+  (let [v (symbol (str (var-prefixes type) v))]
     (swap! *lvars* conj v)
     v))
 

test/narjure/test/bag.clj

@@ -0,0 +1,25 @@
+(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 (= :a (-> a-bag get-el first)))
+  (is (= :a (-> a-bag (get-el :a) first)))
+  (is (nil? (get-el a-bag :b))))

test/narjure/test/narsese.clj

@@ -15,7 +15,13 @@
          (narsese->clj "((tim --> fish) && (tom --> fish)).")))
   (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]]] (: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>)."))))
+  )
 
 (deftest test-numbers-validation
   (is (not (failure? (parse "<bird --> swimmer>. %1;0.9%"))))
@@ -30,5 +36,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%"))))