Added the '...neighbours within distance...' feature to the rule language.

README.md

@@ -6,8 +6,11 @@ A rule parser for MicroWorld
 
 Main entry point is (parse-rule _string_), where string takes a form detailed
 in __[grammar](#grammar)__, below. If the rule is interpretted correctly the result will
-be a Clojure anonymous function; if the rule is not interpretted, currently nil
+be the source code of a Clojure anonymous function; if the rule cannot be interpretted,
-is returned and there's no helpful error message.
+an error 'I did not understand...' will be shown.
+
+The function (compile-rule _string_) is like parse-rule, except that it returns
+a compiled Clojure anonymous function.
 
 ### Generated function and evaluation environment
 
@@ -20,8 +23,25 @@ It returns a new cell, based on the cell passed.
 
 Actions of the rule will (can only) modify properties of the cell; there are two
 properties which are special and SHOULD NOT be modified, namely the properties
-__x__ and __y__. Currently there is no policing that these properties are not
+__x__ and __y__. 
-modified.
+
+### Execution
+
+Each time the world is transformed, exactly the same set of rules is applied to every
+cell. The rules are applied to the cell in turn, in the order in which they are
+written in the rule text, until the conditions of one of them match the cell.
+The actions of that rule are then used to transform the cell, and the rest of
+the rules are not applied.
+
+So, for example, if your first rule is
+
+    if x is more than -1 then state should be new
+
+then no matter what your other rules are, your world will never change, because
+all cells have x more than -1.
+
+If you are having problems because one of your rules isn't working, look to
+see whether there is another rule above it which is 'blocking' it.
 
 ### <a name="grammar"></a>Grammar
 
@@ -75,6 +95,37 @@ A _condition_ is one of:
 + fewer than _number_ neighbours have _property_ less than _numeric-value_
 + some neighbours have _property_ less than _numeric-value_
 
+#### About neighbours
+
+Note that everywhere above I've used 'neighbours', you can use
+
+    neighbours within _distance_
+
+A cell has eight immediate neighbours - cells which actually touch it (except 
+for cells on the edge of the map, which have fewer). If the cell we're 
+interested in is the cell marked 'X' in the table below, its immediate neighbours
+are the ones marked '1'. But outside the ones marked '1', it has more distant 
+neighbours - those marked '2' and '3' in the table, and still more outside those.
+
+<table>
+<tr><td>3</td><td>3</td><td>3</td><td>3</td><td>3</td><td>3</td><td>3</td></tr>
+<tr><td>3</td><td>2</td><td>2</td><td>2</td><td>2</td><td>2</td><td>3</td></tr>
+<tr><td>3</td><td>2</td><td>1</td><td>1</td><td>1</td><td>2</td><td>3</td></tr>
+<tr><td>3</td><td>2</td><td>1</td><td>X</td><td>1</td><td>2</td><td>3</td></tr>
+<tr><td>3</td><td>2</td><td>1</td><td>1</td><td>1</td><td>2</td><td>3</td></tr>
+<tr><td>3</td><td>2</td><td>2</td><td>2</td><td>2</td><td>2</td><td>3</td></tr>
+<tr><td>3</td><td>3</td><td>3</td><td>3</td><td>3</td><td>3</td><td>3</td></tr>
+</table>
+
+If a rule just says 'neighbours', and not 'neighbours within', it means 
+'neighbours within 1'; so
+
+    if some neighbours are scrub then state should be scrub
+
+has exactly the same meaning as
+
+    if some neighbours within 1 are scrub then state should be scrub
+
 #### Actions
 
 In these rules, _actions_ is one of:
@@ -90,8 +141,8 @@ and _action_ is:
 #### Properties
 
 In the above, _property_ is the name of any property of a cell. Any alpha-numeric
-string of characters can form the name of a property. Actions should __NOT__ refer
+string of characters can form the name of a property. Actions should __NOT__ 
-to the reserved properties __x__ and __y__.
+try to change the reserved properties __x__ and __y__.
 
 #### Values in Conditions
 
@@ -140,6 +191,7 @@ and 'some neighbours...' is equivalent to 'more than 0 neighbours...'
 
 ## License
 
-Copyright © 2014 Simon Brooke
+Copyright © 2014 [Simon Brooke](mailto:simon@journeyman.cc)
 
-Distributed under the terms of the [GNU General Public License v2](http://www.gnu.org/licenses/gpl-2.0.html)
+Distributed under the terms of the [GNU General Public License v2]
+(http://www.gnu.org/licenses/gpl-2.0.html)

project.clj

@@ -5,5 +5,6 @@
             :url "http://www.gnu.org/licenses/gpl-2.0.html"}
   :plugins [[lein-marginalia "0.7.1"]]
   :dependencies [[org.clojure/clojure "1.5.1"]
+                 [org.clojure/tools.trace "0.7.8"]
                  [mw-engine "0.1.0-SNAPSHOT"]
                  ])

src/mw_parser/core.clj

@@ -34,6 +34,12 @@
 ;; a regular expression which matches string representation of numbers
 (def re-number #"^[0-9.]*$")
 
+;; error thrown when an attempt is made to set a reserved property
+(def reserved-properties-error 
+  "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")
+;; error thrown when a rule cannot be parsed
+(def bad-parse-error "I did not understand '%s'")
+
 (defn- keyword-or-numeric
   "If this token appears to represent an explicit number, return that number;
    otherwise, make a keyword of it and return that."
@@ -53,6 +59,7 @@
 ;; In every case if the function cannot parse the desired construct from the
 ;; front of the sequence of tokens it returns nil.
 
+
 (defn parse-numeric-value
   "Parse a number."
   [[value & remainder]]
@@ -86,6 +93,12 @@
   ([tokens]
     (parse-simple-value tokens false)))
 
+(defn gen-token-value
+  "Parse a single value from this single token and return just the generated
+   code, not a pair."
+  [token expect-int]
+  (first (parse-simple-value (list token) expect-int)))
+
 (defn parse-disjunct-value
   "Parse a list of values from among these `tokens`. If `expect-int` is true, return
    integers or things which will evaluate to integers."
@@ -165,7 +178,8 @@
   ([comp1 quantity property value remainder comp2 distance] 
     [(list comp1  
          (list 'count
-               (list 'get-neighbours-with-property-value 'world '(cell :x) '(cell :y) 1
+               (list 'get-neighbours-with-property-value 'world 
+                     '(cell :x) '(cell :y) distance 
                      (keyword property) (keyword-or-numeric value) comp2))
          quantity)
            remainder])
@@ -174,27 +188,39 @@
 
 (defn parse-comparator-neighbours-condition
   "Parse conditions of the form '...more than 6 neighbours are [condition]'"
-  [[MORE THAN n NEIGHBOURS have-or-are & rest]]
+  [[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]]
   (let [quantity (first (parse-numeric-value (list n)))
         comparator (cond (= MORE "more") '>
                      (member? MORE '("fewer" "less")) '<)]       
     (cond
+      (not (= WITHIN "within"))
+      (parse-comparator-neighbours-condition 
+        (flatten 
+          ;; two tokens were mis-parsed as 'within distance' that weren't
+          ;; actually 'within' and a distance. Splice in 'within 1' and try
+          ;; again.
+          (list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
       (and quantity 
            comparator
            (= THAN "than")
            (= NEIGHBOURS "neighbours"))
       (cond
         (= have-or-are "are") 
-        (let [[value & remainder] rest]
+        (let [[value & remainder] rest
-          (gen-neighbours-condition comparator quantity :state value remainder =))
+              dist (gen-token-value distance true)]
+          (gen-neighbours-condition comparator quantity :state value remainder = dist))
         (= have-or-are "have")
-        (let [[property comp1 comp2 value & remainder] rest]
+        (let [[property comp1 comp2 value & remainder] rest
+              dist (gen-token-value distance true)]
           (cond (and (= comp1 "equal") (= comp2 "to"))
-            (gen-neighbours-condition comparator quantity property value remainder =)
+            (gen-neighbours-condition comparator quantity property 
+                                      value remainder = dist)
             (and (= comp1 "more") (= comp2 "than"))
-            (gen-neighbours-condition comparator quantity property value remainder >)
+            (gen-neighbours-condition comparator quantity property 
+                                      value remainder > dist)
             (and (= comp1 "less") (= comp2 "than"))
-            (gen-neighbours-condition comparator quantity property value remainder <)
+            (gen-neighbours-condition comparator quantity property 
+                                      value remainder < dist)
             ))))))
   
 (defn parse-some-neighbours-condition
@@ -205,22 +231,34 @@
 
 (defn parse-simple-neighbours-condition
   "Parse conditions of the form '...6 neighbours are [condition]'"
-  [[n NEIGHBOURS have-or-are & rest]]
+  [[n NEIGHBOURS WITHIN distance have-or-are & rest]]
   (let [quantity (first (parse-numeric-value (list n)))]       
     (cond
       (and quantity (= NEIGHBOURS "neighbours"))
       (cond
+        (not (= WITHIN "within"))
+        (parse-simple-neighbours-condition
+          (flatten 
+            ;; two tokens were mis-parsed as 'within distance' that weren't
+            ;; actually 'within' and a distance. Splice in 'within 1' and try
+            ;; again.
+            (list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
         (= have-or-are "are") 
-        (let [[value & remainder] rest]
+        (let [[value & remainder] rest
-          (gen-neighbours-condition '= quantity :state value remainder =))
+              dist (gen-token-value distance true)]
+          (gen-neighbours-condition '= quantity :state value remainder = dist))
         (= have-or-are "have")
-        (let [[property comp1 comp2 value & remainder] rest]
+        (let [[property comp1 comp2 value & remainder] rest
+              dist (gen-token-value distance true)]
           (cond (and (= comp1 "equal") (= comp2 "to"))
-            (gen-neighbours-condition '= quantity property value remainder =)
+            (gen-neighbours-condition '= quantity property value remainder = 
+                                      dist)
             (and (= comp1 "more") (= comp2 "than"))
-            (gen-neighbours-condition '= quantity property value remainder >)
+            (gen-neighbours-condition '= quantity property value remainder > 
+                                      dist)
             (and (= comp1 "less") (= comp2 "than"))
-            (gen-neighbours-condition '= quantity property value remainder <)
+            (gen-neighbours-condition '= quantity property value remainder < 
+                                      dist)
             ))))))
   
 (defn parse-neighbours-condition
@@ -281,9 +319,13 @@
 (defn- parse-arithmetic-action 
   "Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]',
    e.g. 'fertility should be fertility + 1', or 'deer should be deer - wolves'."
-  [previous [prop1 should be prop2 operator value & rest]]
+  [previous [prop1 SHOULD BE prop2 operator value & rest]]
-  (if (and (= should "should")
+  (cond
-           (= be "be")
+    (member? prop2 '("x" "y"))
+    (throw 
+      (Exception. reserved-properties-error))
+    (and (= SHOULD "should")
+           (= BE "be")
            (member? operator '("+" "-" "*" "/")))
     [(list 'merge (or previous 'cell)
            {(keyword prop1) (list 'int 
@@ -294,8 +336,12 @@
 
 (defn- parse-set-action 
   "Parse actions of the form '[property] should be [value].'"
-  [previous [property should be value & rest]]
+  [previous [property SHOULD BE value & rest]]
-  (if (and (= should "should") (= be "be"))
+  (cond 
+    (member? property '("x" "y"))
+    (throw 
+      (Exception. reserved-properties-error))
+    (and (= SHOULD "should") (= BE "be"))
     [(list 'merge (or previous 'cell)
            {(keyword property) (cond (re-matches re-number value) (read-string value) true (keyword value))}) rest]))
 
@@ -344,7 +390,7 @@
    (string? line) 
    (let [rule (parse-rule (split (triml line) #"\s+"))]
      (cond rule rule
-       true (throw (Exception. (str "I did not understand '" line "'")))))
+       true (throw (Exception. (format bad-parse-error line)))))
    true 
    (let [[left remainder] (parse-left-hand-side line)
               [right junk] (parse-right-hand-side remainder)]

test/mw_parser/core_test.clj

@@ -21,6 +21,20 @@
            (is (parse-rule "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub"))
            ))
 
+(deftest exception-tests
+  (testing "Constructions which should cause exceptions to be thrown"
+           (is (thrown-with-msg? Exception #"^I did not understand.*"
+                        (parse-rule "the quick brown fox jumped over the lazy dog"))
+               "Exception thrown if rule text does not match grammar")
+           (is (thrown-with-msg? 
+                 Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
+                 (parse-rule "if state is new then x should be 0"))
+               "Exception thrown on attempt to set 'x'")
+           (is (thrown-with-msg? 
+                 Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" 
+                 (parse-rule "if state is new then y should be 0"))
+               "Exception thrown on attempt to set 'y'")))
+
 (deftest correctness-tests
   (testing "Simplest possible rule"
            (let [afn (compile-rule "if state is new then state should be grassland")]
@@ -355,4 +369,34 @@
                                  (list {:deer 2 :wolves 2} nil))) 
                         1)
                      "Action is executed")))
+  
+;; simple within distance
+  (testing "Number neighbours within distance have property equal to value"
+           (let [afn (compile-rule "if 8 neighbours within 2 have state equal to new then state should be water")
+                 world (make-world 5 5)]
+              (is (= (apply afn (list {:x 0 :y 0} world))
+                    {:state :water :x 0 :y 0})
+                 "Rule fires when condition is met (in a new world all cells are new, corner cell has eight neighbours within two)")
+             (is (nil? (apply afn (list {:x 1 :y 1} world)))
+                 "Middle cell has twenty-four neighbours within two, so rule does not fire.")))
+
+;; comparator within distance
+  (testing "More than number neighbours within distance have property equal to symbolic-value"
+           (let [afn (compile-rule "if more than 7 neighbours within 2 have state equal to grassland and more than 7 neighbours within 2 have state equal to water then state should be beach")
+                 ;; 5x5 world, strip of high ground two cells wide down left hand side
+                 ;; xxooo
+                 ;; xxooo
+                 ;; xxooo
+                 ;; xxooo
+                 ;; xxooo
+                 world (transform-world 
+                         (make-world 5 5)
+                         (list (compile-rule "if x is less than 2 then altitude should be 11 and state should be grassland")
+                               (compile-rule "if x is more than 1 then altitude should be 0 and state should be water")))]
+             (is (= (:state (apply afn (list {:x 2 :y 2} world))) :beach)
+                 "Rule fires when condition is met (strip of altitude 11 down right hand side)")
+             (is (nil? (apply afn (list {:x 0 :y 1} world)))
+                 "Middle cell of the strip has only two high neighbours, so rule should not fire.")))
+
+ 
   )