From 4acb2617bedb717486ac2bc85b819ef96f968d53 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Fri, 18 Jul 2014 15:15:12 +0100 Subject: [PATCH] Added the '...neighbours within distance...' feature to the rule language. --- README.md | 68 ++++++++++++++++++++++++---- project.clj | 1 + src/mw_parser/core.clj | 88 +++++++++++++++++++++++++++--------- test/mw_parser/core_test.clj | 44 ++++++++++++++++++ 4 files changed, 172 insertions(+), 29 deletions(-) diff --git a/README.md b/README.md index 7f0ef17..130df59 100644 --- a/README.md +++ b/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 -is returned and there's no helpful error message. +be the source code of a Clojure anonymous function; if the rule cannot be interpretted, +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 -modified. +__x__ and __y__. + +### 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. ### 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. + + + + + + + + + +
3333333
3222223
3211123
321X123
3211123
3222223
3333333
+ +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 -to the reserved properties __x__ and __y__. +string of characters can form the name of a property. Actions should __NOT__ +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) \ No newline at end of file +Distributed under the terms of the [GNU General Public License v2] +(http://www.gnu.org/licenses/gpl-2.0.html) \ No newline at end of file diff --git a/project.clj b/project.clj index 4739ada..50f30b5 100644 --- a/project.clj +++ b/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"] ]) diff --git a/src/mw_parser/core.clj b/src/mw_parser/core.clj index a47b0ba..01edee7 100644 --- a/src/mw_parser/core.clj +++ b/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] - (gen-neighbours-condition comparator quantity :state value remainder =)) + (let [[value & remainder] rest + 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] - (gen-neighbours-condition '= quantity :state value remainder =)) + (let [[value & remainder] rest + 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]] - (if (and (= should "should") - (= be "be") + [previous [prop1 SHOULD BE prop2 operator value & rest]] + (cond + (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]] - (if (and (= should "should") (= be "be")) + [previous [property SHOULD BE value & rest]] + (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)] diff --git a/test/mw_parser/core_test.clj b/test/mw_parser/core_test.clj index c8b061f..2135579 100644 --- a/test/mw_parser/core_test.clj +++ b/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."))) + + ) \ No newline at end of file