some kind of tests for rules

src/nal/core.clj

@@ -7,7 +7,8 @@
   (if (>= c1 c2) [f1 c1] [f2 c2]))
 
 (defn inference
-  [{:keys [task-type] :as task} belief]
-  (generate-conclusions (r/rules task-type) task belief))
+  ([task belief] (inference r/rules task belief))
+  ([rules {:keys [task-type] :as task} belief]
+   (generate-conclusions (rules task-type) task belief)))
 
 (def revision t/revision)

src/nal/deriver/rules.clj

@@ -132,29 +132,33 @@
 (defmacro defrules [name rules]
   `(def ~name (quote ~rules)))
 
+(defn expand-rules [rules]
+  (rules->> (apply concat rules)
+            contains-list? generate-all-lists
+            contains-list? generate-all-lists
+            identity rule
+            order-for-all-same? generate-all-orders
+            allow-swapping? swap
+            allow-backward? expand-backward-rules))
+
+(defn generate-deriver [expanded-rules]
+  (let [judgement-rules# (check-duplication (filter belief? expanded-rules))
+        question-rules# (check-duplication (filter question? expanded-rules))
+        goal-rules# (check-duplication (filter goal? expanded-rules))
+        quest-rules# (check-duplication (filter quest? expanded-rules))]
+    (println "Beliefs rules:" (count judgement-rules#))
+    (println "Questions rules:" (count question-rules#))
+    (println "Goal rules:" (count goal-rules#))
+    (println "Quests rules:" (count quest-rules#))
+    {:belief   (rules-map judgement-rules# :belief)
+     :question (rules-map question-rules# :question)
+     :goal     (rules-map goal-rules# :goal)
+     :quest    (rules-map quest-rules# :quest)
+     :origin   (group-by :origin expanded-rules)
+     :id       (group-by :id expanded-rules)}))
+
 (defn compile-rules
   "Define rules. Rules must be #R statements."
   ;TODO exception on duplication of the rule
   [& rules]
-  (time
-    (let [rules (rules->> (apply concat rules)
-                          contains-list? generate-all-lists
-                          contains-list? generate-all-lists
-                          identity rule
-                          order-for-all-same? generate-all-orders
-                          allow-swapping? swap
-                          allow-backward? expand-backward-rules)
-          judgement-rules# (check-duplication (filter belief? rules))
-          question-rules# (check-duplication (filter question? rules))
-          goal-rules# (check-duplication (filter goal? rules))
-          quest-rules# (check-duplication (filter quest? rules))]
-      (println "Beliefs rules:" (count judgement-rules#))
-      (println "Questions rules:" (count question-rules#))
-      (println "Goal rules:" (count goal-rules#))
-      (println "Quests rules:" (count quest-rules#))
-      {:belief   (rules-map judgement-rules# :belief)
-       :question (rules-map question-rules# :question)
-       :goal     (rules-map goal-rules# :goal)
-       :quest    (rules-map quest-rules# :quest)
-       :origin   (group-by :origin rules)
-       :id       (group-by :id rules)})))
+  (time (generate-deriver (expand-rules rules))))

test/nal/test/rules/similarity_to_inheritance.clj

@@ -0,0 +1,38 @@
+(ns nal.test.rules.similarity-to-inheritance
+  (:require [nal.rules :as r]
+            [nal.deriver.rules :refer [generate-deriver]]
+            [nal.core :refer [inference]]
+            [clojure.test :refer :all]))
+
+
+(defn get-rules [rules-name]
+  (generate-deriver (get-in r/rules [:origin rules-name])))
+
+(def rules (get-rules :similarity-to-inheritance))
+
+
+(deftest test-similarity-to-inheritance
+  (is (= '({:statement  [--> S P]
+            :task-type  :belief
+            :occurrence 1
+            :truth      [1.0 0.81]})
+         (inference rules
+                    '{:statement  [--> S P]
+                      :truth      [1 0.9]
+                      :task-type  :question
+                      :occurrence 1}
+
+                    '{:statement  [<-> S P]
+                      :truth      [1 0.9]
+                      :occurrence 0})))
+  (is (= '()
+         (inference rules
+                    '{:statement  [--> S P]
+                      :truth      [1 0.9]
+                      :task-type  :belief
+                      :occurrence 1}
+
+                    '{:statement  [<-> S P]
+                      :truth      [1 0.9]
+                      :occurrence 0}))))
+