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

Major overhaul of rule metadata, so upversioned to 0.3.0

Browse source 
Many tests do not pass at this time.
This commit is contained in:
Simon Brooke 2023-07-19 20:30:58 +01:00
parent 8c2e44b42a
commit b4f796aca4
15 changed files with 228 additions and 1213 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
project.clj
View file

@ -1,4 +1,4 @@
(defproject mw-parser "0.2.0-SNAPSHOT" (defproject mw-parser "0.3.0-SNAPSHOT"
:cloverage {:output "docs/cloverage"} :cloverage {:output "docs/cloverage"}
:codox {:metadata {:doc "**TODO**: write docs" :codox {:metadata {:doc "**TODO**: write docs"
:doc/format :markdown} :doc/format :markdown}
@ -7,7 +7,7 @@
:dependencies [[org.clojure/clojure "1.11.1"] :dependencies [[org.clojure/clojure "1.11.1"]
[org.clojure/tools.trace "0.7.11"] [org.clojure/tools.trace "0.7.11"]
[instaparse "1.4.12"] [instaparse "1.4.12"]
[mw-engine "0.2.0-SNAPSHOT"] [mw-engine "0.3.0-SNAPSHOT"]
[trptr/java-wrapper "0.2.3"]] [trptr/java-wrapper "0.2.3"]]
:description "Parser for production rules for MicroWorld engine" :description "Parser for production rules for MicroWorld engine"
:license {:name "GNU General Public License v2" :license {:name "GNU General Public License v2"

49
src/mw_parser/bulk.clj
View file

@ -1,49 +0,0 @@
(ns ^{:doc "parse multiple rules from a stream, possibly a file."
:author "Simon Brooke"}
mw-parser.bulk
(:require [clojure.string :refer [split]]
[mw-parser.declarative :refer [compile]]
[mw-parser.utils :refer [comment?]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; mw-parser: a rule parser for MicroWorld.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2014 Simon Brooke
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn parse-string
"Parse rules from successive lines in this `string`, assumed to have multiple
lines delimited by the new-line character. Return a list of S-expressions."
[string]
(map compile
(remove comment? (split string #"\n"))))
(defn parse-file
"Parse rules from successive lines in the file loaded from this `filename`.
Return a list of S-expressions."
[filename]
(parse-string (slurp filename)))
(defn compile-file
"Compile each non-comment line of the file indicated by this `filename` into
an executable anonymous function, and return the sequence of such functions."
[filename]
(compile (slurp filename) true))

451
src/mw_parser/core.clj
View file

@ -1,451 +0,0 @@
(ns ^{:doc "A very simple parser which parses production rules.
**NOTE**: This parser is obsolete and is superceded by the
declarative parser, q.v."
:author "Simon Brooke"}
mw-parser.core
(:require [clojure.string :refer [split trim triml]]
[mw-engine.utils :refer [member?]])
(:gen-class))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; mw-parser: a rule parser for MicroWorld.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2014 Simon Brooke
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; A very simple parser which parses production rules of the following forms:
;;;;
;;;; * "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"
;;;; * "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"
;;;; * "if altitude is 100 or fertility is 25 then state should be heath"
;;;; * "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2"
;;;; * "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"
;;;; * "if state is grassland and 4 neighbours have state equal to water then state should be village"
;;;; * "if state is forest and fertility is between 55 and 75 then state should be climax"
;;;; * "if 6 neighbours have state equal to water then state should be village"
;;;; * "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village"
;;;; * "if state is forest or state is climax and some neighbours have state equal to fire then 3 in 5 chance that state should be fire"
;;;; * "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub"
;;;; *
;;;;
;;;; it generates rules in the form expected by `mw-engine.core`, q.v.
;;;;
;;;; It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil.
;;;; Very occasionally it generates a wrong rule - one which is not a correct translation of the rule
;;;; semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a
;;;; design fault.
;;;;
;;;; More significantly it does not generate useful error messages on failure.
;;;;
;;;; This parser is now obsolete, but is retained in the codebase for now in
;;;; case it is of use to anyone. Prefer the declarative.clj parser.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare parse-conditions)
(declare parse-not-condition)
(declare parse-simple-condition)
;; a regular expression which matches string representation of positive numbers
(def re-number #"^[0-9.]*$")
;; error thrown when an attempt is made to set a reserved property
(def reserved-properties-error
"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")
;; error thrown when a rule cannot be parsed
(def bad-parse-error "I did not understand '%s'")
(defn- keyword-or-numeric
"If this token appears to represent an explicit number, return that number;
otherwise, make a keyword of it and return that."
[token]
(cond
(re-matches re-number token) (read-string token)
(keyword? token) token
:else (keyword token)))
;; Generally all functions in this file with names beginning 'parse-' take a
;; sequence of tokens (and in some cases other optional arguments) and return a
;; vector comprising
;;
;; 1. A code fragment parsed from the front of the sequence of tokens, and
;; 2. the remaining tokens which were not consumed in constructing that fragment.
;;
;; In every case if the function cannot parse the desired construct from the
;; front of the sequence of tokens it returns nil.
(defn parse-numeric-value
"Parse a number."
[[value & remainder]]
(when (and value (re-matches re-number value)) [(read-string value) remainder]))
(defn parse-property-int
"Parse a token assumed to be the name of a property of the current cell,
whose value is assumed to be an integer."
[[value & remainder]]
(when value [(list 'mw-engine.utils/get-int 'cell (keyword value)) remainder]))
(defn parse-property-value
"Parse a token assumed to be the name of a property of the current cell."
[[value & remainder]]
(when value [(list (keyword value) 'cell) remainder]))
(defn parse-token-value
"Parse a token assumed to be a simple token value."
[[value & remainder]]
(when value [(keyword value) remainder]))
(defn parse-simple-value
"Parse a value from the first of these `tokens`. If `expect-int` is true, return
an integer or something which will evaluate to an integer."
([tokens expect-int]
(or
(parse-numeric-value tokens)
(cond expect-int (parse-property-int tokens)
:else (parse-token-value tokens))))
([tokens]
(parse-simple-value tokens false)))
(defn gen-token-value
"Parse a single value from this single token and return just the generated
code, not a pair."
[token expect-int]
(first (parse-simple-value (list token) expect-int)))
(defn parse-disjunct-value
"Parse a list of values from among these `tokens`. If `expect-int` is true, return
integers or things which will evaluate to integers."
[[OR token & tokens] expect-int]
(cond (member? OR '("or" "in"))
(let [value (first (parse-simple-value (list token) expect-int))
seek-others (= (first tokens) "or")]
(cond seek-others
(let [[others remainder] (parse-disjunct-value tokens expect-int)]
[(cons value others) remainder])
:else
[(list value) tokens]))))
(defn parse-value
"Parse a value from among these `tokens`. If `expect-int` is true, return
an integer or something which will evaluate to an integer."
([tokens expect-int]
(or
(parse-disjunct-value tokens expect-int)
(parse-simple-value tokens expect-int)))
([tokens]
(parse-value tokens false)))
(defn parse-member-condition
"Parses a condition of the form '[property] in [value] or [value]...'"
[[property IS IN & rest]]
(when (and (member? IS '("is" "are")) (= IN "in"))
(let [[l remainder] (parse-disjunct-value (cons "in" rest) false)]
[(list 'member? (list (keyword property) 'cell) (list 'quote l)) remainder])))
(defn- parse-less-condition
"Parse '[property] less than [value]'."
[[property IS LESS THAN & rest]]
(cond (and (member? IS '("is" "are")) (member? LESS '("less" "fewer")) (= THAN "than"))
(let [[value remainder] (parse-value rest true)]
[(list '< (list 'get-int 'cell (keyword property)) value) remainder])))
(defn- parse-more-condition
"Parse '[property] more than [value]'."
[[property IS MORE THAN & rest]]
(cond (and (member? IS '("is" "are")) (member? MORE '("more" "greater")) (= THAN "than"))
(let [[value remainder] (parse-value rest true)]
[(list '> (list 'get-int 'cell (keyword property)) value) remainder])))
(defn- parse-between-condition
[[p IS BETWEEN v1 AND v2 & rest]]
(cond (and (member? IS '("is" "are")) (= BETWEEN "between") (= AND "and") (not (nil? v2)))
(let [property (first (parse-simple-value (list p) true))
value1 (first (parse-simple-value (list v1) true))
value2 (first (parse-simple-value (list v2) true))]
[(list 'or
(list '< value1 property value2)
(list '> value1 property value2)) rest])))
(defn- parse-is-condition
"Parse clauses of the form 'x is y', 'x is in y or z...',
'x is between y and z', 'x is more than y' or 'x is less than y'.
It is necessary to disambiguate whether value is a numeric or keyword."
[[property IS value & rest]]
(when
(member? IS '("is" "are"))
(cond
(re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest]
value [(list '= (list (keyword property) 'cell) (keyword value)) rest])))
(defn- parse-not-condition
"Parse the negation of a simple condition."
[[property IS NOT & rest]]
(cond (and (member? IS '("is" "are")) (= NOT "not"))
(let [partial (parse-simple-condition (cons property (cons "is" rest)))]
(cond partial
(let [[condition remainder] partial]
[(list 'not condition) remainder])))))
(defn- gen-neighbours-condition
([comp1 quantity property value remainder comp2 distance]
[(list comp1
(list 'count
(list 'get-neighbours-with-property-value 'world
'(cell :x) '(cell :y) distance
(keyword property) (keyword-or-numeric value) comp2))
quantity)
remainder])
([comp1 quantity property value remainder comp2]
(gen-neighbours-condition comp1 quantity property value remainder comp2 1)))
(defn parse-comparator-neighbours-condition
"Parse conditions of the form '...more than 6 neighbours are [condition]'"
[[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]]
(let [quantity (first (parse-numeric-value (list n)))
comparator (cond (= MORE "more") '>
(member? MORE '("fewer" "less")) '<)]
(cond
(not= WITHIN "within")
(parse-comparator-neighbours-condition
(flatten
;; two tokens were mis-parsed as 'within distance' that weren't
;; actually 'within' and a distance. Splice in 'within 1' and try
;; again.
(list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
(and quantity
comparator
(= THAN "than")
(= NEIGHBOURS "neighbours"))
(cond
(= have-or-are "are")
(let [[value & remainder] rest
dist (gen-token-value distance true)]
(gen-neighbours-condition comparator quantity :state value remainder = dist))
(= have-or-are "have")
(let [[property comp1 comp2 value & remainder] rest
dist (gen-token-value distance true)]
(cond (and (= comp1 "equal") (= comp2 "to"))
(gen-neighbours-condition comparator quantity property
value remainder = dist)
(and (= comp1 "more") (= comp2 "than"))
(gen-neighbours-condition comparator quantity property
value remainder > dist)
(and (= comp1 "less") (= comp2 "than"))
(gen-neighbours-condition comparator quantity property
value remainder < dist)))))))
(defn parse-some-neighbours-condition
[[SOME NEIGHBOURS & rest]]
(cond
(and (= SOME "some") (= NEIGHBOURS "neighbours"))
(parse-comparator-neighbours-condition (concat '("more" "than" "0" "neighbours") rest))))
(defn parse-simple-neighbours-condition
"Parse conditions of the form '...6 neighbours are [condition]'"
[[n NEIGHBOURS WITHIN distance have-or-are & rest]]
(let [quantity (first (parse-numeric-value (list n)))]
(cond
(and quantity (= NEIGHBOURS "neighbours"))
(cond
(not= WITHIN "within")
(parse-simple-neighbours-condition
(flatten
;; two tokens were mis-parsed as 'within distance' that weren't
;; actually 'within' and a distance. Splice in 'within 1' and try
;; again.
(list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
(= have-or-are "are")
(let [[value & remainder] rest
dist (gen-token-value distance true)]
(gen-neighbours-condition '= quantity :state value remainder = dist))
(= have-or-are "have")
(let [[property comp1 comp2 value & remainder] rest
dist (gen-token-value distance true)]
(cond (and (= comp1 "equal") (= comp2 "to"))
(gen-neighbours-condition '= quantity property value remainder =
dist)
(and (= comp1 "more") (= comp2 "than"))
(gen-neighbours-condition '= quantity property value remainder >
dist)
(and (= comp1 "less") (= comp2 "than"))
(gen-neighbours-condition '= quantity property value remainder <
dist)))))))
(defn parse-neighbours-condition
"Parse conditions referring to neighbours"
[tokens]
(or
(parse-simple-neighbours-condition tokens)
(parse-comparator-neighbours-condition tokens)
(parse-some-neighbours-condition tokens)))
(defn parse-simple-condition
"Parse conditions of the form '[property] [comparison] [value]'."
[tokens]
(or
(parse-neighbours-condition tokens)
(parse-member-condition tokens)
(parse-not-condition tokens)
(parse-less-condition tokens)
(parse-more-condition tokens)
(parse-between-condition tokens)
(parse-is-condition tokens)))
(defn- parse-disjunction-condition
"Parse '... or [condition]' from `tokens`, where `left` is the already parsed first disjunct."
[left tokens]
(let [partial (parse-conditions tokens)]
(when partial
(let [[right remainder] partial]
[(list 'or left right) remainder]))))
(defn- parse-conjunction-condition
"Parse '... and [condition]' from `tokens`, where `left` is the already parsed first conjunct."
[left tokens]
(let [partial (parse-conditions tokens)]
(when partial
(let [[right remainder] partial]
[(list 'and left right) remainder]))))
(defn- parse-conditions
"Parse conditions from `tokens`, where conditions may be linked by either 'and' or 'or'."
[tokens]
(let [partial (parse-simple-condition tokens)]
(when partial
(let [[left [next & remainder]] partial]
(cond
(= next "and") (parse-conjunction-condition left remainder)
(= next "or") (parse-disjunction-condition left remainder)
:else partial)))))
(defn- parse-left-hand-side
"Parse the left hand side ('if...') of a production rule."
[[IF & tokens]]
(when
(= IF "if")
(parse-conditions tokens)))
(defn- parse-arithmetic-action
"Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]',
e.g. 'fertility should be fertility + 1', or 'deer should be deer - wolves'."
[previous [prop1 SHOULD BE prop2 operator value & rest]]
(cond
(member? prop1 '("x" "y"))
(throw
(Exception. reserved-properties-error))
(and (= SHOULD "should")
(= BE "be")
(member? operator '("+" "-" "*" "/")))
[(list 'merge (or previous 'cell)
{(keyword prop1) (list 'int
(list (symbol operator)
(list 'get-int 'cell (keyword prop2))
(if
(re-matches re-number value)
(read-string value)
(list 'get-int 'cell (keyword value)))))})
rest]))
(defn- parse-set-action
"Parse actions of the form '[property] should be [value].'"
[previous [property SHOULD BE value & rest]]
(cond
(member? property '("x" "y"))
(throw
(Exception. reserved-properties-error))
(and (= SHOULD "should") (= BE "be"))
[(list 'merge (or previous 'cell)
{(keyword property) (if
(re-matches re-number value)
(read-string value)
(keyword value))}) rest]))
(defn- parse-simple-action [previous tokens]
(or (parse-arithmetic-action previous tokens)
(parse-set-action previous tokens)))
(defn- parse-actions
"Parse actions from tokens."
[previous tokens]
(let [[left remainder] (parse-simple-action previous tokens)]
(cond left
(cond (= (first remainder) "and")
(parse-actions left (rest remainder))
:else (list left)))))
(defn- parse-probability
"Parse a probability of an action from this collection of tokens"
[previous [n CHANCE IN m & tokens]]
(cond
(and (= CHANCE "chance") (= IN "in"))
(let [[action remainder] (parse-actions previous tokens)]
(cond action
[(list 'cond
(list '<
(list 'rand
(first (parse-simple-value (list m) true)))
(first (parse-simple-value (list n) true)))
action) remainder]))))
(defn- parse-right-hand-side
"Parse the right hand side ('then...') of a production rule."
[[THEN & tokens]]
(when (= THEN "then")
(or
(parse-probability nil tokens)
(parse-actions nil tokens))))
(defn parse-rule
"Parse a complete rule from this `line`, expected to be either a string or a
sequence of string tokens. Return the rule in the form of an S-expression.
Throws an exception if parsing fails."
[line]
(if
(string? line) (let [rule (parse-rule (split (triml line) #"\s+"))]
(if rule rule
(throw (Exception. (format bad-parse-error line)))))
(let [[left remainder] (parse-left-hand-side line)
[right junk] (parse-right-hand-side remainder)]
(when
;; there should be a valide left hand side and a valid right hand side
;; there shouldn't be anything left over (junk should be empty)
(and left right (empty? junk))
(list 'fn ['cell 'world] (list 'if left right))))))
(defn compile-rule
"Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules,
into Clojure source, and then compile it into an anonymous
function object, getting round the problem of binding mw-engine.utils in
the compiling environment. If `return-tuple?` is present and true, return
a list comprising the anonymous function compiled, and the function from
which it was compiled.
Throws an exception if parsing fails."
([rule-text return-tuple?]
(let [afn (eval (parse-rule rule-text))]
(if
(and afn return-tuple?)
(list afn (trim rule-text))
afn)))
([rule-text]
(compile-rule rule-text false)))

110
src/mw_parser/declarative.clj
View file

@ -1,12 +1,11 @@
(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 [clojure.string :refer [join split split-lines trim]] (:require [clojure.string :refer [join split-lines]]
[instaparse.core :refer [parser]] [instaparse.core :refer [parser]]
[mw-parser.flow :refer [flow-grammar]] [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 [comment?]]
[trptr.java-wrapper.locale :refer [get-default]]) [trptr.java-wrapper.locale :refer [get-default]])
(:import [java.util Locale])) (:import [java.util Locale]))
@ -33,11 +32,18 @@
;;;; ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ruleset-grammar
"Experimental: parse a whole file in one go."
(join "\n" ["LINES := LINE | LINE CR LINES;"
"LINE := RULE | FLOW-RULE | CR | COMMENT | '' ;"
"CR := #'[\\r\\n]';"
"COMMENT := #'[;#]+[^\\r\\n]*' | #'/\\*.*\\*/'"]))
(def rule-grammar (def rule-grammar
"Basic rule language grammar. "Basic rule language grammar.
in order to simplify translation into other natural languages, all in order to simplify translation into other natural languages, all
TOKENS within the parser should be unambiguou." TOKENS within the parser should be unambiguous."
(join "\n" ["RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS;" (join "\n" ["RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS;"
"ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS" "ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS"
"ACTION := SIMPLE-ACTION | PROBABLE-ACTION;" "ACTION := SIMPLE-ACTION | PROBABLE-ACTION;"
@ -68,7 +74,7 @@
"QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER;" "QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER;"
"RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION;" "RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION;"
"SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE;" "SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE;"
"SPACE := #'\\s+';" "SPACE := #'[ \\t]+';"
"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;"]))
@ -121,61 +127,61 @@
([^Locale _locale] ([^Locale _locale]
keywords-en)) keywords-en))
(defmacro build-parser (def parse
"Compose this grammar fragment `g` with the common grammar fragments to
make a complete grammar, and return a parser for that complete grammar."
[g]
`(parser (join "\n" [~g common-grammar (keywords-for-locale)])))
(def parse-rule
"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)) (parser (join "\n" [ruleset-grammar rule-grammar flow-grammar common-grammar (keywords-for-locale)])))
(def parse-flow (defn- compile-rule
"Parse the argument, assumed to be a string in the correct syntax, and return a parse tree." "Compile a rule function from this `parse-tree` derived from this `source`
(build-parser flow-grammar)) at the zero-based line number `n` in the source file; return a compiled
function, whose metadata has the keys:
(defn parse * `:rule-type` : the type of rule the function represents;
"Top level parser function: parse this `text` as either a production or a flow rule; * `:parse` : this `parse-tree`;
return a raw parse tree." * `:lisp` : the lisp source generated from this `parse-tree`;
[^String rule-text] * `:line : the one-based line number of the definition in the source file,
(let [text (trim rule-text)] i.e. `(inc n)`."
(when-not (zero? (count text)) [parse-tree source n]
(case (first (split text #"\s+")) (when-not (keyword? parse-tree)
"if" (parse-rule text) (let [lisp (generate parse-tree)
"flow" (parse-flow text) line-no (inc n)]
";;" nil (try
(throw (ex-info "Rule text was not recognised" {:text text})))))) (if (#{'fn 'fn*} (first lisp))
(vary-meta
(eval lisp)
merge (meta lisp) {:src source :lisp lisp :line line-no})
(throw
(Exception.
(format "Parse of `%s` did not return a function: %s" source lisp))))
(catch Exception any (throw (ex-info (.getMessage any)
{:source source
:parse parse-tree
:lisp lisp
:line line-no})))))))
(defn compile (defn compile
"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
function object, getting round the problem of binding mw-engine.utils in function object, getting round the problem of binding mw-engine.utils in
the compiling environment. If `return-tuple?` is present and true, return the compiling environment.
a list comprising the anonymous function compiled, and the function from
which it was compiled. Returns a list of anonymous functions each of two arguments, `[cell world]`,
as expected for a MicroWorld rule function. Each function is decorated with
metadata having the keys:
* `:rule-type` : the type of rule the function represents;
* `:lisp` : the lisp source from which the function was compiled;
* `:parse` : the parse-tree from which that lisp source was derived;
* `:source` : the rule source from which the parse-tree was derived;
* `:line : the one-based line number of the rule source in the source file.
Throws an exception if parsing fails." Throws an exception if parsing fails."
([rule-text return-tuple?] [rule-text]
(let [lines (map trim (remove comment? (split-lines rule-text)))] (let [lines (split-lines rule-text)]
(if (> (count lines) 1) (remove
(map #(compile % return-tuple?) lines) nil?
(let [src (first lines) (map
parse-tree (doall (simplify (parse src))) compile-rule
fn' (doall (generate parse-tree)) (simplify (parse rule-text))
afn (try lines
(if (#{'fn 'fn*} (first fn')) (range (count lines))))))
(vary-meta (eval fn') merge (meta fn'))
(throw (Exception.
(format "Parse of `%s` did not return a function: %s"
src fn'))))
(catch Exception any (throw (ex-info (.getMessage any)
{:src src
:parse parse-tree
:fn fn'}))))]
(if
return-tuple?
(vary-meta (list afn src fn') merge (meta afn))
afn)))))
([rule-text]
(compile rule-text false)))

2
src/mw_parser/errors.clj
View file

@ -24,8 +24,6 @@
;; error thrown when an attempt is made to set a reserved property ;; error thrown when an attempt is made to set a reserved property
(def reserved-properties-error
"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")
;; error thrown when a rule cannot be parsed. Slots are for ;; error thrown when a rule cannot be parsed. Slots are for
;; (1) rule text ;; (1) rule text
;; (2) cursor showing where in the rule text the error occurred ;; (2) cursor showing where in the rule text the error occurred

8
src/mw_parser/generate.clj
View file

@ -1,8 +1,7 @@
(ns ^{:doc "Generate Clojure source from simplified parse trees." (ns ^{:doc "Generate Clojure source from simplified parse trees."
:author "Simon Brooke"} :author "Simon Brooke"}
mw-parser.generate mw-parser.generate
(:require [mw-parser.errors :as pe] (:require [mw-parser.utils :refer [assert-type search-tree TODO]]))
[mw-parser.utils :refer [assert-type search-tree TODO]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
@ -25,6 +24,9 @@
(declare generate generate-action) (declare generate generate-action)
(def reserved-properties-error
"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")
;;; macros used in generated rules ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; macros used in generated rules ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; production (if-then) rules ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; production (if-then) rules ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -152,7 +154,7 @@
(let [property (generate (second tree)) (let [property (generate (second tree))
expression (generate (nth tree 3))] expression (generate (nth tree 3))]
(if (or (= property :x) (= property :y)) (if (or (= property :x) (= property :y))
(throw (Exception. pe/reserved-properties-error)) (throw (Exception. reserved-properties-error))
(list 'merge (list 'merge
(if (empty? others) 'cell (if (empty? others) 'cell
;; else ;; else

19
src/mw_parser/simplify.clj
View file

@ -68,13 +68,32 @@
:ACTIONS (cons (first tree) (simplify (rest tree))) :ACTIONS (cons (first tree) (simplify (rest tree)))
:AND nil :AND nil
:CHANCE-IN nil :CHANCE-IN nil
:COMMENT nil
:COMPARATIVE (simplify-second-of-two tree) :COMPARATIVE (simplify-second-of-two tree)
:CONDITION (simplify-second-of-two tree) :CONDITION (simplify-second-of-two tree)
:CONDITIONS (simplify-second-of-two tree) :CONDITIONS (simplify-second-of-two tree)
:CR nil
:DISJUNCT-EXPRESSION (simplify-chained-list tree :DISJUNCT-VALUE :VALUE) :DISJUNCT-EXPRESSION (simplify-chained-list tree :DISJUNCT-VALUE :VALUE)
:EXPRESSION (simplify-second-of-two tree) :EXPRESSION (simplify-second-of-two tree)
:FLOW-CONDITIONS (simplify-second-of-two tree) :FLOW-CONDITIONS (simplify-second-of-two tree)
:IN nil :IN nil
;; this is like simplify-second-of-two except if there isn't
;; a second element it returns nil
:LINE (when (= (count tree) 2) (simplify (nth tree 1)))
:LINES (loop [lines tree result '()]
(let [line (simplify (second lines))
;; the reason for putting :BLANK in the result in place
;; of lines that weren't rules is so that we can keep
;; track of the source text of the line we're compiling.
result' (concat result (list (or line :BLANK)))]
(when-not (= :LINES (first lines))
(throw (ex-info "Unexpeced parse tree: LINES"
{:lines lines})))
(case (count lines)
2 result'
4 (recur (nth lines 3) result')
(throw (ex-info "Unexpeced parse tree: LINES"
{:lines lines})))))
:PROPERTY (simplify-second-of-two tree) :PROPERTY (simplify-second-of-two tree)
:PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
:OR nil :OR nil

17
src/mw_parser/utils.clj
View file

@ -1,8 +1,6 @@
(ns ^{:doc "Utilities used in more than one namespace within the parser." (ns ^{:doc "Utilities used in more than one namespace within the parser."
:author "Simon Brooke"} :author "Simon Brooke"}
mw-parser.utils mw-parser.utils)
(:require [clojure.string :refer [trim]]
[mw-engine.utils :refer [member?]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ;;;;
@ -27,11 +25,6 @@
;;;; ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn comment?
"Is this `line` a comment?"
[line]
(or (empty? (trim line)) (member? (first line) '(nil \# \;))))
(defn suitable-fragment? (defn suitable-fragment?
"Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`." "Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`."
[tree-fragment type] [tree-fragment type]
@ -39,18 +32,11 @@
(keyword? type) (keyword? type)
(= (first tree-fragment) type))) (= (first tree-fragment) type)))
(defn rule?
"Return true if the argument appears to be a parsed rule tree, else false."
[maybe-rule]
(suitable-fragment? maybe-rule :RULE))
(defn TODO (defn TODO
"Marker to indicate I'm not yet finished!" "Marker to indicate I'm not yet finished!"
[message] [message]
message) message)
(defn assert-type (defn assert-type
"If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception." "If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception."
[tree-fragment type] [tree-fragment type]
@ -59,7 +45,6 @@
{:actual tree-fragment {:actual tree-fragment
:expected type})))) :expected type}))))
(defn search-tree (defn search-tree
"Return the first element of this tree which has this tag in a depth-first, left-to-right search" "Return the first element of this tree which has this tag in a depth-first, left-to-right search"
[tree tag] [tree tag]

25
test/mw_parser/bulk_test.clj
View file

@ -1,25 +0,0 @@
(ns mw-parser.bulk-test
(:require [clojure.java.io :refer [as-file]]
[clojure.test :refer [deftest is testing]]
[mw-parser.bulk :refer [compile-file parse-file]]))
(deftest bulk-parsing-test
(testing "Bulk (file) parsing and compilation"
(is (= (count (parse-file (as-file "resources/rules.txt"))) 15)
"Should parse all rules and throw no exceptions")
(is (empty?
(remove #(= % 'fn)
(map first
(parse-file
(as-file "resources/rules.txt")))))
"all parsed rules should be lambda sexprs")
(is (= (count (compile-file (as-file "resources/rules.txt"))) 15)
"Should compile all rules and throw no exceptions")
(is (empty?
(remove ifn?
(map first
(compile-file
(as-file "resources/rules.txt")))))
"all compiled rules should be ifns")
))

475
test/mw_parser/core_test.clj
View file

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

237
test/mw_parser/declarative_test.clj
View file

@ -1,34 +1,43 @@
(ns mw-parser.declarative-test (ns mw-parser.declarative-test
(:require [clojure.test :refer [deftest is testing]] (:require [clojure.string :refer [join]]
[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 parse parse-rule]] [mw-parser.declarative :refer [compile parse]]
[mw-parser.utils :refer [rule?]])) [mw-parser.generate :refer [generate]]
[mw-parser.simplify :refer [simplify]]
[mw-parser.utils :refer [suitable-fragment?]]))
(defn rule?
"Return true if the argument appears to be a parsed rule tree, else false."
[maybe-rule]
(suitable-fragment? maybe-rule :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!"
(is (rule? (parse-rule "if state is forest then state should be climax"))) (is (rule? (parse "if state is forest then state should be climax")))
(is (rule? (parse-rule "if state is in grassland or pasture or heath then state should be village"))) (is (rule? (parse "if state is in grassland or pasture or heath then state should be village")))
(is (rule? (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))) (is (rule? (parse "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")))
(is (rule? (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"))) (is (rule? (parse "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3")))
(is (rule? (parse-rule "if altitude is 100 or fertility is 25 then state should be heath"))) (is (rule? (parse "if altitude is 100 or fertility is 25 then state should be heath")))
(is (rule? (parse-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2"))) (is (rule? (parse "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2")))
(is (rule? (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"))) (is (rule? (parse "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves")))
(is (rule? (parse-rule "if state is forest and fertility is between 55 and 75 then state should be climax"))) (is (rule? (parse "if state is forest and fertility is between 55 and 75 then state should be climax")))
(is (rule? (parse-rule "if fertility is between 55 and 75 then state should be climax"))) (is (rule? (parse "if fertility is between 55 and 75 then state should be climax")))
(is (rule? (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))))) (is (rule? (parse "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")))))
(deftest neighbours-rules-tests (deftest neighbours-rules-tests
(testing "Rules which relate to neighbours - hard!" (testing "Rules which relate to neighbours - hard!"
(is (rule? (parse-rule "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire"))) (is (rule? (parse "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire")))
(is (rule? (parse-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village"))) (is (rule? (parse "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village")))
(is (rule? (parse-rule "if 6 neighbours have state equal to water then state should be village"))) (is (rule? (parse "if 6 neighbours have state equal to water then state should be village")))
(is (rule? (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village"))) (is (rule? (parse "if state is grassland and 4 neighbours have state equal to water then state should be village")))
(is (rule? (parse-rule "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub"))) (is (rule? (parse "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 "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 "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 "if 6 neighbours have state equal to water then state should be village")))))
(deftest exception-tests (deftest exception-tests
@ -39,20 +48,22 @@
(is (thrown-with-msg? Exception #"^I did not understand.*" (is (thrown-with-msg? Exception #"^I did not understand.*"
(parse "if i have a cat on my lap then everything is fine")) (parse "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")
;; TODO: these two should be moved to generate-test; the exception should be
;; being thrown (but isn't) in the generate phase.
(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 "if state is new then x should be 0")) (generate (simplify (parse "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 "if state is new then y should be 0")) (generate (simplify (parse "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
;; these are, in so far as possible, the same as the correctness-tests in core-tests - i.e., the two compilers ;; these are, in so far as possible, the same as the correctness-tests in core-tests - i.e., the two compilers
;; compile the same language. ;; compile the same language.
(testing "Simplest possible rule" (testing "Simplest possible rule"
(let [afn (compile "if state is new then state should be grassland")] (let [afn (first (compile "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")
@ -60,7 +71,7 @@
"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 "if state is new and altitude is 0 then state should be water")] (let [afn (first (compile "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")
@ -70,7 +81,7 @@
"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 "if state is new or state is waste then state should be grassland")] (let [afn (first (compile "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")
@ -81,7 +92,7 @@
"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 "if state is not new then state should be grassland")] (let [afn (first (compile "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))
@ -91,15 +102,15 @@
(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 "if state is new then x should be 0")) (first (compile "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 "if state is new then y should be 0")) (first (compile "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"
(let [afn (compile "if state is in heath or scrub or forest then state should be climax")] (let [afn (first (compile "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")
@ -113,7 +124,7 @@
"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 "if state is not in heath or scrub or forest then state should be climax")] (let [afn (first (compile "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)))
@ -125,7 +136,7 @@
"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 "if altitude is more than 200 then state should be snow")] (let [afn (first (compile "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")
@ -133,7 +144,7 @@
"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 "if wolves are more than deer then deer should be 0")] (let [afn (first (compile "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")
@ -141,7 +152,7 @@
"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 "if altitude is less than 10 then state should be water")] (let [afn (first (compile "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")
@ -149,7 +160,7 @@
"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 "if wolves are less than deer then deer should be deer - wolves")] (let [afn (first (compile "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")
@ -157,14 +168,14 @@
"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 "if 3 neighbours have state equal to new then state should be water") (let [afn (first (compile "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 "if 3 neighbours are new then state should be water") (let [afn (first (compile "if 3 neighbours are new then state should be water"))
world (make-world 3 3)] world (make-world 3 3)]
;; 'are new' and 'is new' should be the same as 'have state equal to new' ;; 'are new' and 'is 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))
@ -172,7 +183,7 @@
"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 "if 3 neighbours is new then state should be water") (let [afn (first (compile "if 3 neighbours is new then state should be water"))
world (make-world 3 3)] world (make-world 3 3)]
;; 'are new' and 'is new' should be the same as 'have state equal to new' ;; 'are new' and 'is 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))
@ -183,76 +194,80 @@
(testing "Number neighbours have property more than numeric-value" (testing "Number neighbours have property more than numeric-value"
;; 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 "if 3 neighbours have altitude more than 10 then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11") (compile (join "\n" ["if x is 2 then altitude should be 11"
(compile "if x is less than 2 then altitude should be 0")))] "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 "if 5 neighbours have altitude less than 10 then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11") (compile (join "\n" ["if x is 2 then altitude should be 11"
(compile "if x is less than 2 then altitude should be 0")))] "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 "if more than 2 neighbours have altitude equal to 11 then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11") (compile (join "\n" ["if x is 2 then altitude should be 11"
(compile "if x is less than 2 then altitude should be 0")))] "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 "if more than 2 neighbours have state equal to grassland then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11 and state should be grassland") (compile
(compile "if x is less than 2 then altitude should be 0 and state should be water")))] (join "\n"
(list "if x is 2 then altitude should be 11 and state should be grassland"
"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 "if more than 2 neighbours are grassland then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11 and state should be grassland") (compile (join "\n" (list "if x is 2 then altitude should be 11 and state should be grassland"
(compile "if x is less than 2 then altitude should be 0 and state should be water")))] "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 "if fewer than 3 neighbours have altitude equal to 11 then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11") (compile (join "\n" (list "if x is 2 then altitude should be 11"
(compile "if x is less than 2 then altitude should be 0")))] "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 "if fewer than 3 neighbours have state equal to grassland then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11 and state should be grassland") (compile
(compile "if x is less than 2 then altitude should be 0 and state should be water")))] (join "\n"
(list "if x is 2 then altitude should be 11 and state should be grassland"
"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)))
@ -260,22 +275,26 @@
;; 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 "if some neighbours have altitude equal to 11 then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11") (compile
(compile "if x is less than 2 then altitude should be 0")))] (join "\n"
(list "if x is 2 then altitude should be 11"
"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 "if some neighbours have state equal to grassland then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11 and state should be grassland") (compile
(compile "if x is less than 2 then altitude should be 0 and state should be water")))] (join "\n"
(list "if x is 2 then altitude should be 11 and state should be grassland"
"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)))
@ -283,11 +302,13 @@
;; 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 "if more than 2 neighbours have altitude more than 10 then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11 and state should be grassland") (compile
(compile "if x is less than 2 then altitude should be 0 and state should be water")))] (join "\n"
(list "if x is 2 then altitude should be 11 and state should be grassland"
"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)))
@ -295,11 +316,13 @@
;; 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 "if fewer than 3 neighbours have altitude more than 10 then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11") (compile
(compile "if x is less than 2 then altitude should be 0")))] (join "\n"
(list "if x is 2 then altitude should be 11"
"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)))
@ -307,11 +330,13 @@
;; 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 "if some neighbours have altitude more than 10 then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11") (compile
(compile "if x is less than 2 then altitude should be 0")))] (join "\n"
(list "if x is 2 then altitude should be 11"
"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)))
@ -319,11 +344,13 @@
;; 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 "if more than 4 neighbours have altitude less than 10 then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11") (compile
(compile "if x is less than 2 then altitude should be 0")))] (join "\n"
(list "if x is 2 then altitude should be 11"
"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)))
@ -331,11 +358,13 @@
;; 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 "if fewer than 4 neighbours have altitude less than 10 then state should be beach") (let [afn (first (compile "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 "if x is 2 then altitude should be 11") (compile
(compile "if x is less than 2 then altitude should be 0")))] (join "\n"
(list "if x is 2 then altitude should be 11"
"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)
@ -343,11 +372,13 @@
;; 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 "if some neighbours have altitude less than 10 then state should be beach") (let [afn (first (compile "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 "if x is less than 2 then altitude should be 11") (compile
(compile "if x is 2 then altitude should be 0")))] (join "\n"
(list "if x is less than 2 then altitude should be 11"
"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)))
@ -357,7 +388,7 @@
;; '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 "if state is new then state should be grassland and fertility should be 0")] (let [afn (first (compile "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")))
@ -367,23 +398,23 @@
;; 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 "if state is forest then 5 chance in 5 state should be climax")] (let [afn (first (compile "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 "if state is forest then 0 chance in 5 state should be climax")] (let [afn (first (compile "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 "if state is climax then fertility should be fertility + 1")] (let [afn (first (compile "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 "if state is climax then fertility should be fertility + leaffall")] (let [afn (first (compile "if state is climax then fertility should be fertility + leaffall"))]
(is (= (:fertility (is (= (:fertility
(apply afn (apply afn
(list {:state :climax (list {:state :climax
@ -393,14 +424,14 @@
"Addition is executed"))) "Addition is executed")))
(testing "Arithmetic action: subtraction of number" (testing "Arithmetic action: subtraction of number"
(let [afn (compile "if state is crop then fertility should be fertility - 1")] (let [afn (first (compile "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 "if wolves are more than 0 then deer should be deer - wolves")] (let [afn (first (compile "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
@ -409,14 +440,14 @@
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: multiplication by number" (testing "Arithmetic action: multiplication by number"
(let [afn (compile "if deer are more than 1 then deer should be deer * 2")] (let [afn (first (compile "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 "if state is crop then deer should be deer * deer")] (let [afn (first (compile "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)))
@ -424,14 +455,14 @@
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: division by number" (testing "Arithmetic action: division by number"
(let [afn (compile "if wolves are more than 0 then deer should be deer / 2")] (let [afn (first (compile "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 "if wolves are more than 0 then deer should be deer / wolves")] (let [afn (first (compile "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)))
@ -440,7 +471,7 @@
;; 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 "if 8 neighbours within 2 have state equal to new then state should be water") (let [afn (first (compile "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})
@ -450,7 +481,7 @@
;; 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 "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 (first (compile "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
@ -459,8 +490,10 @@
;; xxooo ;; xxooo
world (transform-world world (transform-world
(make-world 5 5) (make-world 5 5)
(list (compile "if x is less than 2 then altitude should be 11 and state should be grassland") (compile
(compile "if x is more than 1 then altitude should be 0 and state should be water")))] (join "\n"
(list "if x is less than 2 then altitude should be 11 and state should be grassland"
"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)))
@ -468,11 +501,13 @@
(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 "if state is scrub then 1 chance in 1 state should be forest") (let [afn (first (compile "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 "if x is 2 then altitude should be 11") (compile
(compile "if x is less than 2 then state should be scrub")))] (join "\n"
(list "if x is 2 then altitude should be 11"
"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)

2
test/mw_parser/flow_test.clj
View file

@ -4,7 +4,7 @@
[mw-parser.declarative :refer [parse]] [mw-parser.declarative :refer [parse]]
[mw-parser.simplify :refer [simplify]])) [mw-parser.simplify :refer [simplify]]))
(deftest parse-flow-tests (deftest parse-tests
(testing "flow-grammar" (testing "flow-grammar"
(let [rule "flow 1 food from house having food more than 10 to house within 2 with least food" (let [rule "flow 1 food from house having food more than 10 to house within 2 with least food"
expected '(:FLOW-RULE expected '(:FLOW-RULE

2
test/mw_parser/generate_test.clj
View file

@ -112,7 +112,7 @@
world [[{:y 0, :state :new, :x 0} {:y 0, :state :new, :x 1} {:y 0, :state :new, :x 2}] world [[{:y 0, :state :new, :x 0} {:y 0, :state :new, :x 1} {:y 0, :state :new, :x 2}]
[{:y 1, :state :new, :x 0} cell {:y 1, :state :new, :x 2}] [{:y 1, :state :new, :x 0} cell {:y 1, :state :new, :x 2}]
[{:y 2, :state :new, :x 0} {:y 2, :state :new, :x 1} {:y 2, :state :new, :x 2}]] [{:y 2, :state :new, :x 0} {:y 2, :state :new, :x 1} {:y 2, :state :new, :x 2}]]
rule (compile "if state is scrub then 1 chance in 5 state should be forest") rule (first (compile "if state is scrub then 1 chance in 5 state should be forest"))
expected #{:scrub :forest} expected #{:scrub :forest}
cell' (reduce cell' (reduce
(fn [c i] (merge (or (apply-rule world c rule) c) {:i i})) (fn [c i] (merge (or (apply-rule world c rule) c) {:i i}))

6
test/mw_parser/simplify_test.clj
View file

@ -1,6 +1,6 @@
(ns mw-parser.simplify-test (ns mw-parser.simplify-test
(:require [clojure.test :refer [deftest is testing]] (:require [clojure.test :refer [deftest is testing]]
[mw-parser.declarative :refer [parse-rule]] [mw-parser.declarative :refer [parse]]
[mw-parser.simplify :refer [simplify]] [mw-parser.simplify :refer [simplify]]
[mw-parser.utils :refer [search-tree]])) [mw-parser.utils :refer [search-tree]]))
@ -81,7 +81,7 @@
(:SYMBOL "scrub") (:SYMBOL "scrub")
(:DISJUNCT-VALUE (:SYMBOL "forest"))))) (:DISJUNCT-VALUE (:SYMBOL "forest")))))
parse-tree (search-tree parse-tree (search-tree
(parse-rule (parse
"if state is not in heath or scrub or forest then state should be climax") "if state is not in heath or scrub or forest then state should be climax")
:DISJUNCT-EXPRESSION) :DISJUNCT-EXPRESSION)
actual (simplify parse-tree)] actual (simplify parse-tree)]
@ -91,7 +91,7 @@
(:SYMBOL "scrub") (:SYMBOL "scrub")
(:SYMBOL "forest")) (:SYMBOL "forest"))
parse-tree (search-tree parse-tree (search-tree
(parse-rule (parse
"if state is not in heath or scrub or forest then state should be climax") "if state is not in heath or scrub or forest then state should be climax")
:DISJUNCT-EXPRESSION) :DISJUNCT-EXPRESSION)
actual (simplify parse-tree)] actual (simplify parse-tree)]

30
test/mw_parser/utils_test.clj
View file

@ -1,30 +0,0 @@
(ns mw-parser.utils-test
(:require [clojure.test :refer [deftest is testing]]
[mw-parser.utils :refer [assert-type rule? search-tree
suitable-fragment? TODO]]))
(deftest fragment-tests
(testing "Functions finding and identifying rule fragments"
(let [rule '(:RULE
(:IF "if")
(:PROPERTY-CONDITION
(:SYMBOL "state")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:SYMBOL "forest"))
(:ACTIONS
(:SIMPLE-ACTION
(:SYMBOL "state")
(:BECOMES "should be")
(:SYMBOL "climax"))))
not-rule [:FROBOZ :foo :bar :ban]]
(is (rule? rule))
(is (not (rule? not-rule)))
(is (= nil (assert-type rule :RULE)))
(is (thrown-with-msg?
Exception #"Expected a :RULE fragment" (assert-type not-rule :RULE)))
(is (= '(:EQUIVALENCE (:IS "is")) (search-tree rule :EQUIVALENCE)))
(is (= nil (search-tree rule :EQUIVOCATION)))
(is (suitable-fragment? '(:EQUIVALENCE (:IS "is")) :EQUIVALENCE))
(is (not (suitable-fragment? :EQUIVALENCE :EQUIVALENCE)))
(is (not (suitable-fragment? '(:EQUIVALENCE (:IS "is")) :QUALIFIER)))
(is (= (TODO "Froboz") "Froboz")))))