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 **NOTE**: This parser is obsolete and is superceded by the
declarative parser, q.v." declarative parser, q.v."
:author "Simon Brooke"} :author "Simon Brooke"}
mw-parser.core mw-parser.core
(:use mw-engine.utils (:require [clojure.string :only [split trim triml]]
[clojure.string :only [split trim triml]]) [mw-engine.utils :refer [member?]])
(:gen-class) (:gen-class))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ;;;;
@ -81,7 +80,7 @@
(cond (cond
(re-matches re-number token) (read-string token) (re-matches re-number token) (read-string token)
(keyword? token) token (keyword? token) token
true (keyword token))) :else (keyword token)))
;; Generally all functions in this file with names beginning 'parse-' take a ;; 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 ;; sequence of tokens (and in some cases other optional arguments) and return a
@ -97,35 +96,34 @@
(defn parse-numeric-value (defn parse-numeric-value
"Parse a number." "Parse a number."
[[value & remainder]] [[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 (defn parse-property-int
"Parse a token assumed to be the name of a property of the current cell, "Parse a token assumed to be the name of a property of the current cell,
whose value is assumed to be an integer." whose value is assumed to be an integer."
[[value & remainder]] [[value & remainder]]
(if value [(list 'get-int 'cell (keyword value)) remainder])) (when value [(list 'get-int 'cell (keyword value)) remainder]))
(defn parse-property-value (defn parse-property-value
"Parse a token assumed to be the name of a property of the current cell." "Parse a token assumed to be the name of a property of the current cell."
[[value & remainder]] [[value & remainder]]
(if value [(list (keyword value) 'cell) remainder])) (when value [(list (keyword value) 'cell) remainder]))
(defn parse-token-value (defn parse-token-value
"Parse a token assumed to be a simple token value." "Parse a token assumed to be a simple token value."
[[value & remainder]] [[value & remainder]]
(if value [(keyword value) remainder])) (when value [(keyword value) remainder]))
(defn parse-simple-value (defn parse-simple-value
"Parse a value from the first of these `tokens`. If `expect-int` is true, return "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." an integer or something which will evaluate to an integer."
([tokens expect-int] ([tokens expect-int]
(or (or
(parse-numeric-value tokens) (parse-numeric-value tokens)
(cond expect-int (cond expect-int (parse-property-int tokens)
(parse-property-int tokens) :else (parse-token-value tokens))))
true (parse-token-value tokens))))
([tokens] ([tokens]
(parse-simple-value tokens false))) (parse-simple-value tokens false)))
(defn gen-token-value (defn gen-token-value
"Parse a single value from this single token and return just the generated "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." integers or things which will evaluate to integers."
[[OR token & tokens] expect-int] [[OR token & tokens] expect-int]
(cond (member? OR '("or" "in")) (cond (member? OR '("or" "in"))
(let [value (first (parse-simple-value (list token) expect-int)) (let [value (first (parse-simple-value (list token) expect-int))
seek-others (= (first tokens) "or")] seek-others (= (first tokens) "or")]
(cond seek-others (cond seek-others
(let [[others remainder] (parse-disjunct-value tokens expect-int)] (let [[others remainder] (parse-disjunct-value tokens expect-int)]
[(cons value others) remainder]) [(cons value others) remainder])
true :else
[(list value) tokens])))) [(list value) tokens]))))
(defn parse-value (defn parse-value
"Parse a value from among these `tokens`. If `expect-int` is true, return "Parse a value from among these `tokens`. If `expect-int` is true, return
an integer or something which will evaluate to an integer." an integer or something which will evaluate to an integer."
([tokens expect-int] ([tokens expect-int]
(or (or
(parse-disjunct-value tokens expect-int) (parse-disjunct-value tokens expect-int)
(parse-simple-value tokens expect-int))) (parse-simple-value tokens expect-int)))
([tokens] ([tokens]
(parse-value tokens false))) (parse-value tokens false)))
(defn parse-member-condition (defn parse-member-condition
"Parses a condition of the form '[property] in [value] or [value]...'" "Parses a condition of the form '[property] in [value] or [value]...'"
[[property IS IN & rest]] [[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)] (let [[l remainder] (parse-disjunct-value (cons "in" rest) false)]
[(list 'member? (list (keyword property) 'cell) (list 'quote l)) remainder]))) [(list 'member? (list (keyword property) 'cell) (list 'quote l)) remainder])))
@ -167,73 +165,72 @@
"Parse '[property] less than [value]'." "Parse '[property] less than [value]'."
[[property IS LESS THAN & rest]] [[property IS LESS THAN & rest]]
(cond (and (member? IS '("is" "are")) (member? LESS '("less" "fewer")) (= THAN "than")) (cond (and (member? IS '("is" "are")) (member? LESS '("less" "fewer")) (= THAN "than"))
(let [[value remainder] (parse-value rest true)] (let [[value remainder] (parse-value rest true)]
[(list '< (list 'get-int 'cell (keyword property)) value) remainder]))) [(list '< (list 'get-int 'cell (keyword property)) value) remainder])))
(defn- parse-more-condition (defn- parse-more-condition
"Parse '[property] more than [value]'." "Parse '[property] more than [value]'."
[[property IS MORE THAN & rest]] [[property IS MORE THAN & rest]]
(cond (and (member? IS '("is" "are")) (member? MORE '("more" "greater")) (= THAN "than")) (cond (and (member? IS '("is" "are")) (member? MORE '("more" "greater")) (= THAN "than"))
(let [[value remainder] (parse-value rest true)] (let [[value remainder] (parse-value rest true)]
[(list '> (list 'get-int 'cell (keyword property)) value) remainder]))) [(list '> (list 'get-int 'cell (keyword property)) value) remainder])))
(defn- parse-between-condition (defn- parse-between-condition
[[p IS BETWEEN v1 AND v2 & rest]] [[p IS BETWEEN v1 AND v2 & rest]]
(cond (and (member? IS '("is" "are")) (= BETWEEN "between") (= AND "and") (not (nil? v2))) (cond (and (member? IS '("is" "are")) (= BETWEEN "between") (= AND "and") (not (nil? v2)))
(let [property (first (parse-simple-value (list p) true)) (let [property (first (parse-simple-value (list p) true))
value1 (first (parse-simple-value (list v1) true)) value1 (first (parse-simple-value (list v1) true))
value2 (first (parse-simple-value (list v2) true))] value2 (first (parse-simple-value (list v2) true))]
[(list 'or [(list 'or
(list '< value1 property value2) (list '< value1 property value2)
(list '> value1 property value2)) rest]))) (list '> value1 property value2)) rest])))
(defn- parse-is-condition (defn- parse-is-condition
"Parse clauses of the form 'x is y', 'x is in y or z...', "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'. '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." It is necessary to disambiguate whether value is a numeric or keyword."
[[property IS value & rest]] [[property IS value & rest]]
(cond (when
(member? IS '("is" "are")) (member? IS '("is" "are"))
(let [tokens (cons property (cons value rest))] (cond
(cond (re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest]
(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])))
value [(list '= (list (keyword property) 'cell) (keyword value)) rest]))))
(defn- parse-not-condition (defn- parse-not-condition
"Parse the negation of a simple condition." "Parse the negation of a simple condition."
[[property IS NOT & rest]] [[property IS NOT & rest]]
(cond (and (member? IS '("is" "are")) (= NOT "not")) (cond (and (member? IS '("is" "are")) (= NOT "not"))
(let [partial (parse-simple-condition (cons property (cons "is" rest)))] (let [partial (parse-simple-condition (cons property (cons "is" rest)))]
(cond partial (cond partial
(let [[condition remainder] partial] (let [[condition remainder] partial]
[(list 'not condition) remainder]))))) [(list 'not condition) remainder])))))
(defn- gen-neighbours-condition (defn- gen-neighbours-condition
([comp1 quantity property value remainder comp2 distance] ([comp1 quantity property value remainder comp2 distance]
[(list comp1 [(list comp1
(list 'count (list 'count
(list 'get-neighbours-with-property-value 'world (list 'get-neighbours-with-property-value 'world
'(cell :x) '(cell :y) distance '(cell :x) '(cell :y) distance
(keyword property) (keyword-or-numeric value) comp2)) (keyword property) (keyword-or-numeric value) comp2))
quantity) quantity)
remainder]) remainder])
([comp1 quantity property value remainder comp2] ([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 (defn parse-comparator-neighbours-condition
"Parse conditions of the form '...more than 6 neighbours are [condition]'" "Parse conditions of the form '...more than 6 neighbours are [condition]'"
[[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]] [[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]]
(let [quantity (first (parse-numeric-value (list n))) (let [quantity (first (parse-numeric-value (list n)))
comparator (cond (= MORE "more") '> comparator (cond (= MORE "more") '>
(member? MORE '("fewer" "less")) '<)] (member? MORE '("fewer" "less")) '<)]
(cond (cond
(not= WITHIN "within") (not= WITHIN "within")
(parse-comparator-neighbours-condition (parse-comparator-neighbours-condition
(flatten (flatten
;; two tokens were mis-parsed as 'within distance' that weren't ;; two tokens were mis-parsed as 'within distance' that weren't
;; actually 'within' and a distance. Splice in 'within 1' and try ;; actually 'within' and a distance. Splice in 'within 1' and try
;; again. ;; 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 (and quantity
comparator comparator
(= THAN "than") (= THAN "than")
@ -247,15 +244,14 @@
(let [[property comp1 comp2 value & remainder] rest (let [[property comp1 comp2 value & remainder] rest
dist (gen-token-value distance true)] dist (gen-token-value distance true)]
(cond (and (= comp1 "equal") (= comp2 "to")) (cond (and (= comp1 "equal") (= comp2 "to"))
(gen-neighbours-condition comparator quantity property (gen-neighbours-condition comparator quantity property
value remainder = dist) value remainder = dist)
(and (= comp1 "more") (= comp2 "than")) (and (= comp1 "more") (= comp2 "than"))
(gen-neighbours-condition comparator quantity property (gen-neighbours-condition comparator quantity property
value remainder > dist) value remainder > dist)
(and (= comp1 "less") (= comp2 "than")) (and (= comp1 "less") (= comp2 "than"))
(gen-neighbours-condition comparator quantity property (gen-neighbours-condition comparator quantity property
value remainder < dist) value remainder < dist)))))))
))))))
(defn parse-some-neighbours-condition (defn parse-some-neighbours-condition
[[SOME NEIGHBOURS & rest]] [[SOME NEIGHBOURS & rest]]
@ -272,11 +268,11 @@
(cond (cond
(not= WITHIN "within") (not= WITHIN "within")
(parse-simple-neighbours-condition (parse-simple-neighbours-condition
(flatten (flatten
;; two tokens were mis-parsed as 'within distance' that weren't ;; two tokens were mis-parsed as 'within distance' that weren't
;; actually 'within' and a distance. Splice in 'within 1' and try ;; actually 'within' and a distance. Splice in 'within 1' and try
;; again. ;; 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") (= have-or-are "are")
(let [[value & remainder] rest (let [[value & remainder] rest
dist (gen-token-value distance true)] dist (gen-token-value distance true)]
@ -285,42 +281,40 @@
(let [[property comp1 comp2 value & remainder] rest (let [[property comp1 comp2 value & remainder] rest
dist (gen-token-value distance true)] dist (gen-token-value distance true)]
(cond (and (= comp1 "equal") (= comp2 "to")) (cond (and (= comp1 "equal") (= comp2 "to"))
(gen-neighbours-condition '= quantity property value remainder = (gen-neighbours-condition '= quantity property value remainder =
dist) dist)
(and (= comp1 "more") (= comp2 "than")) (and (= comp1 "more") (= comp2 "than"))
(gen-neighbours-condition '= quantity property value remainder > (gen-neighbours-condition '= quantity property value remainder >
dist) dist)
(and (= comp1 "less") (= comp2 "than")) (and (= comp1 "less") (= comp2 "than"))
(gen-neighbours-condition '= quantity property value remainder < (gen-neighbours-condition '= quantity property value remainder <
dist) dist)))))))
))))))
(defn parse-neighbours-condition (defn parse-neighbours-condition
"Parse conditions referring to neighbours" "Parse conditions referring to neighbours"
[tokens] [tokens]
(or (or
(parse-simple-neighbours-condition tokens) (parse-simple-neighbours-condition tokens)
(parse-comparator-neighbours-condition tokens) (parse-comparator-neighbours-condition tokens)
(parse-some-neighbours-condition tokens) (parse-some-neighbours-condition tokens)))
))
(defn parse-simple-condition (defn parse-simple-condition
"Parse conditions of the form '[property] [comparison] [value]'." "Parse conditions of the form '[property] [comparison] [value]'."
[tokens] [tokens]
(or (or
(parse-neighbours-condition tokens) (parse-neighbours-condition tokens)
(parse-member-condition tokens) (parse-member-condition tokens)
(parse-not-condition tokens) (parse-not-condition tokens)
(parse-less-condition tokens) (parse-less-condition tokens)
(parse-more-condition tokens) (parse-more-condition tokens)
(parse-between-condition tokens) (parse-between-condition tokens)
(parse-is-condition tokens))) (parse-is-condition tokens)))
(defn- parse-disjunction-condition (defn- parse-disjunction-condition
"Parse '... or [condition]' from `tokens`, where `left` is the already parsed first disjunct." "Parse '... or [condition]' from `tokens`, where `left` is the already parsed first disjunct."
[left tokens] [left tokens]
(let [partial (parse-conditions tokens)] (let [partial (parse-conditions tokens)]
(if partial (when partial
(let [[right remainder] partial] (let [[right remainder] partial]
[(list 'or left right) remainder])))) [(list 'or left right) remainder]))))
@ -328,7 +322,7 @@
"Parse '... and [condition]' from `tokens`, where `left` is the already parsed first conjunct." "Parse '... and [condition]' from `tokens`, where `left` is the already parsed first conjunct."
[left tokens] [left tokens]
(let [partial (parse-conditions tokens)] (let [partial (parse-conditions tokens)]
(if partial (when partial
(let [[right remainder] partial] (let [[right remainder] partial]
[(list 'and left right) remainder])))) [(list 'and left right) remainder]))))
@ -336,19 +330,19 @@
"Parse conditions from `tokens`, where conditions may be linked by either 'and' or 'or'." "Parse conditions from `tokens`, where conditions may be linked by either 'and' or 'or'."
[tokens] [tokens]
(let [partial (parse-simple-condition tokens)] (let [partial (parse-simple-condition tokens)]
(if partial (when partial
(let [[left [next & remainder]] partial] (let [[left [next & remainder]] partial]
(cond (cond
(= next "and") (parse-conjunction-condition left remainder) (= next "and") (parse-conjunction-condition left remainder)
(= next "or") (parse-disjunction-condition left remainder) (= next "or") (parse-disjunction-condition left remainder)
true partial))))) :else partial)))))
(defn- parse-left-hand-side (defn- parse-left-hand-side
"Parse the left hand side ('if...') of a production rule." "Parse the left hand side ('if...') of a production rule."
[[IF & tokens]] [[IF & tokens]]
(if (when
(= IF "if") (= IF "if")
(parse-conditions tokens))) (parse-conditions tokens)))
(defn- parse-arithmetic-action (defn- parse-arithmetic-action
"Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]', "Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]',
@ -357,16 +351,19 @@
(cond (cond
(member? prop1 '("x" "y")) (member? prop1 '("x" "y"))
(throw (throw
(Exception. reserved-properties-error)) (Exception. reserved-properties-error))
(and (= SHOULD "should") (and (= SHOULD "should")
(= BE "be") (= BE "be")
(member? operator '("+" "-" "*" "/"))) (member? operator '("+" "-" "*" "/")))
[(list 'merge (or previous 'cell) [(list 'merge (or previous 'cell)
{(keyword prop1) (list 'int {(keyword prop1) (list 'int
(list (symbol operator) (list 'get-int 'cell (keyword prop2)) (list (symbol operator)
(cond (list 'get-int 'cell (keyword prop2))
(re-matches re-number value) (read-string value) (if
true (list 'get-int 'cell (keyword value)))))}) rest])) (re-matches re-number value)
(read-string value)
(list 'get-int 'cell (keyword value)))))})
rest]))
(defn- parse-set-action (defn- parse-set-action
"Parse actions of the form '[property] should be [value].'" "Parse actions of the form '[property] should be [value].'"
@ -374,10 +371,13 @@
(cond (cond
(member? property '("x" "y")) (member? property '("x" "y"))
(throw (throw
(Exception. reserved-properties-error)) (Exception. reserved-properties-error))
(and (= SHOULD "should") (= BE "be")) (and (= SHOULD "should") (= BE "be"))
[(list 'merge (or previous 'cell) [(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] (defn- parse-simple-action [previous tokens]
(or (parse-arithmetic-action previous tokens) (or (parse-arithmetic-action previous tokens)
@ -390,29 +390,29 @@
(cond left (cond left
(cond (= (first remainder) "and") (cond (= (first remainder) "and")
(parse-actions left (rest remainder)) (parse-actions left (rest remainder))
true (list left))))) :else (list left)))))
(defn- parse-probability (defn- parse-probability
"Parse a probability of an action from this collection of tokens" "Parse a probability of an action from this collection of tokens"
[previous [n CHANCE IN m & tokens]] [previous [n CHANCE IN m & tokens]]
(cond (cond
(and (= CHANCE "chance")(= IN "in")) (and (= CHANCE "chance") (= IN "in"))
(let [[action remainder] (parse-actions previous tokens)] (let [[action remainder] (parse-actions previous tokens)]
(cond action (cond action
[(list 'cond [(list 'cond
(list '< (list '<
(list 'rand (list 'rand
(first (parse-simple-value (list m) true))) (first (parse-simple-value (list m) true)))
(first (parse-simple-value (list n) true))) (first (parse-simple-value (list n) true)))
action) remainder])))) action) remainder]))))
(defn- parse-right-hand-side (defn- parse-right-hand-side
"Parse the right hand side ('then...') of a production rule." "Parse the right hand side ('then...') of a production rule."
[[THEN & tokens]] [[THEN & tokens]]
(if (= THEN "then") (when (= THEN "then")
(or (or
(parse-probability nil tokens) (parse-probability nil tokens)
(parse-actions nil tokens)))) (parse-actions nil tokens))))
(defn parse-rule (defn parse-rule
"Parse a complete rule from this `line`, expected to be either a string or a "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." Throws an exception if parsing fails."
[line] [line]
(cond (if
(string? line) (string? line) (let [rule (parse-rule (split (triml line) #"\s+"))]
(let [rule (parse-rule (split (triml line) #"\s+"))] (if rule rule
(cond rule rule (throw (Exception. (format bad-parse-error line)))))
true (throw (Exception. (format bad-parse-error line)))))
true
(let [[left remainder] (parse-left-hand-side line) (let [[left remainder] (parse-left-hand-side line)
[right junk] (parse-right-hand-side remainder)] [right junk] (parse-right-hand-side remainder)]
(cond (when
;; there should be a valide left hand side and a valid right hand side ;; 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) ;; 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)))))) (list 'fn ['cell 'world] (list 'if left right))))))
(defn compile-rule (defn compile-rule
@ -444,11 +442,10 @@
Throws an exception if parsing fails." Throws an exception if parsing fails."
([rule-text return-tuple?] ([rule-text return-tuple?]
(do (let [afn (eval (parse-rule rule-text))]
(use 'mw-engine.utils) (if
(let [afn (eval (parse-rule rule-text))] (and afn return-tuple?)
(cond (list afn (trim rule-text))
(and afn return-tuple?)(list afn (trim rule-text)) afn)))
true afn))))
([rule-text] ([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." (ns ^{:doc "A very simple parser which parses production rules."
:author "Simon Brooke"} :author "Simon Brooke"}
mw-parser.declarative mw-parser.declarative
(:require [instaparse.core :refer [parser]] (:require [clojure.string :refer [join split trim]]
[clojure.string :refer [join trim]] [instaparse.core :refer [parser]]
[mw-parser.errors :refer [throw-parse-exception]] [mw-parser.errors :refer [throw-parse-exception]]
[mw-parser.flow :refer [flow-grammar]]
[mw-parser.generate :refer [generate]] [mw-parser.generate :refer [generate]]
[mw-parser.simplify :refer [simplify]] [mw-parser.simplify :refer [simplify]]
[mw-parser.utils :refer [rule?]] [mw-parser.utils :refer [rule?]]
@ -71,8 +72,7 @@
"SPACE := #'\\s+';" "SPACE := #'\\s+';"
"VALUE := SYMBOL | NUMBER;" "VALUE := SYMBOL | NUMBER;"
"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 (def keywords-en
"English language keyword literals used in rules - both in production "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 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 internationalise; this isn't a full solution but it's a step towards
a solution." a solution."
(join "\n" ["ALL := 'all'" (join "\n" ["ALL := 'all'"
"AND := 'and';" "AND := 'and';"
"BECOMES := 'should be' | 'becomes';" "BECOMES := 'should be' | 'becomes';"
"BETWEEN := 'between';" "BETWEEN := 'between';"
"CHANCE-IN := 'chance in';" "CHANCE-IN := 'chance in';"
"EACH := 'each' | 'every' | 'all';" "EACH := 'each' | 'every' | 'all';"
"EQUAL := 'equal to';" "EQUAL := 'equal to';"
"FIRST := 'first';" "FIRST := 'first';"
"FLOW := 'flow' | 'move';" "FLOW := 'flow' | 'move';"
"FROM := 'from';" "FROM := 'from';"
"IF := 'if';" "IF := 'if';"
"IN := 'in';" "IN := 'in';"
"IS := 'is' | 'are' | 'have' | 'has';" "IS := 'is' | 'are' | 'have' | 'has';"
"LEAST := 'least';" "LEAST := 'least';"
"LESS := 'less' | 'fewer';" "LESS := 'less' | 'fewer';"
"MORE := 'more' | 'greater';" "MORE := 'more' | 'greater';"
"MOST := 'most';" "MOST := 'most';"
"NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';" "NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';"
"NONE := 'no';" "NONE := 'no';"
"NOT := 'not';" "NOT := 'not';"
"OR := 'or';" "OR := 'or';"
"SOME := 'some';" "SOME := 'some';"
;; SYMBOL is in the per-language file so that languages that use ;; SYMBOL is in the per-language file so that languages that use
;; (e.g.) Cyrillic characters can change the definition. ;; (e.g.) Cyrillic characters can change the definition.
"SYMBOL := #'[a-z]+';" "SYMBOL := #'[a-z]+';"
"THAN := 'than';" "THAN := 'than';"
"THEN := 'then';" "THEN := 'then';"
"TO := 'to';" "TO := 'to';"
"WITH := 'with' | 'where' | 'having';" "WITH := 'with' | 'where' | 'having';"
"WITHIN := 'within';"])) "WITHIN := 'within';"]))
@ -122,7 +122,7 @@
([^Locale _locale] ([^Locale _locale]
keywords-en)) keywords-en))
(defmacro build-parser (defmacro build-parser
"Compose this grammar fragment `g` with the common grammar fragments to "Compose this grammar fragment `g` with the common grammar fragments to
make a complete grammar, and return a parser for that complete grammar." make a complete grammar, and return a parser for that complete grammar."
[g] [g]
@ -132,6 +132,22 @@
"Parse the argument, assumed to be a string in the correct syntax, and return a parse tree." "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree."
(build-parser rule-grammar)) (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 (defn compile-rule
"Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules, "Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules,
into Clojure source, and then compile it into an anonymous 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." (ns ^{:doc "A very simple parser which parses flow rules."
:author "Simon Brooke"} :author "Simon Brooke"}
mw-parser.flow mw-parser.flow
(:require [clojure.string :refer [join]] (:require [clojure.string :refer [join]]))
[mw-parser.declarative :refer [build-parser]]
[mw-parser.simplify :refer [simplify-second-of-two]]))
(def flow-grammar (def flow-grammar
"Grammar for flow rules. "Grammar for flow rules.
@ -21,7 +19,7 @@
The basic rule I want to be able to compile at this stage is the 'mutual The basic rule I want to be able to compile at this stage is the 'mutual
aid' rule: 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;" (join "\n" ["FLOW-RULE := FLOW SPACE QUANTITY SPACE PROPERTY SPACE FROM SPACE SOURCE SPACE TO-HOW SPACE DESTINATION;"
"PERCENTAGE := NUMBER #'%';" "PERCENTAGE := NUMBER #'%';"
@ -35,33 +33,3 @@
"TO-HOW := TO | TO-EACH | TO-FIRST;" "TO-HOW := TO | TO-EACH | TO-FIRST;"
"TO-EACH := TO SPACE EACH | TO SPACE ALL;" "TO-EACH := TO SPACE EACH | TO SPACE ALL;"
"TO-FIRST := TO SPACE FIRST"])) "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]) ;;; (fn [cell world])
;;; (if (= (:state cell) (or (:house cell) :house)) ;;; (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 (defn generate-flow
[tree] [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 ;;; Top level; only function anything outside this file (except tests) should
;;; really call. ;;; really call.

6
test/mw_parser/bulk_test.clj
View file

@ -1,7 +1,7 @@
(ns mw-parser.bulk-test (ns mw-parser.bulk-test
(:use clojure.java.io) (:require [clojure.java.io :refer [as-file]]
(:require [clojure.test :refer :all] [clojure.test :refer [deftest is testing]]
[mw-parser.bulk :refer :all])) [mw-parser.bulk :refer [compile-file parse-file]]))
(deftest bulk-parsing-test (deftest bulk-parsing-test
(testing "Bulk (file) parsing and compilation" (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]] (:require [clojure.test :refer [deftest is testing]]
[mw-engine.core :refer [transform-world]] [mw-engine.core :refer [transform-world]]
[mw-engine.world :refer [make-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-rule parse-simple-value
parse-value]])) parse-value]]))
(deftest primitives-tests (deftest primitives-tests
(testing "Simple functions supporting the parser" (testing "Simple functions supporting the parser"
(is (= (parse-simple-value '()) nil) (is (= (parse-simple-value '()) nil)
"if there's nothing to parse, return nil") "if there's nothing to parse, return nil")
(is (= (first (parse-simple-value '("1234" "and" "that"))) 1234) (is (= (first (parse-simple-value '("1234" "and" "that"))) 1234)
"a simple value is expected to be just a number.") "a simple value is expected to be just a number.")
(is (= (first (parse-simple-value '("this" "and" "that"))) :this) (is (= (first (parse-simple-value '("this" "and" "that"))) :this)
"or else just a keyword") "or else just a keyword")
(is (= (first (parse-simple-value '("this" "and" "that") true)) (is (= (first (parse-simple-value '("this" "and" "that") true))
'(get-int cell :this)) '(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") "...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) (is (= (parse-value '()) nil)
"if there's nothing to parse, return nil") "if there's nothing to parse, return nil")
(is (= (first (parse-value '("1234" "and" "that"))) 1234) (is (= (first (parse-value '("1234" "and" "that"))) 1234)
"a simple value is expected to be just a number.") "a simple value is expected to be just a number.")
(is (= (first (parse-value '("this" "and" "that"))) :this) (is (= (first (parse-value '("this" "and" "that"))) :this)
"or else just a keyword") "or else just a keyword")
(is (= (first (parse-value '("this" "and" "that") true)) (is (= (first (parse-value '("this" "and" "that") true))
'(get-int cell :this)) '(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") "...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) (is (= (parse-property-value '()) nil)
"if there's nothing to parse, return nil") "if there's nothing to parse, return nil")
(is (= (first (parse-property-value '("this" "and" "that"))) '(:this cell)) (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") "Parsing a property value returns a code function to pull its value off the current cell")))
))
(deftest rules-tests (deftest rules-tests
(testing "Rule parser - does not test whether generated functions actually work, just that something is generated!" (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 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 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 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 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 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 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 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 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 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 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 state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub"))))
))
(deftest exception-tests (deftest exception-tests
(testing "Constructions which should cause exceptions to be thrown" (testing "Constructions which should cause exceptions to be thrown"
(is (thrown-with-msg? Exception #"^I did not understand.*" (is (thrown-with-msg? Exception #"^I did not understand.*"
(parse-rule "the quick brown fox jumped over the lazy dog")) (parse-rule "the quick brown fox jumped over the lazy dog"))
"Exception thrown if rule text does not match grammar") "Exception thrown if rule text does not match grammar")
(is (thrown-with-msg? (is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" 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")) (parse-rule "if state is new then x should be 0"))
"Exception thrown on attempt to set 'x'") "Exception thrown on attempt to set 'x'")
(is (thrown-with-msg? (is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" 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")) (parse-rule "if state is new then y should be 0"))
"Exception thrown on attempt to set 'y'") "Exception thrown on attempt to set 'y'")
(is (thrown? Exception (compile-rule "if state is new then x should be 0")) (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") "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")) (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") "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")) (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") "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")) (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") "Can't set y property to symbol, as this would break the world")))
))
(deftest correctness-tests (deftest correctness-tests
(testing "Simplest possible rule" (testing "Simplest possible rule"
(let [afn (compile-rule "if state is new then state should be grassland")] (let [afn (compile-rule "if state is new then state should be grassland")]
(is (= (apply afn (list {:state :new} nil)) (is (= (apply afn (list {:state :new} nil))
{:state :grassland}) {:state :grassland})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (nil? (apply afn (list {:state :forest} nil)))) (is (nil? (apply afn (list {:state :forest} nil))))
"Rule doesn't fire when condition isn't met")) "Rule doesn't fire when condition isn't met"))
(testing "Condition conjunction rule" (testing "Condition conjunction rule"
(let [afn (compile-rule "if state is new and altitude is 0 then state should be water")] (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)) (is (= (apply afn (list {:state :new :altitude 0} nil))
{:state :water :altitude 0}) {:state :water :altitude 0})
"Rule fires when conditions are met") "Rule fires when conditions are met")
(is (nil? (apply afn (list {:state :new :altitude 5} nil))) (is (nil? (apply afn (list {:state :new :altitude 5} nil)))
"Rule does not fire: second condition not met") "Rule does not fire: second condition not met")
(is (nil? (apply afn (list {:state :forest :altitude 0} nil))) (is (nil? (apply afn (list {:state :forest :altitude 0} nil)))
"Rule does not fire: first condition not met"))) "Rule does not fire: first condition not met")))
(testing "Condition disjunction rule" (testing "Condition disjunction rule"
(let [afn (compile-rule "if state is new or state is waste then state should be grassland")] (let [afn (compile-rule "if state is new or state is waste then state should be grassland")]
(is (= (apply afn (list {:state :new} nil)) (is (= (apply afn (list {:state :new} nil))
{:state :grassland}) {:state :grassland})
"Rule fires: first condition met") "Rule fires: first condition met")
(is (= (apply afn (list {:state :waste} nil)) (is (= (apply afn (list {:state :waste} nil))
{:state :grassland}) {:state :grassland})
"Rule fires: second condition met") "Rule fires: second condition met")
(is (nil? (apply afn (list {:state :forest} nil))) (is (nil? (apply afn (list {:state :forest} nil)))
"Rule does not fire: neither condition met"))) "Rule does not fire: neither condition met")))
(testing "Simple negation rule" (testing "Simple negation rule"
(let [afn (compile-rule "if state is not new then state should be grassland")] (let [afn (compile-rule "if state is not new then state should be grassland")]
(is (nil? (apply afn (list {:state :new} nil))) (is (nil? (apply afn (list {:state :new} nil)))
"Rule doesn't fire when condition isn't met") "Rule doesn't fire when condition isn't met")
(is (= (apply afn (list {:state :forest} nil)) (is (= (apply afn (list {:state :forest} nil))
{:state :grassland}) {:state :grassland})
"Rule fires when condition is met"))) "Rule fires when condition is met")))
(testing "Can't set x or y properties") (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" (testing "Simple list membership rule"
(let [afn (compile-rule "if state is in heath or scrub or forest then state should be climax")] (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)) (is (= (apply afn (list {:state :heath} nil))
{:state :climax}) {:state :climax})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (= (apply afn (list {:state :scrub} nil)) (is (= (apply afn (list {:state :scrub} nil))
{:state :climax}) {:state :climax})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (= (apply afn (list {:state :forest} nil)) (is (= (apply afn (list {:state :forest} nil))
{:state :climax}) {:state :climax})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (nil? (apply afn (list {:state :grassland} nil))) (is (nil? (apply afn (list {:state :grassland} nil)))
"Rule does not fire when condition is not met"))) "Rule does not fire when condition is not met")))
(testing "Negated list membership rule" (testing "Negated list membership rule"
(let [afn (compile-rule "if state is not in heath or scrub or forest then state should be climax")] (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))) (is (nil? (apply afn (list {:state :heath} nil)))
"Rule does not fire when condition is not met") "Rule does not fire when condition is not met")
(is (nil? (apply afn (list {:state :scrub} nil))) (is (nil? (apply afn (list {:state :scrub} nil)))
"Rule does not fire when condition is not met") "Rule does not fire when condition is not met")
(is (nil? (apply afn (list {:state :forest} nil))) (is (nil? (apply afn (list {:state :forest} nil)))
"Rule does not fire when condition is not met") "Rule does not fire when condition is not met")
(is (= (apply afn (list {:state :grassland} nil)) (is (= (apply afn (list {:state :grassland} nil))
{:state :climax}) {:state :climax})
"Rule fires when condition is met"))) "Rule fires when condition is met")))
(testing "Property is more than numeric-value" (testing "Property is more than numeric-value"
(let [afn (compile-rule "if altitude is more than 200 then state should be snow")] (let [afn (compile-rule "if altitude is more than 200 then state should be snow")]
(is (= (apply afn (list {:altitude 201} nil)) (is (= (apply afn (list {:altitude 201} nil))
{:state :snow :altitude 201}) {:state :snow :altitude 201})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (nil? (apply afn (list {:altitude 200} nil))) (is (nil? (apply afn (list {:altitude 200} nil)))
"Rule does not fire when condition is not met"))) "Rule does not fire when condition is not met")))
(testing "Property is more than property" (testing "Property is more than property"
(let [afn (compile-rule "if wolves are more than deer then deer should be 0")] (let [afn (compile-rule "if wolves are more than deer then deer should be 0")]
(is (= (apply afn (list {:deer 2 :wolves 3} nil)) (is (= (apply afn (list {:deer 2 :wolves 3} nil))
{:deer 0 :wolves 3}) {:deer 0 :wolves 3})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (nil? (apply afn (list {:deer 3 :wolves 2} nil))) (is (nil? (apply afn (list {:deer 3 :wolves 2} nil)))
"Rule does not fire when condition is not met"))) "Rule does not fire when condition is not met")))
(testing "Property is less than numeric-value" (testing "Property is less than numeric-value"
(let [afn (compile-rule "if altitude is less than 10 then state should be water")] (let [afn (compile-rule "if altitude is less than 10 then state should be water")]
(is (= (apply afn (list {:altitude 9} nil)) (is (= (apply afn (list {:altitude 9} nil))
{:state :water :altitude 9}) {:state :water :altitude 9})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (nil? (apply afn (list {:altitude 10} nil))) (is (nil? (apply afn (list {:altitude 10} nil)))
"Rule does not fire when condition is not met"))) "Rule does not fire when condition is not met")))
(testing "Property is less than property" (testing "Property is less than property"
(let [afn (compile-rule "if wolves are less than deer then deer should be deer - wolves")] (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)) (is (= (apply afn (list {:deer 3 :wolves 2} nil))
{:deer 1 :wolves 2}) {:deer 1 :wolves 2})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (nil? (apply afn (list {:deer 2 :wolves 3} nil))) (is (nil? (apply afn (list {:deer 2 :wolves 3} nil)))
"Rule does not fire when condition is not met"))) "Rule does not fire when condition is not met")))
(testing "Number neighbours have property equal to value" (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") (let [afn (compile-rule "if 3 neighbours have state equal to new then state should be water")
world (make-world 3 3)] world (make-world 3 3)]
(is (= (apply afn (list {:x 0 :y 0} world)) (is (= (apply afn (list {:x 0 :y 0} world))
{:state :water :x 0 :y 0}) {: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)") "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))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell has eight neighbours, so rule does not fire.")) "Middle cell has eight neighbours, so rule does not fire."))
(let [afn (compile-rule "if 3 neighbours are new then state should be water") (let [afn (compile-rule "if 3 neighbours are new then state should be water")
world (make-world 3 3)] world (make-world 3 3)]
;; 'are new' should be the same as 'have state equal to new' ;; 'are new' should be the same as 'have state equal to new'
(is (= (apply afn (list {:x 0 :y 0} world)) (is (= (apply afn (list {:x 0 :y 0} world))
{:state :water :x 0 :y 0}) {: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)") "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))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell has eight neighbours, so rule does not fire."))) "Middle cell has eight neighbours, so rule does not fire.")))
(testing "Number neighbours have property more than numeric-value" (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") (let [afn (compile-rule "if 3 neighbours have altitude more than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (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 "Number neighbours have property less than numeric-value" (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") (let [afn (compile-rule "if 5 neighbours have altitude less than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has two high neighbours, so rule should not fire."))) "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" (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") (let [afn (compile-rule "if more than 2 neighbours have altitude equal to 11 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (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 "More than number neighbours have property equal to symbolic-value" (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") (let [afn (compile-rule "if more than 2 neighbours have state equal to grassland then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (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."))
(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 are grassland then state should be beach")
;; 'are grassland' should mean the same as 'have state equal to grassland'. ;; 'are grassland' should mean the same as 'have state equal to grassland'.
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (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" (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") (let [afn (compile-rule "if fewer than 3 neighbours have altitude equal to 11 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) (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)") "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))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell of world has three high neighbours, so rule should not fire."))) "Middle cell of world has three high neighbours, so rule should not fire.")))
(testing "Fewer than number neighbours have property equal to symbolic-value" (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") (let [afn (compile-rule "if fewer than 3 neighbours have state equal to grassland then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (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)") "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))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell of world has three high neighbours, so rule should not fire."))) "Middle cell of world has three high neighbours, so rule should not fire.")))
;; some neighbours have property equal to value ;; some neighbours have property equal to value
(testing "Some neighbours have property equal to numeric-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") (let [afn (compile-rule "if some neighbours have altitude equal to 11 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire."))) "Left hand side of world has no high neighbours, so rule should not fire.")))
(testing "Some neighbours have property equal to symbolic-value" (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") (let [afn (compile-rule "if some neighbours have state equal to grassland then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire."))) "Left hand side of world has no high neighbours, so rule should not fire.")))
;; more than number neighbours have property more than numeric-value ;; more than number neighbours have property more than numeric-value
(testing "More than number neighbours have property more than symbolic-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") (let [afn (compile-rule "if more than 2 neighbours have altitude more than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (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.")))
;; fewer than number neighbours have property more than numeric-value ;; fewer than number neighbours have property more than numeric-value
(testing "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") (let [afn (compile-rule "if fewer than 3 neighbours have altitude more than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) (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)") "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))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell of world has three high neighbours, so rule should not fire."))) "Middle cell of world has three high neighbours, so rule should not fire.")))
;; some neighbours have property more than numeric-value ;; some neighbours have property more than numeric-value
(testing "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") (let [afn (compile-rule "if some neighbours have altitude more than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire."))) "Left hand side of world has no high neighbours, so rule should not fire.")))
;; more than number neighbours have property less than numeric-value ;; more than number neighbours have property less than numeric-value
(testing "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") (let [afn (compile-rule "if more than 4 neighbours have altitude less than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (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."))) "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 ;; fewer than number neighbours have property less than numeric-value
(testing "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") (let [afn (compile-rule "if fewer than 4 neighbours have altitude less than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (nil? (apply afn (list {:x 1 :y 1} world))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Centre cell has five low neighbours, so rule should not fire") "Centre cell has five low neighbours, so rule should not fire")
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) (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."))) "Middle cell of the strip has only three low neighbours, so rule should fire.")))
;; some neighbours have property less than numeric-value ;; some neighbours have property less than numeric-value
(testing "Some number 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") (let [afn (compile-rule "if some neighbours have altitude less than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is less than 2 then altitude should be 11") (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")))] (compile-rule "if x is 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 0 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left of world is all high, so rule should not fire."))) "Left of world is all high, so rule should not fire.")))
;; 'single action' already tested in 'condition' tests above ;; 'single action' already tested in 'condition' tests above
;; action and actions ;; action and actions
(testing "Conjunction of actions" (testing "Conjunction of actions"
(let [afn (compile-rule "if state is new then state should be grassland and fertility should be 0")] (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)) (is (= (apply afn (list {:state :new} nil))
{:state :grassland :fertility 0}) {:state :grassland :fertility 0})
"Both actions are executed"))) "Both actions are executed")))
;; 'property should be symbolic-value' and 'property should be numeric-value' ;; 'property should be symbolic-value' and 'property should be numeric-value'
;; already tested in tests above ;; already tested in tests above
;; number chance in number property should be value ;; number chance in number property should be value
(testing "Syntax of probability rule - action of real probability very hard to test" (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")] (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) (is (= (:state (apply afn (list {:state :forest} nil))) :climax)
"five chance in five should fire every time")) "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")] (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))) (is (nil? (apply afn (list {:state :forest} nil)))
"zero chance in five should never fire"))) "zero chance in five should never fire")))
;; property operator numeric-value ;; property operator numeric-value
(testing "Arithmetic action: addition of number" (testing "Arithmetic action: addition of number"
(let [afn (compile-rule "if state is climax then fertility should be fertility + 1")] (let [afn (compile-rule "if state is climax then fertility should be fertility + 1")]
(is (= (:fertility (is (= (:fertility
(apply afn (list {:state :climax :fertility 0} nil))) (apply afn (list {:state :climax :fertility 0} nil)))
1) 1)
"Addition is executed"))) "Addition is executed")))
(testing "Arithmetic action: addition of property value" (testing "Arithmetic action: addition of property value"
(let [afn (compile-rule "if state is climax then fertility should be fertility + leaf-fall")] (let [afn (compile-rule "if state is climax then fertility should be fertility + leaf-fall")]
(is (= (:fertility (is (= (:fertility
(apply afn (apply afn
(list {:state :climax (list {:state :climax
:fertility 0 :fertility 0
:leaf-fall 1} nil))) :leaf-fall 1} nil)))
1) 1)
"Addition is executed"))) "Addition is executed")))
(testing "Arithmetic action: subtraction of number" (testing "Arithmetic action: subtraction of number"
(let [afn (compile-rule "if state is crop then fertility should be fertility - 1")] (let [afn (compile-rule "if state is crop then fertility should be fertility - 1")]
(is (= (:fertility (is (= (:fertility
(apply afn (list {:state :crop :fertility 2} nil))) (apply afn (list {:state :crop :fertility 2} nil)))
1) 1)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: subtraction of property value" (testing "Arithmetic action: subtraction of property value"
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer - wolves")] (let [afn (compile-rule "if wolves are more than 0 then deer should be deer - wolves")]
(is (= (:deer (is (= (:deer
(apply afn (apply afn
(list {:deer 3 (list {:deer 3
:wolves 2} nil))) :wolves 2} nil)))
1) 1)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: multiplication by number" (testing "Arithmetic action: multiplication by number"
(let [afn (compile-rule "if deer are more than 1 then deer should be deer * 2")] (let [afn (compile-rule "if deer are more than 1 then deer should be deer * 2")]
(is (= (:deer (is (= (:deer
(apply afn (list {:deer 2} nil))) (apply afn (list {:deer 2} nil)))
4) 4)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: multiplication by property value" (testing "Arithmetic action: multiplication by property value"
(let [afn (compile-rule "if state is crop then deer should be deer * deer")] (let [afn (compile-rule "if state is crop then deer should be deer * deer")]
(is (= (:deer (is (= (:deer
(apply afn (apply afn
(list {:state :crop :deer 2} nil))) (list {:state :crop :deer 2} nil)))
4) 4)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: division by number" (testing "Arithmetic action: division by number"
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer / 2")] (let [afn (compile-rule "if wolves are more than 0 then deer should be deer / 2")]
(is (= (:deer (is (= (:deer
(apply afn (list {:deer 2 :wolves 1} nil))) (apply afn (list {:deer 2 :wolves 1} nil)))
1) 1)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: division by property value" (testing "Arithmetic action: division by property value"
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer / wolves")] (let [afn (compile-rule "if wolves are more than 0 then deer should be deer / wolves")]
(is (= (:deer (is (= (:deer
(apply afn (apply afn
(list {:deer 2 :wolves 2} nil))) (list {:deer 2 :wolves 2} nil)))
1) 1)
"Action is executed"))) "Action is executed")))
;; simple within distance ;; simple within distance
(testing "Number neighbours within distance have property equal to value" (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") (let [afn (compile-rule "if 8 neighbours within 2 have state equal to new then state should be water")
world (make-world 5 5)] world (make-world 5 5)]
(is (= (apply afn (list {:x 0 :y 0} world)) (is (= (apply afn (list {:x 0 :y 0} world))
{:state :water :x 0 :y 0}) {: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)") "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))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell has twenty-four neighbours within two, so rule does not fire."))) "Middle cell has twenty-four neighbours within two, so rule does not fire.")))
;; comparator within distance ;; comparator within distance
(testing "More than number neighbours within distance have property equal to symbolic-value" (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 ;; 5x5 world, strip of high ground two cells wide down left hand side
;; xxooo ;; xxooo
;; xxooo ;; xxooo
;; xxooo ;; xxooo
;; xxooo ;; xxooo
;; xxooo ;; xxooo
world (transform-world world (transform-world
(make-world 5 5) (make-world 5 5)
(list (compile-rule "if x is less than 2 then altitude should be 11 and state should be grassland") (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")))] (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) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (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."))))

179
test/mw_parser/declarative_test.clj
View file

@ -1,10 +1,10 @@
(ns mw-parser.declarative-test (ns mw-parser.declarative-test
(:require [clojure.test :refer [deftest is testing]] (:require [clojure.test :refer [deftest is testing]]
[mw-engine.core :refer [transform-world]] [mw-engine.core :refer [transform-world]]
[mw-engine.utils :refer [get-cell]] [mw-engine.utils :refer [get-cell]]
[mw-engine.world :refer [make-world]] [mw-engine.world :refer [make-world]]
[mw-parser.declarative :refer [compile-rule parse-rule]] [mw-parser.declarative :refer [compile-rule parse-rule]]
[mw-parser.utils :refer [rule?]])) [mw-parser.utils :refer [rule?]]))
(deftest rules-tests (deftest rules-tests
(testing "Rule parser - does not test whether generated functions actually work, just that something is generated!" (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 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 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 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 (deftest exception-tests
@ -40,15 +39,14 @@
(is (thrown-with-msg? Exception #"^I did not understand.*" (is (thrown-with-msg? Exception #"^I did not understand.*"
(compile-rule "if i have a cat on my lap then everything is fine")) (compile-rule "if i have a cat on my lap then everything is fine"))
"Exception thrown if rule text does not match grammar") "Exception thrown if rule text does not match grammar")
(is (thrown-with-msg? (is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" 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")) (compile-rule "if state is new then x should be 0"))
"Exception thrown on attempt to set 'x'") "Exception thrown on attempt to set 'x'")
(is (thrown-with-msg? (is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" 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")) (compile-rule "if state is new then y should be 0"))
"Exception thrown on attempt to set 'y'") "Exception thrown on attempt to set 'y'")))
))
(deftest correctness-tests (deftest correctness-tests
@ -93,12 +91,12 @@
(testing "Can't set x or y properties" (testing "Can't set x or y properties"
(is (thrown-with-msg? (is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" 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")) (compile-rule "if state is new then x should be 0"))
"Exception thrown on attempt to set 'x'") "Exception thrown on attempt to set 'x'")
(is (thrown-with-msg? (is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" 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")) (compile-rule "if state is new then y should be 0"))
"Exception thrown on attempt to set 'y'")) "Exception thrown on attempt to set 'y'"))
(testing "Simple list membership rule" (testing "Simple list membership rule"
@ -188,9 +186,9 @@
;; if 3 neighbours have altitude more than 10 then state should be beach ;; 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") (let [afn (compile-rule "if 3 neighbours have altitude more than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (is (nil? (apply afn (list {:x 2 :y 1} world)))
@ -199,9 +197,9 @@
(testing "Number neighbours have property less than numeric-value" (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") (let [afn (compile-rule "if 5 neighbours have altitude less than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (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" (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") (let [afn (compile-rule "if more than 2 neighbours have altitude equal to 11 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (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" (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") (let [afn (compile-rule "if more than 2 neighbours have state equal to grassland then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (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") (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'. ;; 'are grassland' should mean the same as 'have state equal to grassland'.
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (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" (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") (let [afn (compile-rule "if fewer than 3 neighbours have altitude equal to 11 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) (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)") "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))) (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" (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") (let [afn (compile-rule "if fewer than 3 neighbours have state equal to grassland then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (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)") "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))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
@ -266,9 +263,9 @@
(testing "Some neighbours have property equal to numeric-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") (let [afn (compile-rule "if some neighbours have altitude equal to 11 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (is (nil? (apply afn (list {:x 0 :y 1} world)))
@ -277,9 +274,9 @@
(testing "Some neighbours have property equal to symbolic-value" (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") (let [afn (compile-rule "if some neighbours have state equal to grassland then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (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" (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") (let [afn (compile-rule "if more than 2 neighbours have altitude more than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (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" (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") (let [afn (compile-rule "if fewer than 3 neighbours have altitude more than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) (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)") "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))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
@ -313,9 +310,9 @@
(testing "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") (let [afn (compile-rule "if some neighbours have altitude more than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (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" (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") (let [afn (compile-rule "if more than 4 neighbours have altitude less than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (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" (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") (let [afn (compile-rule "if fewer than 4 neighbours have altitude less than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (nil? (apply afn (list {:x 1 :y 1} world))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Centre cell has five low neighbours, so rule should not fire") "Centre cell has five low neighbours, so rule should not fire")
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) (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" (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") (let [afn (compile-rule "if some neighbours have altitude less than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is less than 2 then altitude should be 11") (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")))] (compile-rule "if x is 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (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)") "Rule fires when condition is met (strip of altitude 0 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (is (nil? (apply afn (list {:x 0 :y 1} world)))
@ -382,63 +379,63 @@
(testing "Arithmetic action: addition of number" (testing "Arithmetic action: addition of number"
(let [afn (compile-rule "if state is climax then fertility should be fertility + 1")] (let [afn (compile-rule "if state is climax then fertility should be fertility + 1")]
(is (= (:fertility (is (= (:fertility
(apply afn (list {:state :climax :fertility 0} nil))) (apply afn (list {:state :climax :fertility 0} nil)))
1) 1)
"Addition is executed"))) "Addition is executed")))
(testing "Arithmetic action: addition of property value" (testing "Arithmetic action: addition of property value"
(let [afn (compile-rule "if state is climax then fertility should be fertility + leaffall")] (let [afn (compile-rule "if state is climax then fertility should be fertility + leaffall")]
(is (= (:fertility (is (= (:fertility
(apply afn (apply afn
(list {:state :climax (list {:state :climax
:fertility 0 :fertility 0
:leaffall 1} nil))) :leaffall 1} nil)))
1) 1)
"Addition is executed"))) "Addition is executed")))
(testing "Arithmetic action: subtraction of number" (testing "Arithmetic action: subtraction of number"
(let [afn (compile-rule "if state is crop then fertility should be fertility - 1")] (let [afn (compile-rule "if state is crop then fertility should be fertility - 1")]
(is (= (:fertility (is (= (:fertility
(apply afn (list {:state :crop :fertility 2} nil))) (apply afn (list {:state :crop :fertility 2} nil)))
1) 1)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: subtraction of property value" (testing "Arithmetic action: subtraction of property value"
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer - wolves")] (let [afn (compile-rule "if wolves are more than 0 then deer should be deer - wolves")]
(is (= (:deer (is (= (:deer
(apply afn (apply afn
(list {:deer 3 (list {:deer 3
:wolves 2} nil))) :wolves 2} nil)))
1) 1)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: multiplication by number" (testing "Arithmetic action: multiplication by number"
(let [afn (compile-rule "if deer are more than 1 then deer should be deer * 2")] (let [afn (compile-rule "if deer are more than 1 then deer should be deer * 2")]
(is (= (:deer (is (= (:deer
(apply afn (list {:deer 2} nil))) (apply afn (list {:deer 2} nil)))
4) 4)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: multiplication by property value" (testing "Arithmetic action: multiplication by property value"
(let [afn (compile-rule "if state is crop then deer should be deer * deer")] (let [afn (compile-rule "if state is crop then deer should be deer * deer")]
(is (= (:deer (is (= (:deer
(apply afn (apply afn
(list {:state :crop :deer 2} nil))) (list {:state :crop :deer 2} nil)))
4) 4)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: division by number" (testing "Arithmetic action: division by number"
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer / 2")] (let [afn (compile-rule "if wolves are more than 0 then deer should be deer / 2")]
(is (= (:deer (is (= (:deer
(apply afn (list {:deer 2 :wolves 1} nil))) (apply afn (list {:deer 2 :wolves 1} nil)))
1) 1)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: division by property value" (testing "Arithmetic action: division by property value"
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer / wolves")] (let [afn (compile-rule "if wolves are more than 0 then deer should be deer / wolves")]
(is (= (:deer (is (= (:deer
(apply afn (apply afn
(list {:deer 2 :wolves 2} nil))) (list {:deer 2 :wolves 2} nil)))
1) 1)
"Action is executed"))) "Action is executed")))
@ -462,24 +459,22 @@
;; xxooo ;; xxooo
;; xxooo ;; xxooo
world (transform-world world (transform-world
(make-world 5 5) (make-world 5 5)
(list (compile-rule "if x is less than 2 then altitude should be 11 and state should be grassland") (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")))] (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) (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)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (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 (deftest regression-tests
(testing "Rule in default set which failed on switchover to declarative rules" (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") (let [afn (compile-rule "if state is scrub then 1 chance in 1 state should be forest")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (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) (is (= (:state (apply afn (list (get-cell world 1 1) world))) :forest)
"Centre cell is scrub, so rule should fire") "Centre cell is scrub, so rule should fire")
(is (= (apply afn (list (get-cell world 2 1) world)) nil) (is (= (apply afn (list (get-cell world 2 1) world)) nil)
"Middle cell of the strip is not scrub, so rule should not fire.")))) "Middle cell of the strip is not scrub, so rule should not fire."))))