Added the simplifier, although it's not currently used, I don't think

project.clj

@@ -12,7 +12,7 @@
             :url "http://www.gnu.org/licenses/gpl-2.0.html"}
   :plugins [[lein-marginalia "0.7.1"]]
   :dependencies [[org.clojure/clojure "1.6.0"]
-                 [org.clojure/tools.trace "0.7.8"]
+                 [org.clojure/tools.trace "0.7.9"]
-                 [instaparse "1.3.5"]
+                 [instaparse "1.4.1"]
                  [mw-engine "0.1.5-SNAPSHOT"]
                  ])

src/mw_parser/declarative.clj

@@ -22,7 +22,8 @@
    DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS;
    CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS;
    CONDITION := NEIGHBOURS-CONDITION | PROPERTY-CONDITION;
-   NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUANTIFIER SPACE NEIGHBOURS IS EXPRESSION | QUALIFIER SPACE NEIGHBOURS-CONDITION;
+   WITHIN-CONDITION := NEIGHBOURS-CONDITION SPACE WITHIN SPACE NUMERIC-EXPRESSION;
+   NEIGHBOURS-CONDITION := WITHIN-CONDITION | QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUANTIFIER SPACE NEIGHBOURS IS EXPRESSION | QUALIFIER SPACE NEIGHBOURS-CONDITION;
    PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION;
    EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE;
    SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE;
@@ -46,6 +47,7 @@
    NONE := 'no';
    ALL := 'all'
    BETWEEN := 'between';
+   WITHIN := 'within';
    IN := 'in';
    MORE := 'more';
    LESS := 'less' | 'fewer';
@@ -178,22 +180,57 @@
     :SYMBOL (list (keyword (second (second tree))) 'cell)
     (generate (second tree))))
 
