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"}
:codox {:metadata {:doc "**TODO**: write docs"
:doc/format :markdown}
@ -7,7 +7,7 @@
:dependencies [[org.clojure/clojure "1.11.1"]
[org.clojure/tools.trace "0.7.11"]
[instaparse "1.4.12"]
[mw-engine "0.2.0-SNAPSHOT"]
[mw-engine "0.3.0-SNAPSHOT"]
[trptr/java-wrapper "0.2.3"]]
:description "Parser for production rules for MicroWorld engine"
: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."
:author "Simon Brooke"}
mw-parser.declarative
(:require [clojure.string :refer [join split split-lines trim]]
(:require [clojure.string :refer [join split-lines]]
[instaparse.core :refer [parser]]
[mw-parser.flow :refer [flow-grammar]]
[mw-parser.generate :refer [generate]]
[mw-parser.simplify :refer [simplify]]
[mw-parser.utils :refer [comment?]]
[trptr.java-wrapper.locale :refer [get-default]])
(: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
"Basic rule language grammar.
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;"
"ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS"
"ACTION := SIMPLE-ACTION | PROBABLE-ACTION;"
@ -68,7 +74,7 @@
"QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER;"
"RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION;"
"SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE;"
"SPACE := #'\\s+';"
"SPACE := #'[ \\t]+';"
"VALUE := SYMBOL | NUMBER;"
"VALUE := SYMBOL | NUMBER;"
"WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION;"]))
@ -121,61 +127,61 @@
([^Locale _locale]
keywords-en))
(defmacro build-parser
"Compose this grammar fragment `g` with the common grammar fragments to
make a complete grammar, and return a parser for that complete grammar."
[g]
`(parser (join "\n" [~g common-grammar (keywords-for-locale)])))
(def parse-rule
(def parse
"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
"Parse the argument, assumed to be a string in the correct syntax, and return a parse tree."
(build-parser flow-grammar))
(defn- compile-rule
"Compile a rule function from this `parse-tree` derived from this `source`
at the zero-based line number `n` in the source file; return a compiled
function, whose metadata has the keys:
(defn parse
"Top level parser function: parse this `text` as either a production or a flow rule;
return a raw parse tree."
[^String rule-text]
(let [text (trim rule-text)]
(when-not (zero? (count text))
(case (first (split text #"\s+"))
"if" (parse-rule text)
"flow" (parse-flow text)
";;" nil
(throw (ex-info "Rule text was not recognised" {:text text}))))))
* `:rule-type` : the type of rule the function represents;
* `:parse` : this `parse-tree`;
* `:lisp` : the lisp source generated from this `parse-tree`;
* `:line : the one-based line number of the definition in the source file,
i.e. `(inc n)`."
[parse-tree source n]
(when-not (keyword? parse-tree)
(let [lisp (generate parse-tree)
line-no (inc n)]
(try
(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
"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.
the compiling environment.
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."
([rule-text return-tuple?]
(let [lines (map trim (remove comment? (split-lines rule-text)))]
(if (> (count lines) 1)
(map #(compile % return-tuple?) lines)
(let [src (first lines)
parse-tree (doall (simplify (parse src)))
fn' (doall (generate parse-tree))
afn (try
(if (#{'fn 'fn*} (first fn'))
(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)))
[rule-text]
(let [lines (split-lines rule-text)]
(remove
nil?
(map
compile-rule
(simplify (parse rule-text))
lines
(range (count lines))))))

2
src/mw_parser/errors.clj
View file

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

8
src/mw_parser/generate.clj
View file

@ -1,8 +1,7 @@
(ns ^{:doc "Generate Clojure source from simplified parse trees."
:author "Simon Brooke"}
mw-parser.generate
(:require [mw-parser.errors :as pe]
[mw-parser.utils :refer [assert-type search-tree TODO]]))
(:require [mw-parser.utils :refer [assert-type search-tree TODO]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@ -25,6 +24,9 @@
(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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; production (if-then) rules ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -152,7 +154,7 @@
(let [property (generate (second tree))
expression (generate (nth tree 3))]
(if (or (= property :x) (= property :y))
(throw (Exception. pe/reserved-properties-error))
(throw (Exception. reserved-properties-error))
(list 'merge
(if (empty? others) 'cell
;; else

19
src/mw_parser/simplify.clj
View file

@ -68,13 +68,32 @@
:ACTIONS (cons (first tree) (simplify (rest tree)))
:AND nil
:CHANCE-IN nil
:COMMENT nil
:COMPARATIVE (simplify-second-of-two tree)
:CONDITION (simplify-second-of-two tree)
:CONDITIONS (simplify-second-of-two tree)
:CR nil
:DISJUNCT-EXPRESSION (simplify-chained-list tree :DISJUNCT-VALUE :VALUE)
:EXPRESSION (simplify-second-of-two tree)
:FLOW-CONDITIONS (simplify-second-of-two tree)
: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-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
: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."
:author "Simon Brooke"}
mw-parser.utils
(:require [clojure.string :refer [trim]]
[mw-engine.utils :refer [member?]]))
mw-parser.utils)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@ -27,11 +25,6 @@
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn comment?
"Is this `line` a comment?"
[line]
(or (empty? (trim line)) (member? (first line) '(nil \# \;))))
(defn suitable-fragment?
"Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`."
[tree-fragment type]
@ -39,18 +32,11 @@
(keyword? 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
"Marker to indicate I'm not yet finished!"
[message]
message)
(defn assert-type
"If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception."
[tree-fragment type]
@ -59,7 +45,6 @@
{:actual tree-fragment
:expected type}))))
(defn search-tree
"Return the first element of this tree which has this tag in a depth-first, left-to-right search"
[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
(: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.utils :refer [get-cell]]
[mw-engine.world :refer [make-world]]
[mw-parser.declarative :refer [compile parse parse-rule]]
[mw-parser.utils :refer [rule?]]))
[mw-parser.declarative :refer [compile parse]]
[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
(testing "Rule parser - does not test whether generated functions actually work, just that something is generated!"
(is (rule? (parse-rule "if state is forest then state should be climax")))
(is (rule? (parse-rule "if state is in grassland or pasture or heath then state should be village")))
(is (rule? (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")))
(is (rule? (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3")))
(is (rule? (parse-rule "if altitude is 100 or fertility is 25 then state should be heath")))
(is (rule? (parse-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2")))
(is (rule? (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves")))
(is (rule? (parse-rule "if state is forest and fertility is between 55 and 75 then state should be climax")))
(is (rule? (parse-rule "if fertility is between 55 and 75 then state should be climax")))
(is (rule? (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")))))
(is (rule? (parse "if state is forest then state should be climax")))
(is (rule? (parse "if state is in grassland or pasture or heath then state should be village")))
(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 "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")))
(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 "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves")))
(is (rule? (parse "if state is forest and 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 "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")))))
(deftest neighbours-rules-tests
(testing "Rules which relate to neighbours - hard!"
(is (rule? (parse-rule "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire")))
(is (rule? (parse-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village")))
(is (rule? (parse-rule "if 6 neighbours have state equal to water then state should be village")))
(is (rule? (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village")))
(is (rule? (parse-rule "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub")))
(is (rule? (parse-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village")))
(is (rule? (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village")))
(is (rule? (parse-rule "if 6 neighbours have state equal to water then state should be village")))))
(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 "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 6 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 "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 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 grassland and 4 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
@ -39,20 +48,22 @@
(is (thrown-with-msg? Exception #"^I did not understand.*"
(parse "if i have a cat on my lap then everything is fine"))
"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?
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'")
(is (thrown-with-msg?
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'")))
(deftest correctness-tests
;; these are, in so far as possible, the same as the correctness-tests in core-tests - i.e., the two compilers
;; compile the same language.
(testing "Simplest possible rule"
(let [afn (compile "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))
{:state :grassland})
"Rule fires when condition is met")
@ -60,7 +71,7 @@
"Rule doesn't fire when condition isn't met")))
(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))
{:state :water :altitude 0})
"Rule fires when conditions are met")
@ -70,7 +81,7 @@
"Rule does not fire: first condition not met")))
(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))
{:state :grassland})
"Rule fires: first condition met")
@ -81,7 +92,7 @@
"Rule does not fire: neither condition met")))
(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)))
"Rule doesn't fire when condition isn't met")
(is (= (apply afn (list {:state :forest} nil))
@ -91,15 +102,15 @@
(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 "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'")
(is (thrown-with-msg?
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'"))
(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))
{:state :climax})
"Rule fires when condition is met")
@ -113,7 +124,7 @@
"Rule does not fire when condition is not met")))
(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)))
"Rule does not fire when condition is not met")
(is (nil? (apply afn (list {:state :scrub} nil)))
@ -125,7 +136,7 @@
"Rule fires when condition is met")))
(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))
{:state :snow :altitude 201})
"Rule fires when condition is met")
@ -133,7 +144,7 @@
"Rule does not fire when condition is not met")))
(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))
{:deer 0 :wolves 3})
"Rule fires when condition is met")
@ -141,7 +152,7 @@
"Rule does not fire when condition is not met")))
(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))
{:state :water :altitude 9})
"Rule fires when condition is met")
@ -149,7 +160,7 @@
"Rule does not fire when condition is not met")))
(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))
{:deer 1 :wolves 2})
"Rule fires when condition is met")
@ -157,14 +168,14 @@
"Rule does not fire when condition is not met")))
(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)]
(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 "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)]
;; 'are new' and 'is new' should be the same as 'have state equal to new'
(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)")
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"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)]
;; 'are new' and 'is new' should be the same as 'have state equal to new'
(is (= (apply afn (list {:x 0 :y 0} world))
@ -183,76 +194,80 @@
(testing "Number neighbours have property more than numeric-value"
;; 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
(make-world 3 3)
(list (compile "if x is 2 then altitude should be 11")
(compile "if x is less than 2 then altitude should be 0")))]
(compile (join "\n" ["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)
"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 "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
(make-world 3 3)
(list (compile "if x is 2 then altitude should be 11")
(compile "if x is less than 2 then altitude should be 0")))]
(compile (join "\n" ["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)
"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 "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
(make-world 3 3)
(list (compile "if x is 2 then altitude should be 11")
(compile "if x is less than 2 then altitude should be 0")))]
(compile (join "\n" ["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)
"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 "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
(make-world 3 3)
(list (compile "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")))]
(compile
(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)
"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 "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'.
world (transform-world
(make-world 3 3)
(list (compile "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")))]
(compile (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)
"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 "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
(make-world 3 3)
(list (compile "if x is 2 then altitude should be 11")
(compile "if x is less than 2 then altitude should be 0")))]
(compile (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)
"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 "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
(make-world 3 3)
(list (compile "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")))]
(compile
(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)
"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)))
@ -260,22 +275,26 @@
;; some neighbours have property equal to 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
(make-world 3 3)
(list (compile "if x is 2 then altitude should be 11")
(compile "if x is less than 2 then altitude should be 0")))]
(compile
(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)
"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 "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
(make-world 3 3)
(list (compile "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")))]
(compile
(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)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world)))
@ -283,11 +302,13 @@
;; more than number neighbours have property more than numeric-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
(make-world 3 3)
(list (compile "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")))]
(compile
(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)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world)))
@ -295,11 +316,13 @@
;; 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
(make-world 3 3)
(list (compile "if x is 2 then altitude should be 11")
(compile "if x is less than 2 then altitude should be 0")))]
(compile
(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)
"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)))
@ -307,11 +330,13 @@
;; 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
(make-world 3 3)
(list (compile "if x is 2 then altitude should be 11")
(compile "if x is less than 2 then altitude should be 0")))]
(compile
(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)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world)))
@ -319,11 +344,13 @@
;; 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
(make-world 3 3)
(list (compile "if x is 2 then altitude should be 11")
(compile "if x is less than 2 then altitude should be 0")))]
(compile
(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)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world)))
@ -331,11 +358,13 @@
;; 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
(make-world 3 3)
(list (compile "if x is 2 then altitude should be 11")
(compile "if x is less than 2 then altitude should be 0")))]
(compile
(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)))
"Centre cell has five low neighbours, so rule should not fire")
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
@ -343,11 +372,13 @@
;; some 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
(make-world 3 3)
(list (compile "if x is less than 2 then altitude should be 11")
(compile "if x is 2 then altitude should be 0")))]
(compile
(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)
"Rule fires when condition is met (strip of altitude 0 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world)))
@ -357,7 +388,7 @@
;; 'single action' already tested in 'condition' tests above
;; action and 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))
{:state :grassland :fertility 0})
"Both actions are executed")))
@ -367,23 +398,23 @@
;; number chance in number property should be value
(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)
"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)))
"zero chance in five should never fire")))
;; property operator numeric-value
(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
(apply afn (list {:state :climax :fertility 0} nil)))
1)
"Addition is executed")))
(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
(apply afn
(list {:state :climax
@ -393,14 +424,14 @@
"Addition is executed")))
(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
(apply afn (list {:state :crop :fertility 2} nil)))
1)
"Action is executed")))
(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
(apply afn
(list {:deer 3
@ -409,14 +440,14 @@
"Action is executed")))
(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
(apply afn (list {:deer 2} nil)))
4)
"Action is executed")))
(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
(apply afn
(list {:state :crop :deer 2} nil)))
@ -424,14 +455,14 @@
"Action is executed")))
(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
(apply afn (list {:deer 2 :wolves 1} nil)))
1)
"Action is executed")))
(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
(apply afn
(list {:deer 2 :wolves 2} nil)))
@ -440,7 +471,7 @@
;; simple within distance
(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)]
(is (= (apply afn (list {:x 0 :y 0} world))
{:state :water :x 0 :y 0})
@ -450,7 +481,7 @@
;; comparator within distance
(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
;; xxooo
;; xxooo
@ -459,8 +490,10 @@
;; xxooo
world (transform-world
(make-world 5 5)
(list (compile "if x is less than 2 then altitude should be 11 and state should be grassland")
(compile "if x is more than 1 then altitude should be 0 and state should be water")))]
(compile
(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)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world)))
@ -468,11 +501,13 @@
(deftest regression-tests
(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
(make-world 3 3)
(list (compile "if x is 2 then altitude should be 11")
(compile "if x is less than 2 then state should be scrub")))]
(compile
(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)
"Centre cell is scrub, so rule should fire")
(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.simplify :refer [simplify]]))
(deftest parse-flow-tests
(deftest parse-tests
(testing "flow-grammar"
(let [rule "flow 1 food from house having food more than 10 to house within 2 with least food"
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}]
[{: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}]]
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}
cell' (reduce
(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
(: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.utils :refer [search-tree]]))
@ -81,7 +81,7 @@
(:SYMBOL "scrub")
(:DISJUNCT-VALUE (:SYMBOL "forest")))))
parse-tree (search-tree
(parse-rule
(parse
"if state is not in heath or scrub or forest then state should be climax")
:DISJUNCT-EXPRESSION)
actual (simplify parse-tree)]
@ -91,7 +91,7 @@
(:SYMBOL "scrub")
(:SYMBOL "forest"))
parse-tree (search-tree
(parse-rule
(parse
"if state is not in heath or scrub or forest then state should be climax")
:DISJUNCT-EXPRESSION)
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")))))