diff --git a/README.md b/README.md index 76f662d..b2ce28f 100644 --- a/README.md +++ b/README.md @@ -2,17 +2,6 @@ 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 @@ -199,15 +188,6 @@ 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 d48db45..66d845e 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-parser "0.1.5-SNAPSHOT" +(defproject mw-parser "0.1.3" :description "Parser for production rules for MicroWorld engine" :url "http://www.journeyman.cc/microworld" :manifest { @@ -11,8 +11,7 @@ :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.6.0"] - [org.clojure/tools.trace "0.7.9"] - [instaparse "1.4.1"] - [mw-engine "0.1.5-SNAPSHOT"] + :dependencies [[org.clojure/clojure "1.5.1"] + [org.clojure/tools.trace "0.7.8"] + [mw-engine "0.1.3"] ]) diff --git a/src/mw_parser/bulk.clj b/src/mw_parser/bulk.clj index b4674ec..b49ca0a 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 aafd595..4f1159e 100644 --- a/src/mw_parser/core.clj +++ b/src/mw_parser/core.clj @@ -20,10 +20,8 @@ ;; 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 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. +;; 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. (ns mw-parser.core (:use mw-engine.utils diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj deleted file mode 100644 index 8bea7dd..0000000 --- a/src/mw_parser/declarative.clj +++ /dev/null @@ -1,368 +0,0 @@ -(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 deleted file mode 100644 index 9943256..0000000 --- a/src/mw_parser/simplifier.clj +++ /dev/null @@ -1,92 +0,0 @@ -(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 deleted file mode 100644 index 86cb449..0000000 --- a/test/mw_parser/declarative_test.clj +++ /dev/null @@ -1,517 +0,0 @@ -(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.")) - ))