-;; (defn generate-neighbours-condition
+(defn generate-neighbours-condition
-;;   "Generate code for a condition which refers to neighbours."
+  "Generate code for a condition which refers to neighbours."
-;;   ([tree]
+  ([tree]
-;;    (let [q (second tree)]
+   (generate-neighbours-condition tree (first (second tree))))
-;;      (if (number? q)
+  ([tree quantifier-type]
-;;        (generate-neighbours-condition '= q
+   (let [quantifier (second (second tree))
-;;   ([comp1 quantity property value remainder comp2 distance]
+         pc (generate (nth tree 4))]
-;;     [(list comp1
+     (case quantifier-type
-;;          (list 'count
+       :NUMBER (generate-neighbours-condition '= (read-string quantifier) pc 1)
-;;                (list 'get-neighbours-with-property-value 'world
+       :SOME (generate-neighbours-condition '> 0 pc 1)
-;;                      '(cell :x) '(cell :y) distance
+       :QUANTIFIER
-;;                      (keyword property) (keyword-or-numeric value) comp2))
+       (let [comparative (generate (simplify (second quantifier)))
-;;          quantity)
+             value (simplify (nth quantifier 5))]
-;;            remainder])
+         (generate-neighbours-condition comparative value pc 1)))))
-;;   ([comp1 quantity property value remainder comp2]
+  ([comp1 quantity property-condition distance]
-;;     (gen-neighbours-condition comp1 quantity property value remainder comp2 1)))
+   (list comp1
+         (list 'count (list 'remove false (list 'map (list 'fn ['cell] property-condition) '(get-neighbours cell world distance)))) quantity))
+  ([comp1 quantity property-condition]
+   (generate-neighbours-condition comp1 quantity property-condition 1)))
+
+;; (def s1 "if 3 neighbours have state equal to forest then state should be forest")
+;; (def s2 "if some neighbours have state equal to forest then state should be forest")
+;; (def s3 "if more than 3 neighbours have state equal to forest then state should be forest")
+;; (def s4 "if fewer than 3 neighbours have state equal to forest then state should be forest")
+;; (def s5 "if all neighbours have state equal to forest then state should be forest")
+;; (def s6 "if more than 3 neighbours within 2 have state equal to forest then state should be forest")
+
+;; (nth (simplify (parse-rule s1)) 2)
+;; (second (nth (simplify (parse-rule s1)) 2))
+;; (nth (simplify (parse-rule s2)) 2)
+;; (map simplify (nth (simplify (parse-rule s2)) 2))
+;; ;; (second (nth (simplify (parse-rule s2)) 2))
+;; ;; (nth (simplify (parse-rule s3)) 2)
+;; (second (nth (simplify (parse-rule s3)) 2))
+;; (map simplify (second (nth (simplify (parse-rule s3)) 2)))
+;; ;; (nth (simplify (parse-rule s4)) 2)
+;; ;; (second (nth (simplify (parse-rule s4)) 2))
+;; ;; (nth (simplify (parse-rule s5)) 2)
+;; ;; (second (nth (simplify (parse-rule s5)) 2))
+;; ;; (nth (simplify (parse-rule s6)) 2)
+;; ;; (second (nth (simplify (parse-rule s6)) 2))
+
+;; ;; (generate (nth (nth (simplify (parse-rule s5)) 2) 4))
+;; ;; (generate (nth (simplify (parse-rule s2)) 2))
+;; ;; (generate (nth (simplify (parse-rule s1)) 2))
+
+
+;; (generate-neighbours-condition '= 3 '(= (:state cell) :forest) 1)
+;; (generate-neighbours-condition (nth (simplify (parse-rule s3)) 2))
+;; (generate-neighbours-condition (nth (simplify (parse-rule s2)) 2))
+;; (generate-neighbours-condition (nth (simplify (parse-rule s1)) 2))
 
 
 (defn generate
@@ -209,7 +246,6 @@
       :CONDITIONS (generate-conditions tree)
       :CONJUNCT-CONDITION (generate-conjunct-condition tree)
       :DISJUNCT-CONDITION (generate-disjunct-condition tree)
-      :PROPERTY-CONDITION (generate-property-condition tree)
       :DISJUNCT-EXPRESSION (generate (nth tree 2))
       :DISJUNCT-VALUE (generate-disjunct-value tree)
       :EQUIVALENCE '=
@@ -220,10 +256,11 @@
                                  = 'not=
                                  > '<
                                  < '>)
-;;       :NEIGHBOURS-CONDITION (generate-neighbours-condition tree)
+      :NEIGHBOURS-CONDITION (generate-neighbours-condition tree)
       :NUMERIC-EXPRESSION (generate-numeric-expression tree)
       :NUMBER (read-string (second tree))
       :PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right
+      :PROPERTY-CONDITION (generate-property-condition tree)
       :QUALIFIER (generate (second tree))
       :RULE (generate-rule tree)
       :SIMPLE-ACTION (generate-simple-action tree)
@@ -271,7 +308,7 @@
       :CONDITION (simplify-second-of-two tree)
       :CONDITIONS (simplify-second-of-two tree)
       :EXPRESSION (simplify-second-of-two tree)
-      :QUANTIFIER (simplify-second-of-two tree)
+;;      :QUANTIFIER (simplify-second-of-two tree)
       :NOT nil
       :PROPERTY (simplify-second-of-two tree)
       :SPACE nil

src/mw_parser/simplifier.clj

@@ -0,0 +1,92 @@
+(ns mw-parser.simplifier
+  (:use mw-engine.utils
+        mw-parser.parser))
+
+(declare simplify)
+
+(defn simplify-qualifier
+  "Given that this `tree` fragment represents a qualifier, what
+   qualifier is that?"
+  [tree]
+  (cond
+    (empty? tree) nil
+    (and (coll? tree)
+         (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree
+    (coll? (first tree)) (or (simplify-qualifier (first tree))
+                             (simplify-qualifier (rest tree)))
+    (coll? tree) (simplify-qualifier (rest tree))
+    true tree))
+
+(defn simplify-second-of-two
+  "There are a number of possible simplifications such that if the `tree` has
+   only two elements, the second is semantically sufficient."
+  [tree]
+  (if (= (count tree) 2) (simplify (nth tree 1)) tree))
+
+
+(defn simplify-some
+  "'some' is the same as 'more than zero'"
+  [tree]
+  [:COMPARATIVE '> 0])
+
+(defn simplify-none
+  "'none' is the same as 'zero'"
+  [tree]
+  [:COMPARATIVE '= 0])
+
+(defn simplify-all
+  "'all' isn't actually the same as 'eight', because cells at the edges of the world have
+  fewer than eight neighbours; but it's a simplifying (ha!) assumption for now."
+  [tree]
+  [:COMPARATIVE '= 8])
+
+(defn simplify-quantifier
+  "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '='
+  and whose quantity is that number. This is actually more complicated but makes generation easier."
+  [tree]
+  (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify (second tree))))
+
+(defn simplify
+  "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with
+  semantically identical simpler fragments"
+  [tree]
+  (if
+    (coll? tree)
+    (case (first tree)
+      :SPACE nil
+      :QUALIFIER (simplify-qualifier tree)
+      :CONDITIONS (simplify-second-of-two tree)
+      :CONDITION (simplify-second-of-two tree)
+      :EXPRESSION (simplify-second-of-two tree)
+      :COMPARATIVE (simplify-second-of-two tree)
+      :QUANTIFIER (simplify-quantifier tree)
+      :VALUE (simplify-second-of-two tree)
+      :PROPERTY (simplify-second-of-two tree)
+      :ACTIONS (simplify-second-of-two tree)
+      :ACTION (simplify-second-of-two tree)
+      :ALL (simplify-all tree)
+      :SOME (simplify-some tree)
+      :NONE (simplify-none tree)
+      (remove nil? (map simplify tree)))
+    tree))
+
+(simplify (parse-rule "if state is climax and 4 neighbours have state equal to fire then 3 chance in 5 state should be fire"))
+(simplify (parse-rule "if state is climax and no neighbours have state equal to fire then 3 chance in 5 state should be fire"))
+
+(simplify (parse-rule "if state is in grassland or pasture or heath and more than 4 neighbours have state equal to water then state should be village"))
+
+(simplify (parse-rule "if 6 neighbours have state equal to water then state should be village"))
+
+(simplify (parse-rule "if fertility is between 55 and 75 then state should be climax"))
+
+(simplify (parse-rule "if state is forest then state should be climax"))
+
+
+(simplify (parse-rule "if state is in grassland or pasture or heath and more than 4 neighbours have state equal to water then state should be village"))
+(simplify (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))
+(simplify (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"))
+(simplify (parse-rule "if altitude is 100 or fertility is 25 then state should be heath"))
+
+(simplify (parse-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2"))
+(simplify (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"))
+(simplify (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village"))