simon/mw-parser
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Started work on generating code from flow rules.

Browse source
This commit is contained in:
Simon Brooke 2023-07-12 23:43:59 +01:00
parent 256f9efd5e
commit 2a5d598f28
7 changed files with 649 additions and 655 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

263
src/mw_parser/core.clj
View file

@ -3,11 +3,10 @@
**NOTE**: This parser is obsolete and is superceded by the
declarative parser, q.v."
:author "Simon Brooke"}
mw-parser.core
(:use mw-engine.utils
[clojure.string :only [split trim triml]])
(:gen-class)
)
mw-parser.core
(:require [clojure.string :only [split trim triml]]
[mw-engine.utils :refer [member?]])
(:gen-class))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@ -81,7 +80,7 @@
(cond
(re-matches re-number token) (read-string token)
(keyword? token) token
true (keyword token)))
:else (keyword token)))
;; Generally all functions in this file with names beginning 'parse-' take a
;; sequence of tokens (and in some cases other optional arguments) and return a
@ -97,35 +96,34 @@
(defn parse-numeric-value
"Parse a number."
[[value & remainder]]
(if (and value (re-matches re-number value)) [(read-string value) remainder]))
(when (and value (re-matches re-number value)) [(read-string value) remainder]))
(defn parse-property-int
"Parse a token assumed to be the name of a property of the current cell,
whose value is assumed to be an integer."
[[value & remainder]]
(if value [(list 'get-int 'cell (keyword value)) remainder]))
(when value [(list 'get-int 'cell (keyword value)) remainder]))
(defn parse-property-value
"Parse a token assumed to be the name of a property of the current cell."
[[value & remainder]]
(if value [(list (keyword value) 'cell) remainder]))
(when value [(list (keyword value) 'cell) remainder]))
(defn parse-token-value
"Parse a token assumed to be a simple token value."
[[value & remainder]]
(if value [(keyword value) remainder]))
(when value [(keyword value) remainder]))
(defn parse-simple-value
"Parse a value from the first of these `tokens`. If `expect-int` is true, return
an integer or something which will evaluate to an integer."
([tokens expect-int]
(or
(parse-numeric-value tokens)
(cond expect-int
(parse-property-int tokens)
true (parse-token-value tokens))))
(or
(parse-numeric-value tokens)
(cond expect-int (parse-property-int tokens)
:else (parse-token-value tokens))))
([tokens]
(parse-simple-value tokens false)))
(parse-simple-value tokens false)))
(defn gen-token-value
"Parse a single value from this single token and return just the generated
@ -138,28 +136,28 @@
integers or things which will evaluate to integers."
[[OR token & tokens] expect-int]
(cond (member? OR '("or" "in"))
(let [value (first (parse-simple-value (list token) expect-int))
seek-others (= (first tokens) "or")]
(cond seek-others
(let [[others remainder] (parse-disjunct-value tokens expect-int)]
[(cons value others) remainder])
true
[(list value) tokens]))))
(let [value (first (parse-simple-value (list token) expect-int))
seek-others (= (first tokens) "or")]
(cond seek-others
(let [[others remainder] (parse-disjunct-value tokens expect-int)]
[(cons value others) remainder])
:else
[(list value) tokens]))))
(defn parse-value
"Parse a value from among these `tokens`. If `expect-int` is true, return
an integer or something which will evaluate to an integer."
([tokens expect-int]
(or
(parse-disjunct-value tokens expect-int)
(parse-simple-value tokens expect-int)))
(or
(parse-disjunct-value tokens expect-int)
(parse-simple-value tokens expect-int)))
([tokens]
(parse-value tokens false)))
(parse-value tokens false)))
(defn parse-member-condition
"Parses a condition of the form '[property] in [value] or [value]...'"
[[property IS IN & rest]]
(if (and (member? IS '("is" "are")) (= IN "in"))
(when (and (member? IS '("is" "are")) (= IN "in"))
(let [[l remainder] (parse-disjunct-value (cons "in" rest) false)]
[(list 'member? (list (keyword property) 'cell) (list 'quote l)) remainder])))
@ -167,73 +165,72 @@
"Parse '[property] less than [value]'."
[[property IS LESS THAN & rest]]
(cond (and (member? IS '("is" "are")) (member? LESS '("less" "fewer")) (= THAN "than"))
(let [[value remainder] (parse-value rest true)]
[(list '< (list 'get-int 'cell (keyword property)) value) remainder])))
(let [[value remainder] (parse-value rest true)]
[(list '< (list 'get-int 'cell (keyword property)) value) remainder])))
(defn- parse-more-condition
"Parse '[property] more than [value]'."
[[property IS MORE THAN & rest]]
(cond (and (member? IS '("is" "are")) (member? MORE '("more" "greater")) (= THAN "than"))
(let [[value remainder] (parse-value rest true)]
[(list '> (list 'get-int 'cell (keyword property)) value) remainder])))
(let [[value remainder] (parse-value rest true)]
[(list '> (list 'get-int 'cell (keyword property)) value) remainder])))
(defn- parse-between-condition
[[p IS BETWEEN v1 AND v2 & rest]]
(cond (and (member? IS '("is" "are")) (= BETWEEN "between") (= AND "and") (not (nil? v2)))
(let [property (first (parse-simple-value (list p) true))
value1 (first (parse-simple-value (list v1) true))
value2 (first (parse-simple-value (list v2) true))]
[(list 'or
(list '< value1 property value2)
(list '> value1 property value2)) rest])))
(let [property (first (parse-simple-value (list p) true))
value1 (first (parse-simple-value (list v1) true))
value2 (first (parse-simple-value (list v2) true))]
[(list 'or
(list '< value1 property value2)
(list '> value1 property value2)) rest])))
(defn- parse-is-condition
"Parse clauses of the form 'x is y', 'x is in y or z...',
'x is between y and z', 'x is more than y' or 'x is less than y'.
It is necessary to disambiguate whether value is a numeric or keyword."
[[property IS value & rest]]
(cond
(when
(member? IS '("is" "are"))
(let [tokens (cons property (cons value rest))]
(cond
(re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest]
value [(list '= (list (keyword property) 'cell) (keyword value)) rest]))))
(cond
(re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest]
value [(list '= (list (keyword property) 'cell) (keyword value)) rest])))
(defn- parse-not-condition
"Parse the negation of a simple condition."
[[property IS NOT & rest]]
(cond (and (member? IS '("is" "are")) (= NOT "not"))
(let [partial (parse-simple-condition (cons property (cons "is" rest)))]
(cond partial
(let [[condition remainder] partial]
[(list 'not condition) remainder])))))
(let [partial (parse-simple-condition (cons property (cons "is" rest)))]
(cond partial
(let [[condition remainder] partial]
[(list 'not condition) remainder])))))
(defn- gen-neighbours-condition
([comp1 quantity property value remainder comp2 distance]
[(list comp1
(list 'count
(list 'get-neighbours-with-property-value 'world
'(cell :x) '(cell :y) distance
(keyword property) (keyword-or-numeric value) comp2))
quantity)
remainder])
[(list comp1
(list 'count
(list 'get-neighbours-with-property-value 'world
'(cell :x) '(cell :y) distance
(keyword property) (keyword-or-numeric value) comp2))
quantity)
remainder])
([comp1 quantity property value remainder comp2]
(gen-neighbours-condition comp1 quantity property value remainder comp2 1)))
(gen-neighbours-condition comp1 quantity property value remainder comp2 1)))
(defn parse-comparator-neighbours-condition
"Parse conditions of the form '...more than 6 neighbours are [condition]'"
[[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]]
(let [quantity (first (parse-numeric-value (list n)))
comparator (cond (= MORE "more") '>
(member? MORE '("fewer" "less")) '<)]
(member? MORE '("fewer" "less")) '<)]
(cond
(not= WITHIN "within")
(parse-comparator-neighbours-condition
(flatten
(flatten
;; two tokens were mis-parsed as 'within distance' that weren't
;; actually 'within' and a distance. Splice in 'within 1' and try
;; again.
(list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
(list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
(and quantity
comparator
(= THAN "than")
@ -247,15 +244,14 @@
(let [[property comp1 comp2 value & remainder] rest
dist (gen-token-value distance true)]
(cond (and (= comp1 "equal") (= comp2 "to"))
(gen-neighbours-condition comparator quantity property
value remainder = dist)
(and (= comp1 "more") (= comp2 "than"))
(gen-neighbours-condition comparator quantity property
value remainder > dist)
(and (= comp1 "less") (= comp2 "than"))
(gen-neighbours-condition comparator quantity property
value remainder < dist)
))))))
(gen-neighbours-condition comparator quantity property
value remainder = dist)
(and (= comp1 "more") (= comp2 "than"))
(gen-neighbours-condition comparator quantity property
value remainder > dist)
(and (= comp1 "less") (= comp2 "than"))
(gen-neighbours-condition comparator quantity property
value remainder < dist)))))))
(defn parse-some-neighbours-condition
[[SOME NEIGHBOURS & rest]]
@ -272,11 +268,11 @@
(cond
(not= WITHIN "within")
(parse-simple-neighbours-condition
(flatten
(flatten
;; two tokens were mis-parsed as 'within distance' that weren't
;; actually 'within' and a distance. Splice in 'within 1' and try
;; again.
(list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
(list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
(= have-or-are "are")
(let [[value & remainder] rest
dist (gen-token-value distance true)]
@ -285,42 +281,40 @@
(let [[property comp1 comp2 value & remainder] rest
dist (gen-token-value distance true)]
(cond (and (= comp1 "equal") (= comp2 "to"))
(gen-neighbours-condition '= quantity property value remainder =
dist)
(and (= comp1 "more") (= comp2 "than"))
(gen-neighbours-condition '= quantity property value remainder >
dist)
(and (= comp1 "less") (= comp2 "than"))
(gen-neighbours-condition '= quantity property value remainder <
dist)
))))))
(gen-neighbours-condition '= quantity property value remainder =
dist)
(and (= comp1 "more") (= comp2 "than"))
(gen-neighbours-condition '= quantity property value remainder >
dist)
(and (= comp1 "less") (= comp2 "than"))
(gen-neighbours-condition '= quantity property value remainder <
dist)))))))
(defn parse-neighbours-condition
"Parse conditions referring to neighbours"
[tokens]
(or
(parse-simple-neighbours-condition tokens)
(parse-comparator-neighbours-condition tokens)
(parse-some-neighbours-condition tokens)
))
(parse-simple-neighbours-condition tokens)
(parse-comparator-neighbours-condition tokens)
(parse-some-neighbours-condition tokens)))
(defn parse-simple-condition
"Parse conditions of the form '[property] [comparison] [value]'."
[tokens]
(or
(parse-neighbours-condition tokens)
(parse-member-condition tokens)
(parse-not-condition tokens)
(parse-less-condition tokens)
(parse-more-condition tokens)
(parse-between-condition tokens)
(parse-is-condition tokens)))
(parse-neighbours-condition tokens)
(parse-member-condition tokens)
(parse-not-condition tokens)
(parse-less-condition tokens)
(parse-more-condition tokens)
(parse-between-condition tokens)
(parse-is-condition tokens)))
(defn- parse-disjunction-condition
"Parse '... or [condition]' from `tokens`, where `left` is the already parsed first disjunct."
[left tokens]
(let [partial (parse-conditions tokens)]
(if partial
(when partial
(let [[right remainder] partial]
[(list 'or left right) remainder]))))
@ -328,7 +322,7 @@
"Parse '... and [condition]' from `tokens`, where `left` is the already parsed first conjunct."
[left tokens]
(let [partial (parse-conditions tokens)]
(if partial
(when partial
(let [[right remainder] partial]
[(list 'and left right) remainder]))))
@ -336,19 +330,19 @@
"Parse conditions from `tokens`, where conditions may be linked by either 'and' or 'or'."
[tokens]
(let [partial (parse-simple-condition tokens)]
(if partial
(when partial
(let [[left [next & remainder]] partial]
(cond
(= next "and") (parse-conjunction-condition left remainder)
(= next "or") (parse-disjunction-condition left remainder)
true partial)))))
:else partial)))))
(defn- parse-left-hand-side
"Parse the left hand side ('if...') of a production rule."
[[IF & tokens]]
(if
"Parse the left hand side ('if...') of a production rule."
[[IF & tokens]]
(when
(= IF "if")
(parse-conditions tokens)))
(parse-conditions tokens)))
(defn- parse-arithmetic-action
"Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]',
@ -357,16 +351,19 @@
(cond
(member? prop1 '("x" "y"))
(throw
(Exception. reserved-properties-error))
(Exception. reserved-properties-error))
(and (= SHOULD "should")
(= BE "be")
(member? operator '("+" "-" "*" "/")))
(= BE "be")
(member? operator '("+" "-" "*" "/")))
[(list 'merge (or previous 'cell)
{(keyword prop1) (list 'int
(list (symbol operator) (list 'get-int 'cell (keyword prop2))
(cond
(re-matches re-number value) (read-string value)
true (list 'get-int 'cell (keyword value)))))}) rest]))
(list (symbol operator)
(list 'get-int 'cell (keyword prop2))
(if
(re-matches re-number value)
(read-string value)
(list 'get-int 'cell (keyword value)))))})
rest]))
(defn- parse-set-action
"Parse actions of the form '[property] should be [value].'"
@ -374,10 +371,13 @@
(cond
(member? property '("x" "y"))
(throw
(Exception. reserved-properties-error))
(Exception. reserved-properties-error))
(and (= SHOULD "should") (= BE "be"))
[(list 'merge (or previous 'cell)
{(keyword property) (cond (re-matches re-number value) (read-string value) true (keyword value))}) rest]))
{(keyword property) (if
(re-matches re-number value)
(read-string value)
(keyword value))}) rest]))
(defn- parse-simple-action [previous tokens]
(or (parse-arithmetic-action previous tokens)
@ -390,29 +390,29 @@
(cond left
(cond (= (first remainder) "and")
(parse-actions left (rest remainder))
true (list left)))))
:else (list left)))))
(defn- parse-probability
"Parse a probability of an action from this collection of tokens"
[previous [n CHANCE IN m & tokens]]
(cond
(and (= CHANCE "chance")(= IN "in"))
(and (= CHANCE "chance") (= IN "in"))
(let [[action remainder] (parse-actions previous tokens)]
(cond action
[(list 'cond
(list '<
(list 'rand
(first (parse-simple-value (list m) true)))
(first (parse-simple-value (list n) true)))
action) remainder]))))
[(list 'cond
(list '<
(list 'rand
(first (parse-simple-value (list m) true)))
(first (parse-simple-value (list n) true)))
action) remainder]))))
(defn- parse-right-hand-side
"Parse the right hand side ('then...') of a production rule."
[[THEN & tokens]]
(if (= THEN "then")
(when (= THEN "then")
(or
(parse-probability nil tokens)
(parse-actions nil tokens))))
(parse-probability nil tokens)
(parse-actions nil tokens))))
(defn parse-rule
"Parse a complete rule from this `line`, expected to be either a string or a
@ -420,18 +420,16 @@
Throws an exception if parsing fails."
[line]
(cond
(string? line)
(let [rule (parse-rule (split (triml line) #"\s+"))]
(cond rule rule
true (throw (Exception. (format bad-parse-error line)))))
true
(if
(string? line) (let [rule (parse-rule (split (triml line) #"\s+"))]
(if rule rule
(throw (Exception. (format bad-parse-error line)))))
(let [[left remainder] (parse-left-hand-side line)
[right junk] (parse-right-hand-side remainder)]
(cond
[right junk] (parse-right-hand-side remainder)]
(when
;; there should be a valide left hand side and a valid right hand side
;; there shouldn't be anything left over (junk should be empty)
(and left right (empty? junk))
(and left right (empty? junk))
(list 'fn ['cell 'world] (list 'if left right))))))
(defn compile-rule
@ -444,11 +442,10 @@
Throws an exception if parsing fails."
([rule-text return-tuple?]
(do
(use 'mw-engine.utils)
(let [afn (eval (parse-rule rule-text))]
(cond
(and afn return-tuple?)(list afn (trim rule-text))
true afn))))
(let [afn (eval (parse-rule rule-text))]
(if
(and afn return-tuple?)
(list afn (trim rule-text))
afn)))
([rule-text]
(compile-rule rule-text false)))
(compile-rule rule-text false)))

66
src/mw_parser/declarative.clj
View file

@ -1,9 +1,10 @@
(ns ^{:doc "A very simple parser which parses production rules."
:author "Simon Brooke"}
mw-parser.declarative
(:require [instaparse.core :refer [parser]]
[clojure.string :refer [join trim]]
(:require [clojure.string :refer [join split trim]]
[instaparse.core :refer [parser]]
[mw-parser.errors :refer [throw-parse-exception]]
[mw-parser.flow :refer [flow-grammar]]
[mw-parser.generate :refer [generate]]
[mw-parser.simplify :refer [simplify]]
[mw-parser.utils :refer [rule?]]
@ -71,8 +72,7 @@
"SPACE := #'\\s+';"
"VALUE := SYMBOL | NUMBER;"
"VALUE := SYMBOL | NUMBER;"
"WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;"
]))
"WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;"]))
(def keywords-en
"English language keyword literals used in rules - both in production
@ -81,33 +81,33 @@
It's a long term aim that the rule language should be easy to
internationalise; this isn't a full solution but it's a step towards
a solution."
(join "\n" ["ALL := 'all'"
"AND := 'and';"
"BECOMES := 'should be' | 'becomes';"
"BETWEEN := 'between';"
"CHANCE-IN := 'chance in';"
(join "\n" ["ALL := 'all'"
"AND := 'and';"
"BECOMES := 'should be' | 'becomes';"
"BETWEEN := 'between';"
"CHANCE-IN := 'chance in';"
"EACH := 'each' | 'every' | 'all';"
"EQUAL := 'equal to';"
"EQUAL := 'equal to';"
"FIRST := 'first';"
"FLOW := 'flow' | 'move';"
"FLOW := 'flow' | 'move';"
"FROM := 'from';"
"IF := 'if';"
"IN := 'in';"
"IS := 'is' | 'are' | 'have' | 'has';"
"IF := 'if';"
"IN := 'in';"
"IS := 'is' | 'are' | 'have' | 'has';"
"LEAST := 'least';"
"LESS := 'less' | 'fewer';"
"MORE := 'more' | 'greater';"
"LESS := 'less' | 'fewer';"
"MORE := 'more' | 'greater';"
"MOST := 'most';"
"NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';"
"NONE := 'no';"
"NOT := 'not';"
"OR := 'or';"
"SOME := 'some';"
"NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';"
"NONE := 'no';"
"NOT := 'not';"
"OR := 'or';"
"SOME := 'some';"
;; SYMBOL is in the per-language file so that languages that use
;; (e.g.) Cyrillic characters can change the definition.
"SYMBOL := #'[a-z]+';"
"THAN := 'than';"
"THEN := 'then';"
"SYMBOL := #'[a-z]+';"
"THAN := 'than';"
"THEN := 'then';"
"TO := 'to';"
"WITH := 'with' | 'where' | 'having';"
"WITHIN := 'within';"]))
@ -122,7 +122,7 @@
([^Locale _locale]
keywords-en))
(defmacro build-parser
(defmacro build-parser
"Compose this grammar fragment `g` with the common grammar fragments to
make a complete grammar, and return a parser for that complete grammar."
[g]
@ -132,6 +132,22 @@
"Parse the argument, assumed to be a string in the correct syntax, and return a parse tree."
(build-parser rule-grammar))
(def parse-flow
"Parse the argument, assumed to be a string in the correct syntax, and return a parse tree."
(build-parser flow-grammar))
(defn parse
"Top level parser function: parse this `text` as either a production or a flow rule;
return a raw parse tree."
[^String rule-text]
(let [text (trim rule-text)]
(when-not (zero? (count text))
(case (first (split text #"\s+"))
"if" (parse-rule text)
"flow" (parse-flow text)
";;" nil
(throw (ex-info "Rule text was not recognised" {:text text}))))))
(defn compile-rule
"Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules,
into Clojure source, and then compile it into an anonymous

36
src/mw_parser/flow.clj
View file

@ -1,9 +1,7 @@
(ns ^{:doc "A very simple parser which parses flow rules."
:author "Simon Brooke"}
mw-parser.flow
(:require [clojure.string :refer [join]]
[mw-parser.declarative :refer [build-parser]]
[mw-parser.simplify :refer [simplify-second-of-two]]))
(:require [clojure.string :refer [join]]))
(def flow-grammar
"Grammar for flow rules.
@ -21,7 +19,7 @@
The basic rule I want to be able to compile at this stage is the 'mutual
aid' rule:
`flow 1 food from house having food > 1 to house with least food within 2`
`flow 1 food from house to house within 2 with least food`
"
(join "\n" ["FLOW-RULE := FLOW SPACE QUANTITY SPACE PROPERTY SPACE FROM SPACE SOURCE SPACE TO-HOW SPACE DESTINATION;"
"PERCENTAGE := NUMBER #'%';"
@ -35,33 +33,3 @@
"TO-HOW := TO | TO-EACH | TO-FIRST;"
"TO-EACH := TO SPACE EACH | TO SPACE ALL;"
"TO-FIRST := TO SPACE FIRST"]))
(def parse-flow
"Parse the argument, assumed to be a string in the correct syntax, and return a parse tree."
(build-parser flow-grammar))
(defn simplify-flow
[tree]
(if (coll? tree)
(case (first tree)
:CONDITION (simplify-second-of-two tree)
:CONDITIONS (simplify-second-of-two tree)
:DETERMINER (simplify-second-of-two tree)
;; :DETERMINER-CONDITION (simplify-determiner-condition tree)
:EXPRESSION (simplify-second-of-two tree)
:FLOW nil
;; :FLOW-CONDITIONS (simplify-second-of-two tree)
:PROPERTY (simplify-second-of-two tree)
:PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
:SPACE nil
:QUANTITY (simplify-second-of-two tree)
:STATE (list :PROPERTY-CONDITION
(list :SYMBOL "state")
'(:QUALIFIER
(:EQUIVALENCE
(:IS "is")))
(list :EXPRESSION
(list :VALUE (second tree))))
(remove nil? (map simplify-flow tree)))
tree))

16
src/mw_parser/generate.clj
View file

@ -280,9 +280,23 @@
;;; (fn [cell world])
;;; (if (= (:state cell) (or (:house cell) :house))
(defmacro flow-rule
[source property quantity-frag destinations]
`(fn [cell world]
(when (and ~source (pos? cell ~property))
(map
(fn [d] {:source (select-keys cell [:x :y])
:destination (select-keys d [:x :y])
:property ~property
:quantity ~quantity-frag})
~destinations))))
(defn generate-flow
[tree]
(assert-type tree :FLOW-RULE))
(assert-type tree :FLOW-RULE)
(let [clauses (reduce #(assoc %1 (first %2) %2) {} (rest tree))]
(list 'fn ['cell 'world]
(list 'when (generate (:SOURCE clauses))))))
;;; Top level; only function anything outside this file (except tests) should
;;; really call.

6
test/mw_parser/bulk_test.clj
View file

@ -1,7 +1,7 @@
(ns mw-parser.bulk-test
(:use clojure.java.io)
(:require [clojure.test :refer :all]
[mw-parser.bulk :refer :all]))
(:require [clojure.java.io :refer [as-file]]
[clojure.test :refer [deftest is testing]]
[mw-parser.bulk :refer [compile-file parse-file]]))
(deftest bulk-parsing-test
(testing "Bulk (file) parsing and compilation"

738
test/mw_parser/core_test.clj
View file

@ -2,470 +2,474 @@
(:require [clojure.test :refer [deftest is testing]]
[mw-engine.core :refer [transform-world]]
[mw-engine.world :refer [make-world]]
[mw-parser.core :refer [compile-rule parse-property-value
[mw-parser.core :refer [compile-rule parse-property-value
parse-rule parse-simple-value
parse-value]]))
(deftest primitives-tests
(testing "Simple functions supporting the parser"
(is (= (parse-simple-value '()) nil)
"if there's nothing to parse, return nil")
(is (= (first (parse-simple-value '("1234" "and" "that"))) 1234)
"a simple value is expected to be just a number.")
(is (= (first (parse-simple-value '("this" "and" "that"))) :this)
"or else just a keyword")
(is (= (first (parse-simple-value '("this" "and" "that") true))
'(get-int cell :this))
"...unless an integer is explicitly sought, in which case it should be something which gets an integer from the current cell")
(is (= (parse-value '()) nil)
"if there's nothing to parse, return nil")
(is (= (first (parse-value '("1234" "and" "that"))) 1234)
"a simple value is expected to be just a number.")
(is (= (first (parse-value '("this" "and" "that"))) :this)
"or else just a keyword")
(is (= (first (parse-value '("this" "and" "that") true))
'(get-int cell :this))
"...unless an integer is explicitly sought, in which case it should be something which gets an integer from the current cell")
(is (= (parse-property-value '()) nil)
"if there's nothing to parse, return nil")
(is (= (first (parse-property-value '("this" "and" "that"))) '(:this cell))
"Parsing a property value returns a code function to pull its value off the current cell")
))
(is (= (parse-simple-value '()) nil)
"if there's nothing to parse, return nil")
(is (= (first (parse-simple-value '("1234" "and" "that"))) 1234)
"a simple value is expected to be just a number.")
(is (= (first (parse-simple-value '("this" "and" "that"))) :this)
"or else just a keyword")
(is (= (first (parse-simple-value '("this" "and" "that") true))
'(get-int cell :this))
"...unless an integer is explicitly sought, in which case it should be something which gets an integer from the current cell")
(is (= (parse-value '()) nil)
"if there's nothing to parse, return nil")
(is (= (first (parse-value '("1234" "and" "that"))) 1234)
"a simple value is expected to be just a number.")
(is (= (first (parse-value '("this" "and" "that"))) :this)
"or else just a keyword")
(is (= (first (parse-value '("this" "and" "that") true))
'(get-int cell :this))
"...unless an integer is explicitly sought, in which case it should be something which gets an integer from the current cell")
(is (= (parse-property-value '()) nil)
"if there's nothing to parse, return nil")
(is (= (first (parse-property-value '("this" "and" "that"))) '(:this cell))
"Parsing a property value returns a code function to pull its value off the current cell")))
(deftest rules-tests
(testing "Rule parser - does not test whether generated functions actually work, just that something is generated!"
(is (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))
(is (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"))
(is (parse-rule "if altitude is 100 or fertility is 25 then state should be heath"))
(is (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 (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"))
(is (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village"))
(is (parse-rule "if state is forest and fertility is between 55 and 75 then state should be climax"))
(is (parse-rule "if 6 neighbours have state equal to water then state should be village"))
(is (parse-rule "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village"))
(is (parse-rule "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire"))
(is (parse-rule "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub"))
))
(is (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))
(is (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"))
(is (parse-rule "if altitude is 100 or fertility is 25 then state should be heath"))
(is (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 (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"))
(is (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village"))
(is (parse-rule "if state is forest and fertility is between 55 and 75 then state should be climax"))
(is (parse-rule "if 6 neighbours have state equal to water then state should be village"))
(is (parse-rule "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village"))
(is (parse-rule "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire"))
(is (parse-rule "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub"))))
(deftest exception-tests
(testing "Constructions which should cause exceptions to be thrown"
(is (thrown-with-msg? Exception #"^I did not understand.*"
(parse-rule "the quick brown fox jumped over the lazy dog"))
"Exception thrown if rule text does not match grammar")
(is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
(parse-rule "if state is new then x should be 0"))
"Exception thrown on attempt to set 'x'")
(is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
(parse-rule "if state is new then y should be 0"))
"Exception thrown on attempt to set 'y'")
(is (thrown? Exception (compile-rule "if state is new then x should be 0"))
"Can't set x property to number, as this would break the world")
(is (thrown? Exception (compile-rule "if state is new then y should be 0"))
"Can't set y property to number, as this would break the world")
(is (thrown? Exception (compile-rule "if state is new then x should be heath"))
"Can't set x property to symbol, as this would break the world")
(is (thrown? Exception (compile-rule "if state is new then y should be heath"))
"Can't set y property to symbol, as this would break the world")
))
(is (thrown-with-msg? Exception #"^I did not understand.*"
(parse-rule "the quick brown fox jumped over the lazy dog"))
"Exception thrown if rule text does not match grammar")
(is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
(parse-rule "if state is new then x should be 0"))
"Exception thrown on attempt to set 'x'")
(is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
(parse-rule "if state is new then y should be 0"))
"Exception thrown on attempt to set 'y'")
(is (thrown? Exception (compile-rule "if state is new then x should be 0"))
"Can't set x property to number, as this would break the world")
(is (thrown? Exception (compile-rule "if state is new then y should be 0"))
"Can't set y property to number, as this would break the world")
(is (thrown? Exception (compile-rule "if state is new then x should be heath"))
"Can't set x property to symbol, as this would break the world")
(is (thrown? Exception (compile-rule "if state is new then y should be heath"))
"Can't set y property to symbol, as this would break the world")))
(deftest correctness-tests
(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"))
(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")))
(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")))
(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")
(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")))
(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")))
(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")))
(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")))
(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")))
(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")))
(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")))
(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)]
(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' 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.")))
(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.")))
(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.")))
(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.")))
(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")
(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."))
)
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.")))
(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.")))
(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.")))
(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.")))
(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.")))
(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.")))
(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.")))
(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.")))
(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.")))
(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.")))
(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")))
(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")))
(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")))
(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")))
(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")))
(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")))
(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")))
(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")))
(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")))
(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")))
(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.")))
(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")
(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."))))
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."))))

179
test/mw_parser/declarative_test.clj
View file

@ -1,10 +1,10 @@
(ns mw-parser.declarative-test
(:require [clojure.test :refer [deftest is testing]]
[mw-engine.core :refer [transform-world]]
[mw-engine.utils :refer [get-cell]]
[mw-engine.world :refer [make-world]]
[mw-parser.declarative :refer [compile-rule parse-rule]]
[mw-parser.utils :refer [rule?]]))
(:require [clojure.test :refer [deftest is testing]]
[mw-engine.core :refer [transform-world]]
[mw-engine.utils :refer [get-cell]]
[mw-engine.world :refer [make-world]]
[mw-parser.declarative :refer [compile-rule parse-rule]]
[mw-parser.utils :refer [rule?]]))
(deftest rules-tests
(testing "Rule parser - does not test whether generated functions actually work, just that something is generated!"
@ -28,8 +28,7 @@
(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")))
))
(is (rule? (parse-rule "if 6 neighbours have state equal to water then state should be village")))))
(deftest exception-tests
@ -40,15 +39,14 @@
(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'")
))
(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
@ -93,12 +91,12 @@
(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 #"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 #"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"
@ -188,9 +186,9 @@
;; if 3 neighbours have altitude more than 10 then state should be beach
(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")))]
(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)))
@ -199,9 +197,9 @@
(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")))]
(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)))
@ -210,9 +208,9 @@
(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")))]
(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)))
@ -221,9 +219,9 @@
(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")))]
(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)))
@ -231,21 +229,20 @@
(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")))]
(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."))
)
"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")))]
(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)))
@ -254,9 +251,9 @@
(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")))]
(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)))
@ -266,9 +263,9 @@
(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")))]
(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)))
@ -277,9 +274,9 @@
(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")))]
(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)))
@ -289,9 +286,9 @@
(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")))]
(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)))
@ -301,9 +298,9 @@
(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")))]
(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)))
@ -313,9 +310,9 @@
(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")))]
(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)))
@ -325,9 +322,9 @@
(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")))]
(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)))
@ -337,9 +334,9 @@
(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")))]
(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)
@ -349,9 +346,9 @@
(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")))]
(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)))
@ -382,63 +379,63 @@
(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)))
(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 + leaffall")]
(is (= (:fertility
(apply afn
(list {:state :climax
:fertility 0
:leaffall 1} nil)))
(apply afn
(list {:state :climax
:fertility 0
:leaffall 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)))
(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)))
(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)))
(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)))
(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)))
(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)))
(apply afn
(list {:deer 2 :wolves 2} nil)))
1)
"Action is executed")))
@ -462,24 +459,22 @@
;; 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")))]
(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."))
))
"Middle cell of the strip has only two high neighbours, so rule should not fire."))))
(deftest regression-tests
(testing "Rule in default set which failed on switchover to declarative rules"
(let [afn (compile-rule "if state is scrub then 1 chance in 1 state should be forest")
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 state should be scrub")))]
(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 state should be scrub")))]
(is (= (:state (apply afn (list (get-cell world 1 1) world))) :forest)
"Centre cell is scrub, so rule should fire")
(is (= (apply afn (list (get-cell world 2 1) world)) nil)
"Middle cell of the strip is not scrub, so rule should not fire."))))