Merge branch 'master' of github.com:simon-brooke/mw-parser

as does one complicated form of neighbours rule; but I'm almost there.

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)

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"]
+  :dependencies [[org.clojure/clojure "1.6.0"]
-                 [org.clojure/tools.trace "0.7.8"]
+                 [org.clojure/tools.trace "0.7.9"]
-                 [mw-engine "0.1.3"]
+                 [instaparse "1.4.1"]
+                 [mw-engine "0.1.5-SNAPSHOT"]
                  ])

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 
+(defn compile-file
-  "Compile each non-comment line of the file indicated by this `filename` into 
+  "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)))

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 significantly it does not generate useful error messages on failure.
-;; more complex issue which I don't yet know how to address.
+;;
+;; 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

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))))
+
+

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"))

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."))
+    ))