diff --git a/README.md b/README.md index b2ce28f..76f662d 100644 --- a/README.md +++ b/README.md @@ -2,6 +2,17 @@ A rule parser for MicroWorld +## Part of the overall MicroWorld system + +While this code works and is interesting on its own, you also need at least +[mw-engine](https://github.com/simon-brooke/mw-engine) and +[mw-ui](https://github.com/simon-brooke/mw-ui). There will be other +modules in due course. + +You can see MicroWorld in action [here](http://www.journeyman.cc/microworld/) - +but please don't be mean to my poor little server. If you want to run big maps +or complex rule-sets, please run it on your own machines. + ## Usage Main entry point is (parse-rule _string_), where string takes a form detailed @@ -188,6 +199,15 @@ and _operator_ is one of the simple arithmetic operators '+', '-', '*' and '/'. Note that '...neighbours are...' is equivalent to '...neighbours have state equal to...', and 'some neighbours...' is equivalent to 'more than 0 neighbours...' +### Roadmap + +The existing parser, *mw-parser.core*, works but is not well written. A much +better parser which does not yet completely work, *mw-parser.insta*, is also +included for the adventurous. + +I intend to replace *mw-parser.core* with *mw-parser.insta* as soon as +*mw-parser.insta* correctly parses all the test rules. + ## License Copyright © 2014 [Simon Brooke](mailto:simon@journeyman.cc) diff --git a/project.clj b/project.clj index 66d845e..d48db45 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-parser "0.1.3" +(defproject mw-parser "0.1.5-SNAPSHOT" :description "Parser for production rules for MicroWorld engine" :url "http://www.journeyman.cc/microworld" :manifest { @@ -11,7 +11,8 @@ :license {:name "GNU General Public License v2" :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.3"] + :dependencies [[org.clojure/clojure "1.6.0"] + [org.clojure/tools.trace "0.7.9"] + [instaparse "1.4.1"] + [mw-engine "0.1.5-SNAPSHOT"] ]) diff --git a/src/mw_parser/bulk.clj b/src/mw_parser/bulk.clj index b49ca0a..b4674ec 100644 --- a/src/mw_parser/bulk.clj +++ b/src/mw_parser/bulk.clj @@ -8,32 +8,32 @@ [clojure.string :only [split trim]]) (:import (java.io BufferedReader StringReader))) -(defn comment? +(defn comment? "Is this `line` a comment?" [line] (or (empty? (trim line)) (member? (first line) '(nil \# \;)))) -(defn parse-string +(defn parse-string "Parse rules from successive lines in this `string`, assumed to have multiple lines delimited by the new-line character. Return a list of S-expressions." [string] ;; TODO: tried to do this using with-open, but couldn't make it work. (map parse-rule (remove comment? (split string #"\n")))) -(defn parse-file +(defn parse-file "Parse rules from successive lines in the file loaded from this `filename`. Return a list of S-expressions." [filename] (parse-string (slurp filename))) (defn compile-string - "Compile each non-comment line of this `string` into an executable anonymous + "Compile each non-comment line of this `string` into an executable anonymous function, and return the sequence of such functions." [string] (map #(compile-rule % true) (remove comment? (split string #"\n")))) -(defn compile-file - "Compile each non-comment line of the file indicated by this `filename` into +(defn compile-file + "Compile each non-comment line of the file indicated by this `filename` into an executable anonymous function, and return the sequence of such functions." [filename] (compile-string (slurp filename))) diff --git a/src/mw_parser/core.clj b/src/mw_parser/core.clj index 4f1159e..aafd595 100644 --- a/src/mw_parser/core.clj +++ b/src/mw_parser/core.clj @@ -20,8 +20,10 @@ ;; semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a ;; design fault. ;; -;; More significantly it does not generate useful error messages on failure. This is, I think, a much -;; more complex issue which I don't yet know how to address. +;; More significantly it does not generate useful error messages on failure. +;; +;; This is the parser that is actually used currently; but see also insta.clj, +;; which is potentially a much better parser but does not quite work yet. (ns mw-parser.core (:use mw-engine.utils diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj new file mode 100644 index 0000000..8bea7dd --- /dev/null +++ b/src/mw_parser/declarative.clj @@ -0,0 +1,368 @@ +(ns mw-parser.declarative + (:use mw-engine.utils + [clojure.string :only [split trim triml]]) + (:require [instaparse.core :as insta])) + + +;; 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. Slots are for +;; (1) rule text +;; (2) cursor showing where in the rule text the error occurred +;; (3) the reason for the error +(def bad-parse-error "I did not understand:\n'%s'\n%s\n%s") + + +(def grammar + ;; in order to simplify translation into other natural languages, all + ;; TOKENS within the parser should be unambiguous + "RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS; + CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | PROPERTY-CONDITION | NEIGHBOURS-CONDITION ; + DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS; + CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS; + CONDITION := NEIGHBOURS-CONDITION | PROPERTY-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 | VALUE; + EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE; + SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE; + DISJUNCT-EXPRESSION := IN SPACE DISJUNCT-VALUE; + RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION; + NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION; + NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER; + COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN; + QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER; + QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER; + EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ; + COMPARATIVE := MORE | LESS; + DISJUNCT-VALUE := VALUE | VALUE SPACE OR SPACE DISJUNCT-VALUE; + IF := 'if'; + THEN := 'then'; + THAN := 'than'; + OR := 'or'; + NOT := 'not'; + AND := 'and'; + SOME := 'some'; + NONE := 'no'; + ALL := 'all' + BETWEEN := 'between'; + WITHIN := 'within'; + IN := 'in'; + MORE := 'more' | 'greater'; + LESS := 'less' | 'fewer'; + OPERATOR := '+' | '-' | '*' | '/'; + NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors'; + PROPERTY := SYMBOL; + VALUE := SYMBOL | NUMBER; + EQUAL := 'equal to'; + IS := 'is' | 'are' | 'have' | 'has'; + NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+'; + SYMBOL := #'[a-z]+'; + ACTIONS := ACTION | ACTION SPACE 'and' SPACE ACTIONS + ACTION := SIMPLE-ACTION | PROBABLE-ACTION; + PROBABLE-ACTION := VALUE SPACE 'chance in' SPACE VALUE SPACE SIMPLE-ACTION; + SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION + BECOMES := 'should be' + SPACE := #' *'" + ) + +(defn TODO + "Marker to indicate I'm not yet finished!" + [message] + message) + + +(declare generate simplify) + + +(defn suitable-fragment? + "Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`." + [tree-fragment type] + (and (coll? tree-fragment) + (= (first tree-fragment) type))) + + +(defn assert-type + "If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception." + [tree-fragment type] + (assert (suitable-fragment? tree-fragment type) + (throw (Exception. (format "Expected a %s fragment" type))))) + + +(defn generate-rule + "From this `tree`, assumed to be a syntactically correct rule specification, + generate and return the appropriate rule as a function of two arguments." + [tree] + (assert-type tree :RULE) + (list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3))))) + + +(defn generate-conditions + "From this `tree`, assumed to be a syntactically correct conditions clause, + generate and return the appropriate clojure fragment." + [tree] + (assert-type tree :CONDITIONS) + (generate (nth tree 1))) + + +(defn generate-condition + [tree] + (assert-type tree :CONDITION) + (generate (nth tree 1))) + + +(defn generate-conjunct-condition + [tree] + (assert-type tree :CONJUNCT-CONDITION) + (list 'and (generate (nth tree 1))(generate (nth tree 3)))) + + +(defn generate-disjunct-condition + [tree] + (assert-type tree :DISJUNCT-CONDITION) + (list 'or (generate (nth tree 1))(generate (nth tree 3)))) + + +(defn generate-ranged-property-condition + "Generate a property condition where the expression is a numeric range" + [tree property expression] + (assert-type tree :PROPERTY-CONDITION) + (assert-type (nth tree 3) :RANGE-EXPRESSION) + (let [l1 (generate (nth expression 2)) + l2 (generate (nth expression 4)) + pv (list property 'cell)] + (list 'let ['lower (list 'min l1 l2) + 'upper (list 'max l1 l2)] + (list 'and (list '>= pv 'lower)(list '<= pv 'upper))))) + + +(defn generate-disjunct-property-condition + "Generate a property condition where the expression is a disjunct expression. + TODO: this is definitely still wrong!" + ([tree] + (let [property (generate (nth tree 1)) + qualifier (generate (nth tree 2)) + expression (generate (nth tree 3))] + (generate-disjunct-property-condition tree property qualifier expression))) + ([tree property qualifier expression] + (let [e (list 'some (list 'fn ['i] '(= i value)) (list 'quote expression))] + (list 'let ['value (list property 'cell)] + (if (= qualifier '=) e + (list 'not e)))))) + + +(defn generate-property-condition + ([tree] + (assert-type tree :PROPERTY-CONDITION) + (if + (and (= (count tree) 2) (= (first (second tree)) :SYMBOL)) + ;; it's a shorthand for 'state equal to symbol'. This should probably have + ;; been handled in simplify... + (generate-property-condition + (list + :PROPERTY-CONDITION + '(:SYMBOL "state") + '(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to"))) + (second tree))) + ;; otherwise... + (generate-property-condition tree (first (nth tree 3))))) + ([tree expression-type] + (assert-type tree :PROPERTY-CONDITION) + (let [property (generate (nth tree 1)) + qualifier (generate (nth tree 2)) + expression (generate (nth tree 3))] + (case expression-type + :DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression) + :RANGE-EXPRESSION (generate-ranged-property-condition tree property expression) + (list qualifier (list property 'cell) expression))))) + + +(defn generate-simple-action + [tree] + (assert-type tree :SIMPLE-ACTION) + (let [property (generate (nth tree 1)) + expression (generate (nth tree 3))] + (if (or (= property :x) (= property :y)) + (throw (Exception. reserved-properties-error)) + (list 'merge 'cell {property expression})))) + + +(defn generate-multiple-actions + [tree] + (assert (and (coll? tree)(= (first tree) :ACTIONS)) "Expected an ACTIONS fragment") + (conj 'do (map generate-simple-action (rest tree)))) + + +(defn generate-disjunct-value + "Generate a disjunct value. Essentially what we need here is to generate a + flat list of values, since the `member` has already been taken care of." + [tree] + (assert-type tree :DISJUNCT-VALUE) + (if (= (count tree) 4) + (cons (generate (second tree)) (generate (nth tree 3))) + (list (generate (second tree))))) + + +(defn generate-numeric-expression + [tree] + (assert-type tree :NUMERIC-EXPRESSION) + (case (first (second tree)) + :SYMBOL (list (keyword (second (second tree))) 'cell) + (generate (second tree)))) + + +(defn generate-neighbours-condition + "Generate code for a condition which refers to neighbours." + ([tree] + (assert-type tree :NEIGHBOURS-CONDITION) + (generate-neighbours-condition tree (first (second (second tree))))) + ([tree quantifier-type] + (let [quantifier (second tree) + pc (generate (nth tree 4))] + (case quantifier-type + :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc 1) + :SOME (generate-neighbours-condition '> 0 pc 1) + :MORE (let [value (generate (nth quantifier 3))] + (generate-neighbours-condition '> value pc 1)) + :LESS (let [value (generate (nth quantifier 3))] + (generate-neighbours-condition '< value pc 1))))) + ([comp1 quantity property-condition distance] + (list comp1 + (list 'count + (list 'remove 'false? + (list 'map (list 'fn ['cell] property-condition) + (list 'mw-engine.utils/get-neighbours 'world 'cell distance)))) quantity)) + ([comp1 quantity property-condition] + (generate-neighbours-condition comp1 quantity property-condition 1))) + + +(defn generate + "Generate code for this (fragment of a) parse tree" + [tree] + (if + (coll? tree) + (case (first tree) + :ACTIONS (generate-multiple-actions tree) + :COMPARATIVE (generate (second tree)) + :COMPARATIVE-QUALIFIER (generate (nth tree 2)) + :CONDITION (generate-condition tree) + :CONDITIONS (generate-conditions tree) + :CONJUNCT-CONDITION (generate-conjunct-condition tree) + :DISJUNCT-CONDITION (generate-disjunct-condition tree) + :DISJUNCT-EXPRESSION (generate (nth tree 2)) + :DISJUNCT-VALUE (generate-disjunct-value tree) + :EQUIVALENCE '= + :EXPRESSION (generate (second tree)) + :LESS '< + :MORE '> + :NEGATED-QUALIFIER (case (generate (second tree)) + = 'not= + > '< + < '>) + :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) + :SYMBOL (keyword (second tree)) + :VALUE (generate (second tree)) + (map generate tree)) + tree)) + + +(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 rule? + "Return true if the argument appears to be a parsed rule tree, else false." + [maybe-rule] + (and (coll? maybe-rule) (= (first maybe-rule) :RULE))) + +(defn simplify + "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with + semantically identical simpler fragments" + [tree] + (if + (coll? tree) + (case (first tree) + :ACTION (simplify-second-of-two tree) + :ACTIONS (simplify-second-of-two tree) + :COMPARATIVE (simplify-second-of-two tree) + :CONDITION (simplify-second-of-two tree) + :CONDITIONS (simplify-second-of-two tree) + :EXPRESSION (simplify-second-of-two tree) + :NOT nil ;; TODO is this right?!? It looks wrong + :PROPERTY (simplify-second-of-two tree) + :SPACE nil + :THEN nil + :VALUE (simplify-second-of-two tree) + (remove nil? (map simplify tree))) + tree)) + +(def parse-rule + "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree." + (insta/parser grammar)) + +(defn explain-parse-error-reason + "Attempt to explain the reason for the parse error." + [reason] + (str "Expecting one of (" (apply str (map #(str (:expecting %) " ") reason)) ")")) + +(defn parser-error-to-map + [parser-error] + (let [m (reduce (fn [map item](merge map {(first item)(second item)})) {} parser-error) + reason (map + #(reduce (fn [map item] (merge {(first item) (second item)} map)) {} %) + (:reason m))] + (merge m {:reason reason}))) + +(defn throw-parse-exception + "Construct a helpful error message from this `parser-error`, and throw an exception with that message." + [parser-error] + (assert (coll? parser-error) "Expected a paser error structure?") + (let + [ + ;; the error structure is a list, such that each element is a list of two items, and + ;; the first element in each sublist is a keyword. Easier to work with it as a map + error-map (parser-error-to-map parser-error) + text (:text error-map) + reason (explain-parse-error-reason (:reason error-map)) + ;; rules have only one line, by definition; we're interested in the column + column (if (:column error-map)(:column error-map) 0) + ;; create a cursor to point to that column + cursor (apply str (reverse (conj (repeat column " ") "^"))) + message (format bad-parse-error text cursor reason) + ] + (throw (Exception. message)))) + +(defn compile-rule + "Compile this `rule`, assumed to be a string with appropriate syntax, into a function of two arguments, + a `cell` and a `world`, having the same semantics." + [rule] + (assert (string? rule)) + (let [tree (simplify (parse-rule rule))] + (if (rule? tree) (eval (generate tree)) + (throw-parse-exception tree)))) + + diff --git a/src/mw_parser/simplifier.clj b/src/mw_parser/simplifier.clj new file mode 100644 index 0000000..9943256 --- /dev/null +++ b/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")) diff --git a/test/mw_parser/declarative_test.clj b/test/mw_parser/declarative_test.clj new file mode 100644 index 0000000..86cb449 --- /dev/null +++ b/test/mw_parser/declarative_test.clj @@ -0,0 +1,517 @@ +(ns mw-parser.declarative-test + (:use clojure.pprint + mw-engine.core + mw-engine.world + mw-engine.utils) + (:require [clojure.test :refer :all] + [mw-parser.declarative :refer :all])) + +(deftest rules-tests + (testing "Rule parser - does not test whether generated functions actually work, just that something is generated!" + (is (rule? (parse-rule "if state is forest then state should be climax"))) + (is (rule? (parse-rule "if state is in grassland or pasture or heath then state should be village"))) + (is (rule? (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))) + (is (rule? (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"))) + (is (rule? (parse-rule "if altitude is 100 or fertility is 25 then state should be heath"))) + (is (rule? (parse-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2"))) + (is (rule? (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"))) + (is (rule? (parse-rule "if state is forest and fertility is between 55 and 75 then state should be climax"))) + (is (rule? (parse-rule "if fertility is between 55 and 75 then state should be climax"))) + (is (rule? (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))) + )) + +(deftest neighbours-rules-tests + (testing "Rules which relate to neighbours - hard!" + (is (rule? (parse-rule "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire"))) + (is (rule? (parse-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if 6 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub"))) + (is (rule? (parse-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if 6 neighbours have state equal to water then state should be village"))) + )) + +(deftest expressions-tests + (testing "Generating primitive expressions." + (is (generate '(:NUMERIC-EXPRESSION (:NUMBER "50"))) 50) + (is (generate '(:NUMERIC-EXPRESSION (:SYMBOL "sealevel"))) + '(:sealevel cell)) + )) + +(deftest lhs-generators-tests + (testing "Generating left-hand-side fragments of rule functions from appropriate fragments of parse trees" + (is (generate + '(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest"))) + '(= (:state cell) :forest)) + (is (generate + '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10"))) + '(= (:fertility cell) 10)) + (is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:LESS "less"]] (:NUMBER "10"))) + '(< (:fertility cell) 10)) + (is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:MORE "more"]] (:NUMBER "10"))) + '(> (:fertility cell) 10)) + (is (generate '(:CONJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:AND "and") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))) + '(and (= (:state cell) :forest) (= (:fertility cell) 10))) + (is (generate '(:DISJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:OR "or") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))) + '(or (= (:state cell) :forest) (= (:fertility cell) 10))) + (is (generate '(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:DISJUNCT-EXPRESSION (:IN "in") (:DISJUNCT-VALUE (:SYMBOL "grassland") (:OR "or") (:DISJUNCT-VALUE (:SYMBOL "pasture") (:OR "or") (:DISJUNCT-VALUE (:SYMBOL "heath"))))))) + '(let [value (:state cell)] (some (fn [i] (= i value)) (quote (:grassland :pasture :heath))))) + (is (generate '(:PROPERTY-CONDITION (:SYMBOL "altitude") [:EQUIVALENCE [:IS "is"]] (:RANGE-EXPRESSION (:BETWEEN "between") (:NUMERIC-EXPRESSION (:NUMBER "50")) (:AND "and") (:NUMERIC-EXPRESSION (:NUMBER "100"))))) + '(let [lower (min 50 100) upper (max 50 100)] (and (>= (:altitude cell) lower) (<= (:altitude cell) upper)))) + )) + +(deftest rhs-generators-tests + (testing "Generating right-hand-side fragments of rule functions from appropriate fragments of parse trees" + (is (generate + '(:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax"))) + '(merge cell {:state :climax})) + (is (generate + '(:SIMPLE-ACTION (:SYMBOL "fertility") (:BECOMES "should be") (:NUMBER "10"))) + '(merge cell {:fertility 10})) + )) + +(deftest full-generation-tests + (testing "Full rule generation from pre-parsed tree" + (is (generate '(:RULE (:IF "if") (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax")))) + '(fn [cell world] (if (= (:state cell) :forest) (merge cell {:state :climax})))) + )) + + +(deftest exception-tests + (testing "Constructions which should cause exceptions to be thrown" + (is (thrown-with-msg? Exception #"^I did not understand.*" + (compile-rule "the quick brown fox jumped over the lazy dog")) + "Exception thrown if rule text does not match grammar") + (is (thrown-with-msg? Exception #"^I did not understand.*" + (compile-rule "if i have a cat on my lap then everything is fine")) + "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" + (compile-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" + (compile-rule "if state is new then y should be 0")) + "Exception thrown on attempt to set 'y'") + )) + +(deftest correctness-tests + ;; these are, in so far as possible, the same as the correctness-tests in core-tests - i.e., the two compilers + ;; compile the same language. + (testing "Simplest possible rule" + (let [afn (compile-rule "if state is new then state should be grassland")] + (is (= (apply afn (list {:state :new} nil)) + {:state :grassland}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:state :forest} nil))) + "Rule doesn't fire when condition isn't met"))) + + (testing "Condition conjunction rule" + (let [afn (compile-rule "if state is new and altitude is 0 then state should be water")] + (is (= (apply afn (list {:state :new :altitude 0} nil)) + {:state :water :altitude 0}) + "Rule fires when conditions are met") + (is (nil? (apply afn (list {:state :new :altitude 5} nil))) + "Rule does not fire: second condition not met") + (is (nil? (apply afn (list {:state :forest :altitude 0} nil))) + "Rule does not fire: first condition not met"))) + + (testing "Condition disjunction rule" + (let [afn (compile-rule "if state is new or state is waste then state should be grassland")] + (is (= (apply afn (list {:state :new} nil)) + {:state :grassland}) + "Rule fires: first condition met") + (is (= (apply afn (list {:state :waste} nil)) + {:state :grassland}) + "Rule fires: second condition met") + (is (nil? (apply afn (list {:state :forest} nil))) + "Rule does not fire: neither condition met"))) + + (testing "Simple negation rule" + (let [afn (compile-rule "if state is not new then state should be grassland")] + (is (nil? (apply afn (list {:state :new} nil))) + "Rule doesn't fire when condition isn't met") + (is (= (apply afn (list {:state :forest} nil)) + {:state :grassland}) + "Rule fires when condition is met"))) + + (testing "Can't set x or y properties" + (is (thrown-with-msg? + Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" + (compile-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" + (compile-rule "if state is new then y should be 0")) + "Exception thrown on attempt to set 'y'")) + + (testing "Simple list membership rule" + (let [afn (compile-rule "if state is in heath or scrub or forest then state should be climax")] + (is (= (apply afn (list {:state :heath} nil)) + {:state :climax}) + "Rule fires when condition is met") + (is (= (apply afn (list {:state :scrub} nil)) + {:state :climax}) + "Rule fires when condition is met") + (is (= (apply afn (list {:state :forest} nil)) + {:state :climax}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:state :grassland} nil))) + "Rule does not fire when condition is not met"))) + + (testing "Negated list membership rule" + (let [afn (compile-rule "if state is not in heath or scrub or forest then state should be climax")] + (is (nil? (apply afn (list {:state :heath} nil))) + "Rule does not fire when condition is not met") + (is (nil? (apply afn (list {:state :scrub} nil))) + "Rule does not fire when condition is not met") + (is (nil? (apply afn (list {:state :forest} nil))) + "Rule does not fire when condition is not met") + (is (= (apply afn (list {:state :grassland} nil)) + {:state :climax}) + "Rule fires when condition is met"))) + + (testing "Property is more than numeric-value" + (let [afn (compile-rule "if altitude is more than 200 then state should be snow")] + (is (= (apply afn (list {:altitude 201} nil)) + {:state :snow :altitude 201}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:altitude 200} nil))) + "Rule does not fire when condition is not met"))) + +;; TODO: this one is very tricky and will require a rethink of the way conditions are parsed. +;; (testing "Property is more than property" +;; (let [afn (compile-rule "if wolves are more than deer then deer should be 0")] +;; (is (= (apply afn (list {:deer 2 :wolves 3} nil)) +;; {:deer 0 :wolves 3}) +;; "Rule fires when condition is met") +;; (is (nil? (apply afn (list {:deer 3 :wolves 2} nil))) +;; "Rule does not fire when condition is not met"))) + + (testing "Property is less than numeric-value" + (let [afn (compile-rule "if altitude is less than 10 then state should be water")] + (is (= (apply afn (list {:altitude 9} nil)) + {:state :water :altitude 9}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:altitude 10} nil))) + "Rule does not fire when condition is not met"))) + + (testing "Property is less than property" + (let [afn (compile-rule "if wolves are less than deer then deer should be deer - wolves")] + (is (= (apply afn (list {:deer 3 :wolves 2} nil)) + {:deer 1 :wolves 2}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:deer 2 :wolves 3} nil))) + "Rule does not fire when condition is not met"))) + + (testing "Number neighbours have property equal to value" + (let [afn (compile-rule "if 3 neighbours have state equal to new then state should be water") + world (make-world 3 3)] + (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 three neighbours)") + (is (nil? (apply afn (list {:x 1 :y 1} world))) + "Middle cell has eight neighbours, so rule does not fire.")) + (let [afn (compile-rule "if 3 neighbours are new then state should be water") + world (make-world 3 3)] + ;; 'are new' and 'is new' should be the same as 'have state equal to new' + (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 three neighbours)") + (is (nil? (apply afn (list {:x 1 :y 1} world))) + "Middle cell has eight neighbours, so rule does not fire.")) + (let [afn (compile-rule "if 3 neighbours is new then state should be water") + world (make-world 3 3)] + ;; 'are new' and 'is new' should be the same as 'have state equal to new' + (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 three neighbours)") + (is (nil? (apply afn (list {:x 1 :y 1} world))) + "Middle cell has eight neighbours, so rule does not fire."))) + + (testing "Number neighbours have property more than numeric-value" + (let [afn (compile-rule "if 3 neighbours have altitude more than 10 then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "if x is less than 2 then altitude should be 0")))] + (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) + "Rule fires when condition is met (strip of altitude 11 down right hand side)") + (is (nil? (apply afn (list {:x 2 :y 1} world))) + "Middle cell of the strip has only two high neighbours, so rule should not fire."))) + + (testing "Number neighbours have property less than numeric-value" + (let [afn (compile-rule "if 5 neighbours have altitude less than 10 then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "if x is less than 2 then altitude should be 0")))] + (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) + "Rule fires when condition is met (strip of altitude 11 down right hand side)") + (is (nil? (apply afn (list {:x 2 :y 1} world))) + "Middle cell of the strip has two high neighbours, so rule should not fire."))) + + (testing "More than number neighbours have property equal to numeric-value" + (let [afn (compile-rule "if more than 2 neighbours have altitude equal to 11 then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "if x is less than 2 then altitude should be 0")))] + (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) + "Rule fires when condition is met (strip of altitude 11 down right hand side)") + (is (nil? (apply afn (list {:x 2 :y 1} world))) + "Middle cell of the strip has only two high neighbours, so rule should not fire."))) + + (testing "More than number neighbours have property equal to symbolic-value" + (let [afn (compile-rule "if more than 2 neighbours have state equal to grassland then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") + (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))] + (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) + "Rule fires when condition is met (strip of altitude 11 down right hand side)") + (is (nil? (apply afn (list {:x 2 :y 1} world))) + "Middle cell of the strip has only two high neighbours, so rule should not fire.")) + (let [afn (compile-rule "if more than 2 neighbours are grassland then state should be beach") + ;; 'are grassland' should mean the same as 'have state equal to grassland'. + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") + (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))] + (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) + "Rule fires when condition is met (strip of altitude 11 down right hand side)") + (is (nil? (apply afn (list {:x 2 :y 1} world))) + "Middle cell of the strip has only two high neighbours, so rule should not fire.")) + ) + + (testing "Fewer than number neighbours have property equal to numeric-value" + (let [afn (compile-rule "if fewer than 3 neighbours have altitude equal to 11 then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "if x is less than 2 then altitude should be 0")))] + (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) + "Rule fires when condition is met (Middle cell of the strip has only two high neighbours)") + (is (nil? (apply afn (list {:x 1 :y 1} world))) + "Middle cell of world has three high neighbours, so rule should not fire."))) + + (testing "Fewer than number neighbours have property equal to symbolic-value" + (let [afn (compile-rule "if fewer than 3 neighbours have state equal to grassland then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") + (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))] + (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) + "Rule fires when condition is met (Middle cell of the strip has only two high neighbours)") + (is (nil? (apply afn (list {:x 1 :y 1} world))) + "Middle cell of world has three high neighbours, so rule should not fire."))) + +;; some neighbours have property equal to value + (testing "Some neighbours have property equal to numeric-value" + (let [afn (compile-rule "if some neighbours have altitude equal to 11 then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "if x is less than 2 then altitude should be 0")))] + (is (= (:state (apply afn (list {:x 1 :y 1} 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))) + "Left hand side of world has no high neighbours, so rule should not fire."))) + + (testing "Some neighbours have property equal to symbolic-value" + (let [afn (compile-rule "if some neighbours have state equal to grassland then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") + (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))] + (is (= (:state (apply afn (list {:x 1 :y 1} 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))) + "Left hand side of world has no high neighbours, so rule should not fire."))) + +;; more than number neighbours have property more than numeric-value + (testing "More than number neighbours have property more than symbolic-value" + (let [afn (compile-rule "if more than 2 neighbours have altitude more than 10 then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") + (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))] + (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) + "Rule fires when condition is met (strip of altitude 11 down right hand side)") + (is (nil? (apply afn (list {:x 2 :y 1} world))) + "Middle cell of the strip has only two high neighbours, so rule should not fire."))) + +;; fewer than number neighbours have property more than numeric-value + (testing "Fewer than number neighbours have property more than numeric-value" + (let [afn (compile-rule "if fewer than 3 neighbours have altitude more than 10 then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "if x is less than 2 then altitude should be 0")))] + (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) + "Rule fires when condition is met (Middle cell of the strip has only two high neighbours)") + (is (nil? (apply afn (list {:x 1 :y 1} world))) + "Middle cell of world has three high neighbours, so rule should not fire."))) + +;; some neighbours have property more than numeric-value + (testing "Some neighbours have property more than numeric-value" + (let [afn (compile-rule "if some neighbours have altitude more than 10 then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "if x is less than 2 then altitude should be 0")))] + (is (= (:state (apply afn (list {:x 1 :y 1} 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))) + "Left hand side of world has no high neighbours, so rule should not fire."))) + +;; more than number neighbours have property less than numeric-value + (testing "More than number neighbours have property less than numeric-value" + (let [afn (compile-rule "if more than 4 neighbours have altitude less than 10 then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "if x is less than 2 then altitude should be 0")))] + (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) + "Rule fires when condition is met (strip of altitude 11 down right hand side)") + (is (nil? (apply afn (list {:x 2 :y 1} world))) + "Middle cell of the strip has only three low neighbours, so rule should not fire."))) + +;; fewer than number neighbours have property less than numeric-value + (testing "Fewer than number neighbours have property less than numeric-value" + (let [afn (compile-rule "if fewer than 4 neighbours have altitude less than 10 then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "if x is less than 2 then altitude should be 0")))] + (is (nil? (apply afn (list {:x 1 :y 1} world))) + "Centre cell has five low neighbours, so rule should not fire") + (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) + "Middle cell of the strip has only three low neighbours, so rule should fire."))) + +;; some neighbours have property less than numeric-value + (testing "Some number neighbours have property less than numeric-value" + (let [afn (compile-rule "if some neighbours have altitude less than 10 then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is less than 2 then altitude should be 11") + (compile-rule "if x is 2 then altitude should be 0")))] + (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) + "Rule fires when condition is met (strip of altitude 0 down right hand side)") + (is (nil? (apply afn (list {:x 0 :y 1} world))) + "Left of world is all high, so rule should not fire."))) + + +;; 'single action' already tested in 'condition' tests above +;; action and actions + (testing "Conjunction of actions" + (let [afn (compile-rule "if state is new then state should be grassland and fertility should be 0")] + (is (= (apply afn (list {:state :new} nil)) + {:state :grassland :fertility 0}) + "Both actions are executed"))) + +;; 'property should be symbolic-value' and 'property should be numeric-value' +;; already tested in tests above + +;; number chance in number property should be value + (testing "Syntax of probability rule - action of real probability very hard to test" + (let [afn (compile-rule "if state is forest then 5 chance in 5 state should be climax")] + (is (= (:state (apply afn (list {:state :forest} nil))) :climax) + "five chance in five should fire every time")) + (let [afn (compile-rule "if state is forest then 0 chance in 5 state should be climax")] + (is (nil? (apply afn (list {:state :forest} nil))) + "zero chance in five should never fire"))) + +;; property operator numeric-value + (testing "Arithmetic action: addition of number" + (let [afn (compile-rule "if state is climax then fertility should be fertility + 1")] + (is (= (:fertility + (apply afn (list {:state :climax :fertility 0} nil))) + 1) + "Addition is executed"))) + + (testing "Arithmetic action: addition of property value" + (let [afn (compile-rule "if state is climax then fertility should be fertility + leaf-fall")] + (is (= (:fertility + (apply afn + (list {:state :climax + :fertility 0 + :leaf-fall 1} nil))) + 1) + "Addition is executed"))) + + (testing "Arithmetic action: subtraction of number" + (let [afn (compile-rule "if state is crop then fertility should be fertility - 1")] + (is (= (:fertility + (apply afn (list {:state :crop :fertility 2} nil))) + 1) + "Action is executed"))) + + (testing "Arithmetic action: subtraction of property value" + (let [afn (compile-rule "if wolves are more than 0 then deer should be deer - wolves")] + (is (= (:deer + (apply afn + (list {:deer 3 + :wolves 2} nil))) + 1) + "Action is executed"))) + + (testing "Arithmetic action: multiplication by number" + (let [afn (compile-rule "if deer are more than 1 then deer should be deer * 2")] + (is (= (:deer + (apply afn (list {:deer 2} nil))) + 4) + "Action is executed"))) + + (testing "Arithmetic action: multiplication by property value" + (let [afn (compile-rule "if state is crop then deer should be deer * deer")] + (is (= (:deer + (apply afn + (list {:state :crop :deer 2} nil))) + 4) + "Action is executed"))) + + (testing "Arithmetic action: division by number" + (let [afn (compile-rule "if wolves are more than 0 then deer should be deer / 2")] + (is (= (:deer + (apply afn (list {:deer 2 :wolves 1} nil))) + 1) + "Action is executed"))) + + (testing "Arithmetic action: division by property value" + (let [afn (compile-rule "if wolves are more than 0 then deer should be deer / wolves")] + (is (= (:deer + (apply afn + (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.")) + ))