diff --git a/project.clj b/project.clj index d48db45..9463073 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-parser "0.1.5-SNAPSHOT" +(defproject mw-parser "3.0.0-SNAPSHOT" :description "Parser for production rules for MicroWorld engine" :url "http://www.journeyman.cc/microworld" :manifest { @@ -8,11 +8,12 @@ "build-signature-timestamp" "unset" "Implementation-Version" "unset" } + :source-paths ["src/clj" "src/cljc"] :license {:name "GNU General Public License v2" :url "http://www.gnu.org/licenses/gpl-2.0.html"} :plugins [[lein-marginalia "0.7.1"]] - :dependencies [[org.clojure/clojure "1.6.0"] + :dependencies [[org.clojure/clojure "1.8.0"] [org.clojure/tools.trace "0.7.9"] - [instaparse "1.4.1"] - [mw-engine "0.1.5-SNAPSHOT"] + [com.lucasbradstreet/instaparse-cljs "1.4.1.2"] + [mw-engine "3.0.0-SNAPSHOT"] ]) diff --git a/resources/rules.txt b/resources/rules.txt index 0356227..d7f2d5f 100644 --- a/resources/rules.txt +++ b/resources/rules.txt @@ -6,19 +6,19 @@ ## Vegetation rules ;; rules which populate the world with plants -;; Occasionally, passing birds plant tree seeds into grassland +;; Occasionally, passing birds plant tree seeds into grassland if state is grassland then 1 chance in 10 state should be heath ;; heath below the treeline grows gradually into forest -if state is heath and altitude is less than 120 then state should be scrub +if state is heath and altitude is less than 120 then state should be scrub if state is scrub then 1 chance in 5 state should be forest ;; Forest on fertile land grows to climax -if state is forest and fertility is more than 5 and altitude is less than 70 then state should be climax - +if state is forest and fertility is more than 5 and altitude is less than 70 then state should be climax + ;; Climax forest occasionally catches fire (e.g. lightning strikes) if state is climax then 1 chance in 500 state should be fire @@ -40,7 +40,7 @@ if state is waste then state should be grassland ## Potential blockers -;; Forest increases soil fertility. +;; Forest increases soil fertility. if state is in forest or climax then fertility should be fertility + 1 diff --git a/src/cljc/microworld/parser/bulk.cljc b/src/cljc/microworld/parser/bulk.cljc new file mode 100644 index 0000000..e9efd2e --- /dev/null +++ b/src/cljc/microworld/parser/bulk.cljc @@ -0,0 +1,62 @@ +(ns ^{:doc "parse multiple rules from a stream, possibly a file." + :author "Simon Brooke"} + microworld.parser.bulk + (:use microworld.parser.declarative + microworld.engine.utils + clojure.java.io + [clojure.string :only [split trim]]) + (:import (java.io BufferedReader StringReader))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; microworld.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 comment? + "Is this `line` a comment?" + [line] + (or (empty? (trim line)) (member? (first line) '(nil \# \;)))) + +(defn parse-string + "Parse rules from successive lines in this `string`, assumed to have multiple + lines delimited by the new-line character. Return a list of S-expressions." + [string] + ;; TODO: tried to do this using with-open, but couldn't make it work. + (map #(parse-rule (trim %)) (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-string + "Compile each non-comment line of this `string` into an executable anonymous + function, and return the sequence of such functions." + [string] + (map #(compile-rule % true) (remove comment? (split string #"\n")))) + +(defn compile-file + "Compile each non-comment line of the file indicated by this `filename` into + an executable anonymous function, and return the sequence of such functions." + [filename] + (compile-string (slurp filename))) diff --git a/src/mw_parser/core.clj b/src/cljc/microworld/parser/core.cljc similarity index 76% rename from src/mw_parser/core.clj rename to src/cljc/microworld/parser/core.cljc index aafd595..746a4f1 100644 --- a/src/mw_parser/core.clj +++ b/src/cljc/microworld/parser/core.cljc @@ -1,45 +1,72 @@ -;; 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 is the parser that is actually used currently; but see also insta.clj, -;; which is potentially a much better parser but does not quite work yet. - -(ns mw-parser.core - (:use mw-engine.utils +(ns ^{:doc "A very simple parser which parses production rules." + :author "Simon Brooke"} + microworld.parser.core + (:use microworld.engine.utils [clojure.string :only [split trim triml]]) (:gen-class) ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; microworld.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 `microworld.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 numbers +;; 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 +(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'") @@ -48,12 +75,12 @@ "If this token appears to represent an explicit number, return that number; otherwise, make a keyword of it and return that." [token] - (cond + (cond (re-matches re-number token) (read-string token) (keyword? token) token true (keyword token))) -;; Generally all functions in this file with names beginning 'parse-' take a +;; Generally all functions in this file with names beginning 'parse-' take a ;; sequence of tokens (and in some cases other optional arguments) and return a ;; vector comprising ;; @@ -70,7 +97,7 @@ (if (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, + "Parse a token assumed to be the name of a property of the current cell, whose value is assumed to be an integer." [[value & remainder]] (if value [(list 'get-int 'cell (keyword value)) remainder])) @@ -115,12 +142,12 @@ [(cons value others) remainder]) true [(list value) tokens])))) - -(defn parse-value + +(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 + (or (parse-disjunct-value tokens expect-int) (parse-simple-value tokens expect-int))) ([tokens] @@ -158,18 +185,18 @@ (list '> value1 property value2)) rest]))) (defn- parse-is-condition - "Parse clauses of the form 'x is y', 'x is in y or z...', + "Parse clauses of the form 'x is y', 'x is in y or z...', 'x is between y and z', 'x is more than y' or 'x is less than y'. It is necessary to disambiguate whether value is a numeric or keyword." [[property IS value & rest]] - (cond + (cond (member? IS '("is" "are")) (let [tokens (cons property (cons value rest))] - (cond + (cond (re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest] value [(list '= (list (keyword property) 'cell) (keyword value)) rest])))) -(defn- parse-not-condition +(defn- parse-not-condition "Parse the negation of a simple condition." [[property IS NOT & rest]] (cond (and (member? IS '("is" "are")) (= NOT "not")) @@ -179,11 +206,11 @@ [(list 'not condition) remainder]))))) (defn- gen-neighbours-condition - ([comp1 quantity property value remainder comp2 distance] - [(list comp1 + ([comp1 quantity property value remainder comp2 distance] + [(list comp1 (list 'count - (list 'get-neighbours-with-property-value 'world - '(cell :x) '(cell :y) distance + (list 'get-neighbours-with-property-value 'world + '(cell :x) '(cell :y) distance (keyword property) (keyword-or-numeric value) comp2)) quantity) remainder]) @@ -195,21 +222,21 @@ [[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]] (let [quantity (first (parse-numeric-value (list n))) comparator (cond (= MORE "more") '> - (member? MORE '("fewer" "less")) '<)] + (member? MORE '("fewer" "less")) '<)] (cond (not= WITHIN "within") - (parse-comparator-neighbours-condition - (flatten + (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 + (and quantity comparator (= THAN "than") (= NEIGHBOURS "neighbours")) (cond - (= have-or-are "are") + (= have-or-are "are") (let [[value & remainder] rest dist (gen-token-value distance true)] (gen-neighbours-condition comparator quantity :state value remainder = dist)) @@ -217,16 +244,16 @@ (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 + (gen-neighbours-condition comparator quantity property value remainder = dist) (and (= comp1 "more") (= comp2 "than")) - (gen-neighbours-condition comparator quantity property + (gen-neighbours-condition comparator quantity property value remainder > dist) (and (= comp1 "less") (= comp2 "than")) - (gen-neighbours-condition comparator quantity property + (gen-neighbours-condition comparator quantity property value remainder < dist) )))))) - + (defn parse-some-neighbours-condition [[SOME NEIGHBOURS & rest]] (cond @@ -236,18 +263,18 @@ (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)))] + (let [quantity (first (parse-numeric-value (list n)))] (cond (and quantity (= NEIGHBOURS "neighbours")) (cond (not= WITHIN "within") (parse-simple-neighbours-condition - (flatten + (flatten ;; two tokens were mis-parsed as 'within distance' that weren't ;; actually 'within' and a distance. Splice in 'within 1' and try ;; again. (list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest))) - (= have-or-are "are") + (= have-or-are "are") (let [[value & remainder] rest dist (gen-token-value distance true)] (gen-neighbours-condition '= quantity :state value remainder = dist)) @@ -255,16 +282,16 @@ (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 = + (gen-neighbours-condition '= quantity property value remainder = dist) (and (= comp1 "more") (= comp2 "than")) - (gen-neighbours-condition '= quantity property value remainder > + (gen-neighbours-condition '= quantity property value remainder > dist) (and (= comp1 "less") (= comp2 "than")) - (gen-neighbours-condition '= quantity property value remainder < + (gen-neighbours-condition '= quantity property value remainder < dist) )))))) - + (defn parse-neighbours-condition "Parse conditions referring to neighbours" [tokens] @@ -320,30 +347,30 @@ (= IF "if") (parse-conditions tokens))) -(defn- parse-arithmetic-action +(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 + (throw (Exception. reserved-properties-error)) (and (= SHOULD "should") (= BE "be") (member? operator '("+" "-" "*" "/"))) [(list 'merge (or previous 'cell) - {(keyword prop1) (list 'int + {(keyword prop1) (list 'int (list (symbol operator) (list 'get-int 'cell (keyword prop2)) (cond (re-matches re-number value) (read-string value) true (list 'get-int 'cell (keyword value)))))}) rest])) -(defn- parse-set-action +(defn- parse-set-action "Parse actions of the form '[property] should be [value].'" [previous [property SHOULD BE value & rest]] - (cond + (cond (member? property '("x" "y")) - (throw + (throw (Exception. reserved-properties-error)) (and (= SHOULD "should") (= BE "be")) [(list 'merge (or previous 'cell) @@ -362,19 +389,19 @@ (parse-actions left (rest remainder)) true (list left))))) -(defn- parse-probability +(defn- parse-probability "Parse a probability of an action from this collection of tokens" [previous [n CHANCE IN m & tokens]] - (cond + (cond (and (= CHANCE "chance")(= IN "in")) (let [[action remainder] (parse-actions previous tokens)] (cond action - [(list 'cond - (list '< - (list 'rand + [(list 'cond + (list '< + (list 'rand (first (parse-simple-value (list m) true))) - (first (parse-simple-value (list n) true))) - action) remainder])))) + (first (parse-simple-value (list n) true))) + action) remainder])))) (defn- parse-right-hand-side "Parse the right hand side ('then...') of a production rule." @@ -384,30 +411,30 @@ (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 +(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] (cond - (string? line) + (string? line) (let [rule (parse-rule (split (triml line) #"\s+"))] (cond rule rule true (throw (Exception. (format bad-parse-error line))))) - true + true (let [[left remainder] (parse-left-hand-side line) [right junk] (parse-right-hand-side remainder)] - (cond + (cond ;; 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 +(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 + function object, getting round the problem of binding microworld.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. @@ -415,9 +442,9 @@ Throws an exception if parsing fails." ([rule-text return-tuple?] (do - (use 'mw-engine.utils) + (use 'microworld.engine.utils) (let [afn (eval (parse-rule rule-text))] - (cond + (cond (and afn return-tuple?)(list afn (trim rule-text)) true afn)))) ([rule-text] diff --git a/src/cljc/microworld/parser/declarative.cljc b/src/cljc/microworld/parser/declarative.cljc new file mode 100644 index 0000000..f084716 --- /dev/null +++ b/src/cljc/microworld/parser/declarative.cljc @@ -0,0 +1,119 @@ +(ns ^{:doc "A very simple parser which parses production rules." + :author "Simon Brooke"} + microworld.parser.declarative + (:require [instaparse.core :as insta] + [clojure.string :refer [split trim triml]] + [microworld.parser.errors :as pe] + [microworld.parser.generate :as pg] + [microworld.parser.simplify :as ps] + [microworld.parser.utils :refer [rule?]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; microworld.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 +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(def grammar + ;; in order to simplify translation into other natural languages, all + ;; TOKENS within the parser should be unambiguous + "RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS; + CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | CONDITION ; + DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS; + CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS; + CONDITION := WITHIN-CONDITION | NEIGHBOURS-CONDITION | PROPERTY-CONDITION; + WITHIN-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE WITHIN SPACE NUMBER SPACE IS SPACE PROPERTY-CONDITION-OR-EXPRESSION; + NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUALIFIER SPACE NEIGHBOURS-CONDITION; + PROPERTY-CONDITION-OR-EXPRESSION := PROPERTY-CONDITION | EXPRESSION; + PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION | VALUE; + EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE; + SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE; + DISJUNCT-EXPRESSION := IN SPACE DISJUNCT-VALUE; + RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION; + NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION; + NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER; + COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN | COMPARATIVE SPACE THAN; + QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER; + QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER; + EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ; + COMPARATIVE := MORE | LESS; + DISJUNCT-VALUE := VALUE | VALUE SPACE OR SPACE DISJUNCT-VALUE; + IF := 'if'; + THEN := 'then'; + THAN := 'than'; + OR := 'or'; + NOT := 'not'; + AND := 'and'; + SOME := 'some'; + NONE := 'no'; + ALL := 'all' + BETWEEN := 'between'; + WITHIN := 'within'; + IN := 'in'; + MORE := 'more' | 'greater'; + LESS := 'less' | 'fewer'; + OPERATOR := '+' | '-' | '*' | '/'; + NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors'; + PROPERTY := SYMBOL; + VALUE := SYMBOL | NUMBER; + EQUAL := 'equal to'; + IS := 'is' | 'are' | 'have' | 'has'; + NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+'; + SYMBOL := #'[a-z]+'; + ACTIONS := ACTION | ACTION SPACE AND SPACE ACTIONS + ACTION := SIMPLE-ACTION | PROBABLE-ACTION; + PROBABLE-ACTION := VALUE SPACE CHANCE-IN SPACE VALUE SPACE SIMPLE-ACTION; + SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION; + CHANCE-IN := 'chance in'; + BECOMES := 'should be' | 'becomes'; + SPACE := #' *'"; + ) + + +(def parse-rule + "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree." + (insta/parser grammar)) + + +(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 microworld.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?] + (assert (string? rule-text)) + (let [rule (trim rule-text) + tree (ps/simplify (parse-rule rule)) + clj (pg/generate tree) + afn (if (rule? tree) (eval clj) + ;; else + (pe/throw-parse-exception tree))] + (if return-tuple? + (list afn {:rule rule :clojure (print-str clj)}) + ;; else + afn))) + ([rule-text] + (compile-rule rule-text false))) + diff --git a/src/cljc/microworld/parser/errors.cljc b/src/cljc/microworld/parser/errors.cljc new file mode 100644 index 0000000..55bc354 --- /dev/null +++ b/src/cljc/microworld/parser/errors.cljc @@ -0,0 +1,68 @@ +(ns ^{:doc "Display parse errors in a format which makes it easy for the user + to see where the error occurred." + :author "Simon Brooke"} + microworld.parser.errors) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; 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. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;; error thrown when an attempt is made to set a reserved property +(def reserved-properties-error + "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions") +;; error thrown when a rule cannot be parsed. Slots are for +;; (1) rule text +;; (2) cursor showing where in the rule text the error occurred +;; (3) the reason for the error +(def bad-parse-error "I did not understand:\n '%s'\n %s\n %s") + + +(defn- explain-parse-error-reason + "Attempt to explain the reason for the parse error." + [reason] + (str "Expecting one of (" (apply str (map #(str (:expecting %) " ") reason)) ")")) + + +(defn- parser-error-to-map + [parser-error] + (let [m (reduce (fn [map item](merge map {(first item)(second item)})) {} parser-error) + reason (map + #(reduce (fn [map item] (merge {(first item) (second item)} map)) {} %) + (:reason m))] + (merge m {:reason reason}))) + + +(defn throw-parse-exception + "Construct a helpful error message from this `parser-error`, and throw an exception with that message." + [parser-error] + (assert (coll? parser-error) "Expected a paser error structure?") + (let + [ + ;; the error structure is a list, such that each element is a list of two items, and + ;; the first element in each sublist is a keyword. Easier to work with it as a map + error-map (parser-error-to-map parser-error) + text (:text error-map) + reason (explain-parse-error-reason (:reason error-map)) + ;; rules have only one line, by definition; we're interested in the column + column (if (:column error-map)(:column error-map) 0) + ;; create a cursor to point to that column + cursor (apply str (reverse (conj (repeat column " ") "^"))) + message (format bad-parse-error text cursor reason) + ] + (throw (Exception. message)))) diff --git a/src/cljc/microworld/parser/generate.cljc b/src/cljc/microworld/parser/generate.cljc new file mode 100644 index 0000000..e7a9e5f --- /dev/null +++ b/src/cljc/microworld/parser/generate.cljc @@ -0,0 +1,316 @@ +(ns ^{:doc "Generate Clojure source from simplified parse trees." + :author "Simon Brooke"} + microworld.parser.generate + (:require [microworld.engine.utils :refer []] + [microworld.parser.utils :refer [assert-type TODO]] + [microworld.parser.errors :as pe])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; 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. +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(declare generate generate-action) + + +(defn generate-rule + "From this `tree`, assumed to be a syntactically correct rule specification, + generate and return the appropriate rule as a function of two arguments." + [tree] + (assert-type tree :RULE) + (list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3))))) + + +(defn generate-conditions + "From this `tree`, assumed to be a syntactically correct conditions clause, + generate and return the appropriate clojure fragment." + [tree] + (assert-type tree :CONDITIONS) + (generate (second tree))) + + +(defn generate-condition + "From this `tree`, assumed to be a syntactically correct condition clause, + generate and return the appropriate clojure fragment." + [tree] + (assert-type tree :CONDITION) + (generate (second tree))) + + +(defn generate-conjunct-condition + [tree] + "From this `tree`, assumed to be a syntactically conjunct correct condition clause, + generate and return the appropriate clojure fragment." + (assert-type tree :CONJUNCT-CONDITION) + (cons 'and (map generate (rest tree)))) + + +(defn generate-disjunct-condition + "From this `tree`, assumed to be a syntactically correct disjunct condition clause, + generate and return the appropriate clojure fragment." + [tree] + (assert-type tree :DISJUNCT-CONDITION) + (cons 'or (map generate (rest tree)))) + + +(defn generate-ranged-property-condition + "From this `tree`, assumed to be a syntactically property condition clause for + this `property` where the `expression` is a numeric range, generate and return + the appropriate clojure fragment." + [tree property expression] + (assert-type tree :PROPERTY-CONDITION) + (assert-type (nth tree 3) :RANGE-EXPRESSION) + (let [l1 (generate (nth expression 2)) + l2 (generate (nth expression 4)) + pv (list property 'cell)] + (list 'let ['lower (list 'min l1 l2) + 'upper (list 'max l1 l2)] + (list 'and (list '>= pv 'lower)(list '<= pv 'upper))))) + + +(defn generate-disjunct-property-condition + "From this `tree`, assumed to be a syntactically property condition clause + where the expression is a a disjunction, generate and return + the appropriate clojure fragment. + TODO: this is definitely still wrong!" + ([tree] + (let [property (generate (second tree)) + qualifier (generate (nth tree 2)) + expression (generate (nth tree 3))] + (generate-disjunct-property-condition tree property qualifier expression))) + ([tree property qualifier expression] + (let [e (list 'some (list 'fn ['i] '(= i value)) (list 'quote expression))] + (list 'let ['value (list property 'cell)] + (if (= qualifier '=) e + (list 'not e)))))) + + +(defn generate-property-condition + "From this `tree`, assumed to be a syntactically property condition clause, + generate and return the appropriate clojure fragment." + ([tree] + (assert-type tree :PROPERTY-CONDITION) + (if + (and (= (count tree) 2) (= (first (second tree)) :SYMBOL)) + ;; it's a shorthand for 'state equal to symbol'. This should probably have + ;; been handled in simplify... + (generate-property-condition + (list + :PROPERTY-CONDITION + '(:SYMBOL "state") + '(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to"))) + (second tree))) + ;; otherwise... + (generate-property-condition tree (first (nth tree 3))))) + ([tree expression-type] + (assert-type tree :PROPERTY-CONDITION) + (let [property (generate (second tree)) + qualifier (generate (nth tree 2)) + e (generate (nth tree 3)) + expression (cond + (and (not (= qualifier '=)) (keyword? e)) (list 'or (list e 'cell) e) + (and (not (= qualifier 'not=)) (keyword? e)) (list 'or (list e 'cell) e) + :else e)] + (case expression-type + :DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression) + :RANGE-EXPRESSION (generate-ranged-property-condition tree property expression) + (list qualifier (list property 'cell) expression))))) + + +(defn generate-qualifier + "From this `tree`, assumed to be a syntactically correct qualifier, + generate and return the appropriate clojure fragment." + [tree] + (if + (= (count tree) 2) + (generate (second tree)) + ;; else + (generate (nth tree 2)))) + + +(defn generate-simple-action + "From this `tree`, assumed to be a syntactically correct simple action, + generate and return the appropriate clojure fragment." + ([tree] + (assert-type tree :SIMPLE-ACTION) + (generate-simple-action tree [])) + ([tree others] + (assert-type tree :SIMPLE-ACTION) + (let [property (generate (second tree)) + expression (generate (nth tree 3))] + (if (or (= property :x) (= property :y)) + (throw (Exception. pe/reserved-properties-error)) + (list 'merge + (if (empty? others) 'cell + ;; else + (generate others)) + {property expression}))))) + + +(defn generate-probable-action + "From this `tree`, assumed to be a syntactically correct probable action, + generate and return the appropriate clojure fragment." + ([tree] + (assert-type tree :PROBABLE-ACTION) + (generate-probable-action tree [])) + ([tree others] + (assert-type tree :PROBABLE-ACTION) + (let + [chances (generate (nth tree 1)) + total (generate (nth tree 2)) + action (generate-action (nth tree 3) others)] + ;; TODO: could almost certainly be done better with macro syntax + (list 'if + (list '< (list 'rand total) chances) + action)))) + + +(defn generate-action + "From this `tree`, assumed to be a syntactically correct action, + generate and return the appropriate clojure fragment." + [tree others] + (case (first tree) + :ACTIONS (generate-action (first tree) others) + :SIMPLE-ACTION (generate-simple-action tree others) + :PROBABLE-ACTION (generate-probable-action tree others) + (throw (Exception. (str "Not a known action type: " (first tree)))))) + + +(defn generate-multiple-actions + "From this `tree`, assumed to be one or more syntactically correct actions, + generate and return the appropriate clojure fragment." + [tree] + (assert-type tree :ACTIONS) + (generate-action (first (rest tree)) (second (rest tree)))) + +(defn generate-disjunct-value + "Generate a disjunct value. Essentially what we need here is to generate a + flat list of values, since the `member` has already been taken care of." + [tree] + (assert-type tree :DISJUNCT-VALUE) + (if (= (count tree) 4) + (cons (generate (second tree)) (generate (nth tree 3))) + (list (generate (second tree))))) + + +(defn generate-numeric-expression + "From this `tree`, assumed to be a syntactically correct numeric expression, + generate and return the appropriate clojure fragment." + [tree] + (assert-type tree :NUMERIC-EXPRESSION) + (case (count tree) + 4 (let [[p operator expression] (rest tree) + property (if (number? p) p (list p 'cell))] + (list (generate operator) (generate property) (generate expression))) + (case (first (second tree)) + :SYMBOL (list (keyword (second (second tree))) 'cell) + (generate (second tree))))) + + +(defn generate-neighbours-condition + "Generate code for a condition which refers to neighbours." + ([tree] + (assert-type tree :NEIGHBOURS-CONDITION) + (case (first (second tree)) + :NUMBER (read-string (second (second tree))) + :QUANTIFIER (generate-neighbours-condition tree (first (second (second tree)))) + :QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2)))))) + ([tree quantifier-type] + (let [quantifier (second tree) + pc (generate (nth tree 4))] + (case quantifier-type + :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc 1) + :SOME (generate-neighbours-condition '> 0 pc 1) + :MORE (let [value (generate (nth quantifier 3))] + (generate-neighbours-condition '> value pc 1)) + :LESS (let [value (generate (nth quantifier 3))] + (generate-neighbours-condition '< value pc 1)) + ))) + ([comp1 quantity property-condition distance] + (list comp1 + (list 'count + (list 'remove 'false? + (list 'map (list 'fn ['cell] property-condition) + (list 'microworld.engine.utils/get-neighbours 'world 'cell distance)))) quantity)) + ([comp1 quantity property-condition] + (generate-neighbours-condition comp1 quantity property-condition 1))) + + +(defn generate-within-condition + "Generate code for a condition which refers to neighbours within a specified distance. + NOTE THAT there's clearly masses of commonality between this and + `generate-neighbours-condition`, and that some refactoring is almost certainly + desirable. It may be that it's better to simplify a `NEIGHBOURS-CONDITION` + into a `WITHIN-CONDITION` in the simplification stage." + ([tree] + (assert-type tree :WITHIN-CONDITION) + (case (first (second tree)) + :QUANTIFIER (generate-within-condition tree (first (second (second tree)))) + :QUALIFIER (TODO "qualified within... help!"))) + ([tree quantifier-type] + (let [quantifier (second tree) + distance (generate (nth tree 4)) + pc (generate (nth tree 6))] + (case quantifier-type + :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc distance) + :SOME (generate-neighbours-condition '> 0 pc distance) + :MORE (let [value (generate (nth quantifier 3))] + (generate-neighbours-condition '> value pc distance)) + :LESS (let [value (generate (nth quantifier 3))] + (generate-neighbours-condition '< value pc distance)) + )))) + + +(defn generate + "Generate code for this (fragment of a) parse tree" + [tree] + (if + (coll? tree) + (case (first tree) + :ACTIONS (generate-multiple-actions tree) + :COMPARATIVE (generate (second tree)) + :COMPARATIVE-QUALIFIER (generate (second tree)) + :CONDITION (generate-condition tree) + :CONDITIONS (generate-conditions tree) + :CONJUNCT-CONDITION (generate-conjunct-condition tree) + :DISJUNCT-CONDITION (generate-disjunct-condition tree) + :DISJUNCT-EXPRESSION (generate (nth tree 2)) + :DISJUNCT-VALUE (generate-disjunct-value tree) + :EQUIVALENCE '= + :EXPRESSION (generate (second tree)) + :LESS '< + :MORE '> + :NEGATED-QUALIFIER (case (generate (second tree)) + = 'not= + > '< + < '>) + :NEIGHBOURS-CONDITION (generate-neighbours-condition tree) + :NUMERIC-EXPRESSION (generate-numeric-expression tree) + :NUMBER (read-string (second tree)) + :OPERATOR (symbol (second tree)) + :PROBABLE-ACTION (generate-probable-action tree) + :PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right + :PROPERTY-CONDITION (generate-property-condition tree) + :QUALIFIER (generate-qualifier tree) + :RULE (generate-rule tree) + :SIMPLE-ACTION (generate-simple-action tree) + :SYMBOL (keyword (second tree)) + :VALUE (generate (second tree)) + :WITHIN-CONDITION (generate-within-condition tree) + (map generate tree)) + tree)) diff --git a/src/cljc/microworld/parser/simplify.cljc b/src/cljc/microworld/parser/simplify.cljc new file mode 100644 index 0000000..1e32c61 --- /dev/null +++ b/src/cljc/microworld/parser/simplify.cljc @@ -0,0 +1,81 @@ +(ns ^{:doc "Simplify a parse tree." + :author "Simon Brooke"} + microworld.parser.simplify + (:require [microworld.engine.utils :refer [member?]])) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; microworld.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 +;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +(declare simplify) + +(defn simplify-qualifier + "Given that this `tree` fragment represents a qualifier, what + qualifier is that?" + [tree] + (cond + (empty? tree) nil + (and (coll? tree) + (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree + (coll? (first tree)) (or (simplify-qualifier (first tree)) + (simplify-qualifier (rest tree))) + (coll? tree) (simplify-qualifier (rest tree)) + true tree)) + +(defn simplify-second-of-two + "There are a number of possible simplifications such that if the `tree` has + only two elements, the second is semantically sufficient." + [tree] + (if (= (count tree) 2) (simplify (nth tree 1)) tree)) + + +(defn simplify-quantifier + "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' + and whose quantity is that number. This is actually more complicated but makes generation easier." + [tree] + (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify (second tree)))) + + +(defn simplify + "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with + semantically identical simpler fragments" + [tree] + (if + (coll? tree) + (case (first tree) + :ACTION (simplify-second-of-two tree) + :ACTIONS (cons (first tree) (simplify (rest tree))) + :CHANCE-IN nil + :COMPARATIVE (simplify-second-of-two tree) + :CONDITION (simplify-second-of-two tree) + :CONDITIONS (simplify-second-of-two tree) + :EXPRESSION (simplify-second-of-two tree) + :PROPERTY (simplify-second-of-two tree) + :PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree) + :SPACE nil + :THEN nil + :AND nil + :VALUE (simplify-second-of-two tree) + (remove nil? (map simplify tree))) + tree)) + diff --git a/src/cljc/microworld/parser/utils.cljc b/src/cljc/microworld/parser/utils.cljc new file mode 100644 index 0000000..9390b18 --- /dev/null +++ b/src/cljc/microworld/parser/utils.cljc @@ -0,0 +1,64 @@ +(ns ^{:doc "Utilities used in more than one namespace within the parser." + :author "Simon Brooke"} + microworld.parser.utils) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; +;;;; microworld.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 rule? + "Return true if the argument appears to be a parsed rule tree, else false." + [maybe-rule] + (and (coll? maybe-rule) (= (first maybe-rule) :RULE))) + + +(defn TODO + "Marker to indicate I'm not yet finished!" + [message] + message) + + +(defn suitable-fragment? + "Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`." + [tree-fragment type] + (and (coll? tree-fragment) + (= (first tree-fragment) type))) + + +(defn assert-type + "If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception." + [tree-fragment type] + (assert (suitable-fragment? tree-fragment type) + (throw (Exception. (format "Expected a %s fragment" type))))) + + +(defn search-tree + "Return the first element of this tree which has this tag in a depth-first, left-to-right search" + [tree tag] + (cond + (= (first tree) tag) tree + :else (first + (remove nil? + (map + #(search-tree % tag) + (rest tree)))))) diff --git a/src/mw_parser/bulk.clj b/src/mw_parser/bulk.clj deleted file mode 100644 index b4674ec..0000000 --- a/src/mw_parser/bulk.clj +++ /dev/null @@ -1,39 +0,0 @@ -;; parse multiple rules from a stream, possibly a file - although the real -;; objective is to parse rules out of a block of text from a textarea - -(ns mw-parser.bulk - (:use mw-parser.core - mw-engine.utils - clojure.java.io - [clojure.string :only [split trim]]) - (:import (java.io BufferedReader StringReader))) - -(defn comment? - "Is this `line` a comment?" - [line] - (or (empty? (trim line)) (member? (first line) '(nil \# \;)))) - -(defn parse-string - "Parse rules from successive lines in this `string`, assumed to have multiple - lines delimited by the new-line character. Return a list of S-expressions." - [string] - ;; TODO: tried to do this using with-open, but couldn't make it work. - (map parse-rule (remove comment? (split string #"\n")))) - -(defn parse-file - "Parse rules from successive lines in the file loaded from this `filename`. - Return a list of S-expressions." - [filename] - (parse-string (slurp filename))) - -(defn compile-string - "Compile each non-comment line of this `string` into an executable anonymous - function, and return the sequence of such functions." - [string] - (map #(compile-rule % true) (remove comment? (split string #"\n")))) - -(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-string (slurp filename))) diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj deleted file mode 100644 index 8bea7dd..0000000 --- a/src/mw_parser/declarative.clj +++ /dev/null @@ -1,368 +0,0 @@ -(ns mw-parser.declarative - (:use mw-engine.utils - [clojure.string :only [split trim triml]]) - (:require [instaparse.core :as insta])) - - -;; error thrown when an attempt is made to set a reserved property -(def reserved-properties-error - "The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions") -;; error thrown when a rule cannot be parsed. Slots are for -;; (1) rule text -;; (2) cursor showing where in the rule text the error occurred -;; (3) the reason for the error -(def bad-parse-error "I did not understand:\n'%s'\n%s\n%s") - - -(def grammar - ;; in order to simplify translation into other natural languages, all - ;; TOKENS within the parser should be unambiguous - "RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS; - CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | PROPERTY-CONDITION | NEIGHBOURS-CONDITION ; - DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS; - CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS; - CONDITION := NEIGHBOURS-CONDITION | PROPERTY-CONDITION; - WITHIN-CONDITION := NEIGHBOURS-CONDITION SPACE WITHIN SPACE NUMERIC-EXPRESSION; - NEIGHBOURS-CONDITION := WITHIN-CONDITION | QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUANTIFIER SPACE NEIGHBOURS IS EXPRESSION | QUALIFIER SPACE NEIGHBOURS-CONDITION; - PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION | VALUE; - EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE; - SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE; - DISJUNCT-EXPRESSION := IN SPACE DISJUNCT-VALUE; - RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION; - NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION; - NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER; - COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN; - QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER; - QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER; - EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ; - COMPARATIVE := MORE | LESS; - DISJUNCT-VALUE := VALUE | VALUE SPACE OR SPACE DISJUNCT-VALUE; - IF := 'if'; - THEN := 'then'; - THAN := 'than'; - OR := 'or'; - NOT := 'not'; - AND := 'and'; - SOME := 'some'; - NONE := 'no'; - ALL := 'all' - BETWEEN := 'between'; - WITHIN := 'within'; - IN := 'in'; - MORE := 'more' | 'greater'; - LESS := 'less' | 'fewer'; - OPERATOR := '+' | '-' | '*' | '/'; - NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors'; - PROPERTY := SYMBOL; - VALUE := SYMBOL | NUMBER; - EQUAL := 'equal to'; - IS := 'is' | 'are' | 'have' | 'has'; - NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+'; - SYMBOL := #'[a-z]+'; - ACTIONS := ACTION | ACTION SPACE 'and' SPACE ACTIONS - ACTION := SIMPLE-ACTION | PROBABLE-ACTION; - PROBABLE-ACTION := VALUE SPACE 'chance in' SPACE VALUE SPACE SIMPLE-ACTION; - SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION - BECOMES := 'should be' - SPACE := #' *'" - ) - -(defn TODO - "Marker to indicate I'm not yet finished!" - [message] - message) - - -(declare generate simplify) - - -(defn suitable-fragment? - "Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`." - [tree-fragment type] - (and (coll? tree-fragment) - (= (first tree-fragment) type))) - - -(defn assert-type - "If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception." - [tree-fragment type] - (assert (suitable-fragment? tree-fragment type) - (throw (Exception. (format "Expected a %s fragment" type))))) - - -(defn generate-rule - "From this `tree`, assumed to be a syntactically correct rule specification, - generate and return the appropriate rule as a function of two arguments." - [tree] - (assert-type tree :RULE) - (list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3))))) - - -(defn generate-conditions - "From this `tree`, assumed to be a syntactically correct conditions clause, - generate and return the appropriate clojure fragment." - [tree] - (assert-type tree :CONDITIONS) - (generate (nth tree 1))) - - -(defn generate-condition - [tree] - (assert-type tree :CONDITION) - (generate (nth tree 1))) - - -(defn generate-conjunct-condition - [tree] - (assert-type tree :CONJUNCT-CONDITION) - (list 'and (generate (nth tree 1))(generate (nth tree 3)))) - - -(defn generate-disjunct-condition - [tree] - (assert-type tree :DISJUNCT-CONDITION) - (list 'or (generate (nth tree 1))(generate (nth tree 3)))) - - -(defn generate-ranged-property-condition - "Generate a property condition where the expression is a numeric range" - [tree property expression] - (assert-type tree :PROPERTY-CONDITION) - (assert-type (nth tree 3) :RANGE-EXPRESSION) - (let [l1 (generate (nth expression 2)) - l2 (generate (nth expression 4)) - pv (list property 'cell)] - (list 'let ['lower (list 'min l1 l2) - 'upper (list 'max l1 l2)] - (list 'and (list '>= pv 'lower)(list '<= pv 'upper))))) - - -(defn generate-disjunct-property-condition - "Generate a property condition where the expression is a disjunct expression. - TODO: this is definitely still wrong!" - ([tree] - (let [property (generate (nth tree 1)) - qualifier (generate (nth tree 2)) - expression (generate (nth tree 3))] - (generate-disjunct-property-condition tree property qualifier expression))) - ([tree property qualifier expression] - (let [e (list 'some (list 'fn ['i] '(= i value)) (list 'quote expression))] - (list 'let ['value (list property 'cell)] - (if (= qualifier '=) e - (list 'not e)))))) - - -(defn generate-property-condition - ([tree] - (assert-type tree :PROPERTY-CONDITION) - (if - (and (= (count tree) 2) (= (first (second tree)) :SYMBOL)) - ;; it's a shorthand for 'state equal to symbol'. This should probably have - ;; been handled in simplify... - (generate-property-condition - (list - :PROPERTY-CONDITION - '(:SYMBOL "state") - '(:QUALIFIER (:EQUIVALENCE (:EQUAL "equal to"))) - (second tree))) - ;; otherwise... - (generate-property-condition tree (first (nth tree 3))))) - ([tree expression-type] - (assert-type tree :PROPERTY-CONDITION) - (let [property (generate (nth tree 1)) - qualifier (generate (nth tree 2)) - expression (generate (nth tree 3))] - (case expression-type - :DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression) - :RANGE-EXPRESSION (generate-ranged-property-condition tree property expression) - (list qualifier (list property 'cell) expression))))) - - -(defn generate-simple-action - [tree] - (assert-type tree :SIMPLE-ACTION) - (let [property (generate (nth tree 1)) - expression (generate (nth tree 3))] - (if (or (= property :x) (= property :y)) - (throw (Exception. reserved-properties-error)) - (list 'merge 'cell {property expression})))) - - -(defn generate-multiple-actions - [tree] - (assert (and (coll? tree)(= (first tree) :ACTIONS)) "Expected an ACTIONS fragment") - (conj 'do (map generate-simple-action (rest tree)))) - - -(defn generate-disjunct-value - "Generate a disjunct value. Essentially what we need here is to generate a - flat list of values, since the `member` has already been taken care of." - [tree] - (assert-type tree :DISJUNCT-VALUE) - (if (= (count tree) 4) - (cons (generate (second tree)) (generate (nth tree 3))) - (list (generate (second tree))))) - - -(defn generate-numeric-expression - [tree] - (assert-type tree :NUMERIC-EXPRESSION) - (case (first (second tree)) - :SYMBOL (list (keyword (second (second tree))) 'cell) - (generate (second tree)))) - - -(defn generate-neighbours-condition - "Generate code for a condition which refers to neighbours." - ([tree] - (assert-type tree :NEIGHBOURS-CONDITION) - (generate-neighbours-condition tree (first (second (second tree))))) - ([tree quantifier-type] - (let [quantifier (second tree) - pc (generate (nth tree 4))] - (case quantifier-type - :NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc 1) - :SOME (generate-neighbours-condition '> 0 pc 1) - :MORE (let [value (generate (nth quantifier 3))] - (generate-neighbours-condition '> value pc 1)) - :LESS (let [value (generate (nth quantifier 3))] - (generate-neighbours-condition '< value pc 1))))) - ([comp1 quantity property-condition distance] - (list comp1 - (list 'count - (list 'remove 'false? - (list 'map (list 'fn ['cell] property-condition) - (list 'mw-engine.utils/get-neighbours 'world 'cell distance)))) quantity)) - ([comp1 quantity property-condition] - (generate-neighbours-condition comp1 quantity property-condition 1))) - - -(defn generate - "Generate code for this (fragment of a) parse tree" - [tree] - (if - (coll? tree) - (case (first tree) - :ACTIONS (generate-multiple-actions tree) - :COMPARATIVE (generate (second tree)) - :COMPARATIVE-QUALIFIER (generate (nth tree 2)) - :CONDITION (generate-condition tree) - :CONDITIONS (generate-conditions tree) - :CONJUNCT-CONDITION (generate-conjunct-condition tree) - :DISJUNCT-CONDITION (generate-disjunct-condition tree) - :DISJUNCT-EXPRESSION (generate (nth tree 2)) - :DISJUNCT-VALUE (generate-disjunct-value tree) - :EQUIVALENCE '= - :EXPRESSION (generate (second tree)) - :LESS '< - :MORE '> - :NEGATED-QUALIFIER (case (generate (second tree)) - = 'not= - > '< - < '>) - :NEIGHBOURS-CONDITION (generate-neighbours-condition tree) - :NUMERIC-EXPRESSION (generate-numeric-expression tree) - :NUMBER (read-string (second tree)) - :PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right - :PROPERTY-CONDITION (generate-property-condition tree) - :QUALIFIER (generate (second tree)) - :RULE (generate-rule tree) - :SIMPLE-ACTION (generate-simple-action tree) - :SYMBOL (keyword (second tree)) - :VALUE (generate (second tree)) - (map generate tree)) - tree)) - - -(defn simplify-qualifier - "Given that this `tree` fragment represents a qualifier, what - qualifier is that?" - [tree] - (cond - (empty? tree) nil - (and (coll? tree) - (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree - (coll? (first tree)) (or (simplify-qualifier (first tree)) - (simplify-qualifier (rest tree))) - (coll? tree) (simplify-qualifier (rest tree)) - true tree)) - -(defn simplify-second-of-two - "There are a number of possible simplifications such that if the `tree` has - only two elements, the second is semantically sufficient." - [tree] - (if (= (count tree) 2) (simplify (nth tree 1)) tree)) - - -(defn rule? - "Return true if the argument appears to be a parsed rule tree, else false." - [maybe-rule] - (and (coll? maybe-rule) (= (first maybe-rule) :RULE))) - -(defn simplify - "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with - semantically identical simpler fragments" - [tree] - (if - (coll? tree) - (case (first tree) - :ACTION (simplify-second-of-two tree) - :ACTIONS (simplify-second-of-two tree) - :COMPARATIVE (simplify-second-of-two tree) - :CONDITION (simplify-second-of-two tree) - :CONDITIONS (simplify-second-of-two tree) - :EXPRESSION (simplify-second-of-two tree) - :NOT nil ;; TODO is this right?!? It looks wrong - :PROPERTY (simplify-second-of-two tree) - :SPACE nil - :THEN nil - :VALUE (simplify-second-of-two tree) - (remove nil? (map simplify tree))) - tree)) - -(def parse-rule - "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree." - (insta/parser grammar)) - -(defn explain-parse-error-reason - "Attempt to explain the reason for the parse error." - [reason] - (str "Expecting one of (" (apply str (map #(str (:expecting %) " ") reason)) ")")) - -(defn parser-error-to-map - [parser-error] - (let [m (reduce (fn [map item](merge map {(first item)(second item)})) {} parser-error) - reason (map - #(reduce (fn [map item] (merge {(first item) (second item)} map)) {} %) - (:reason m))] - (merge m {:reason reason}))) - -(defn throw-parse-exception - "Construct a helpful error message from this `parser-error`, and throw an exception with that message." - [parser-error] - (assert (coll? parser-error) "Expected a paser error structure?") - (let - [ - ;; the error structure is a list, such that each element is a list of two items, and - ;; the first element in each sublist is a keyword. Easier to work with it as a map - error-map (parser-error-to-map parser-error) - text (:text error-map) - reason (explain-parse-error-reason (:reason error-map)) - ;; rules have only one line, by definition; we're interested in the column - column (if (:column error-map)(:column error-map) 0) - ;; create a cursor to point to that column - cursor (apply str (reverse (conj (repeat column " ") "^"))) - message (format bad-parse-error text cursor reason) - ] - (throw (Exception. message)))) - -(defn compile-rule - "Compile this `rule`, assumed to be a string with appropriate syntax, into a function of two arguments, - a `cell` and a `world`, having the same semantics." - [rule] - (assert (string? rule)) - (let [tree (simplify (parse-rule rule))] - (if (rule? tree) (eval (generate tree)) - (throw-parse-exception tree)))) - - diff --git a/src/mw_parser/simplifier.clj b/src/mw_parser/simplifier.clj deleted file mode 100644 index 9943256..0000000 --- a/src/mw_parser/simplifier.clj +++ /dev/null @@ -1,92 +0,0 @@ -(ns mw-parser.simplifier - (:use mw-engine.utils - mw-parser.parser)) - -(declare simplify) - -(defn simplify-qualifier - "Given that this `tree` fragment represents a qualifier, what - qualifier is that?" - [tree] - (cond - (empty? tree) nil - (and (coll? tree) - (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree - (coll? (first tree)) (or (simplify-qualifier (first tree)) - (simplify-qualifier (rest tree))) - (coll? tree) (simplify-qualifier (rest tree)) - true tree)) - -(defn simplify-second-of-two - "There are a number of possible simplifications such that if the `tree` has - only two elements, the second is semantically sufficient." - [tree] - (if (= (count tree) 2) (simplify (nth tree 1)) tree)) - - -(defn simplify-some - "'some' is the same as 'more than zero'" - [tree] - [:COMPARATIVE '> 0]) - -(defn simplify-none - "'none' is the same as 'zero'" - [tree] - [:COMPARATIVE '= 0]) - -(defn simplify-all - "'all' isn't actually the same as 'eight', because cells at the edges of the world have - fewer than eight neighbours; but it's a simplifying (ha!) assumption for now." - [tree] - [:COMPARATIVE '= 8]) - -(defn simplify-quantifier - "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' - and whose quantity is that number. This is actually more complicated but makes generation easier." - [tree] - (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify (second tree)))) - -(defn simplify - "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with - semantically identical simpler fragments" - [tree] - (if - (coll? tree) - (case (first tree) - :SPACE nil - :QUALIFIER (simplify-qualifier tree) - :CONDITIONS (simplify-second-of-two tree) - :CONDITION (simplify-second-of-two tree) - :EXPRESSION (simplify-second-of-two tree) - :COMPARATIVE (simplify-second-of-two tree) - :QUANTIFIER (simplify-quantifier tree) - :VALUE (simplify-second-of-two tree) - :PROPERTY (simplify-second-of-two tree) - :ACTIONS (simplify-second-of-two tree) - :ACTION (simplify-second-of-two tree) - :ALL (simplify-all tree) - :SOME (simplify-some tree) - :NONE (simplify-none tree) - (remove nil? (map simplify tree))) - tree)) - -(simplify (parse-rule "if state is climax and 4 neighbours have state equal to fire then 3 chance in 5 state should be fire")) -(simplify (parse-rule "if state is climax and no neighbours have state equal to fire then 3 chance in 5 state should be fire")) - -(simplify (parse-rule "if state is in grassland or pasture or heath and more than 4 neighbours have state equal to water then state should be village")) - -(simplify (parse-rule "if 6 neighbours have state equal to water then state should be village")) - -(simplify (parse-rule "if fertility is between 55 and 75 then state should be climax")) - -(simplify (parse-rule "if state is forest then state should be climax")) - - -(simplify (parse-rule "if state is in grassland or pasture or heath and more than 4 neighbours have state equal to water then state should be village")) -(simplify (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")) -(simplify (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3")) -(simplify (parse-rule "if altitude is 100 or fertility is 25 then state should be heath")) - -(simplify (parse-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2")) -(simplify (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves")) -(simplify (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village")) diff --git a/test/mw_parser/bulk_test.clj b/test/microworld/parser/bulk_test.clj similarity index 67% rename from test/mw_parser/bulk_test.clj rename to test/microworld/parser/bulk_test.clj index e80acc7..6b74a61 100644 --- a/test/mw_parser/bulk_test.clj +++ b/test/microworld/parser/bulk_test.clj @@ -1,24 +1,25 @@ -(ns mw-parser.bulk-test +(ns microworld.parser.bulk-test (:use clojure.java.io) (:require [clojure.test :refer :all] - [mw-parser.bulk :refer :all])) + [microworld.parser.bulk :refer :all])) (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 + (is (empty? + (remove #(= % ':RULE) + (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 + (remove ifn? + (map first + (compile-file (as-file "resources/rules.txt"))))) "all compiled rules should be ifns") )) + diff --git a/test/mw_parser/core_test.clj b/test/microworld/parser/core_test.clj similarity index 99% rename from test/mw_parser/core_test.clj rename to test/microworld/parser/core_test.clj index f0e152e..bd55717 100644 --- a/test/mw_parser/core_test.clj +++ b/test/microworld/parser/core_test.clj @@ -1,9 +1,9 @@ -(ns mw-parser.core-test +(ns microworld.parser.core-test (:use clojure.pprint - mw-engine.core - mw-engine.world) + microworld.engine.core + microworld.engine.world) (:require [clojure.test :refer :all] - [mw-parser.core :refer :all])) + [microworld.parser.core :refer :all])) (deftest primitives-tests (testing "Simple functions supporting the parser" diff --git a/test/microworld/parser/declarative_test.clj b/test/microworld/parser/declarative_test.clj new file mode 100644 index 0000000..953582d --- /dev/null +++ b/test/microworld/parser/declarative_test.clj @@ -0,0 +1,497 @@ +(ns microworld.parser.declarative-test + (:use clojure.pprint + microworld.engine.core + microworld.engine.world + microworld.engine.utils + microworld.parser.utils) + (:require [clojure.test :refer :all] + [microworld.parser.declarative :refer :all])) + +(deftest rules-tests + (testing "Rule parser - does not test whether generated functions actually work, just that something is generated!" + (is (rule? (parse-rule "if state is forest then state should be climax"))) + (is (rule? (parse-rule "if state is in grassland or pasture or heath then state should be village"))) + (is (rule? (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))) + (is (rule? (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"))) + (is (rule? (parse-rule "if altitude is 100 or fertility is 25 then state should be heath"))) + (is (rule? (parse-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2"))) + (is (rule? (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"))) + (is (rule? (parse-rule "if state is forest and fertility is between 55 and 75 then state should be climax"))) + (is (rule? (parse-rule "if fertility is between 55 and 75 then state should be climax"))) + (is (rule? (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))) + )) + +(deftest neighbours-rules-tests + (testing "Rules which relate to neighbours - hard!" + (is (rule? (parse-rule "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire"))) + (is (rule? (parse-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if 6 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub"))) + (is (rule? (parse-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village"))) + (is (rule? (parse-rule "if 6 neighbours have state equal to water then state should be village"))) + )) + + +(deftest exception-tests + (testing "Constructions which should cause exceptions to be thrown" + (is (thrown-with-msg? Exception #"^I did not understand.*" + (compile-rule "the quick brown fox jumped over the lazy dog")) + "Exception thrown if rule text does not match grammar") + (is (thrown-with-msg? Exception #"^I did not understand.*" + (compile-rule "if i have a cat on my lap then everything is fine")) + "Exception thrown if rule text does not match grammar") + (is (thrown-with-msg? + Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" + (compile-rule "if state is new then x should be 0")) + "Exception thrown on attempt to set 'x'") + (is (thrown-with-msg? + Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" + (compile-rule "if state is new then y should be 0")) + "Exception thrown on attempt to set 'y'") + )) + + +(deftest correctness-tests + ;; these are, in so far as possible, the same as the correctness-tests in core-tests - i.e., the two compilers + ;; compile the same language. + (testing "Simplest possible rule" + (let [afn (compile-rule "if state is new then state should be grassland")] + (is (= (apply afn (list {:state :new} nil)) + {:state :grassland}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:state :forest} nil))) + "Rule doesn't fire when condition isn't met"))) + + (testing "Condition conjunction rule" + (let [afn (compile-rule "if state is new and altitude is 0 then state should be water")] + (is (= (apply afn (list {:state :new :altitude 0} nil)) + {:state :water :altitude 0}) + "Rule fires when conditions are met") + (is (nil? (apply afn (list {:state :new :altitude 5} nil))) + "Rule does not fire: second condition not met") + (is (nil? (apply afn (list {:state :forest :altitude 0} nil))) + "Rule does not fire: first condition not met"))) + + (testing "Condition disjunction rule" + (let [afn (compile-rule "if state is new or state is waste then state should be grassland")] + (is (= (apply afn (list {:state :new} nil)) + {:state :grassland}) + "Rule fires: first condition met") + (is (= (apply afn (list {:state :waste} nil)) + {:state :grassland}) + "Rule fires: second condition met") + (is (nil? (apply afn (list {:state :forest} nil))) + "Rule does not fire: neither condition met"))) + + (testing "Simple negation rule" + (let [afn (compile-rule "if state is not new then state should be grassland")] + (is (nil? (apply afn (list {:state :new} nil))) + "Rule doesn't fire when condition isn't met") + (is (= (apply afn (list {:state :forest} nil)) + {:state :grassland}) + "Rule fires when condition is met"))) + + (testing "Can't set x or y properties" + (is (thrown-with-msg? + Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" + (compile-rule "if state is new then x should be 0")) + "Exception thrown on attempt to set 'x'") + (is (thrown-with-msg? + Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" + (compile-rule "if state is new then y should be 0")) + "Exception thrown on attempt to set 'y'")) + + (testing "Simple list membership rule" + (let [afn (compile-rule "if state is in heath or scrub or forest then state should be climax")] + (is (= (apply afn (list {:state :heath} nil)) + {:state :climax}) + "Rule fires when condition is met") + (is (= (apply afn (list {:state :scrub} nil)) + {:state :climax}) + "Rule fires when condition is met") + (is (= (apply afn (list {:state :forest} nil)) + {:state :climax}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:state :grassland} nil))) + "Rule does not fire when condition is not met"))) + + (testing "Negated list membership rule" + (let [afn (compile-rule "if state is not in heath or scrub or forest then state should be climax")] + (is (nil? (apply afn (list {:state :heath} nil))) + "Rule does not fire when condition is not met") + (is (nil? (apply afn (list {:state :scrub} nil))) + "Rule does not fire when condition is not met") + (is (nil? (apply afn (list {:state :forest} nil))) + "Rule does not fire when condition is not met") + (is (= (apply afn (list {:state :grassland} nil)) + {:state :climax}) + "Rule fires when condition is met"))) + + (testing "Property is more than numeric-value" + (let [afn (compile-rule "if altitude is more than 200 then state should be snow")] + (is (= (apply afn (list {:altitude 201} nil)) + {:state :snow :altitude 201}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:altitude 200} nil))) + "Rule does not fire when condition is not met"))) + + (testing "Property is more than property" + (let [afn (compile-rule "if wolves are more than deer then deer should be 0")] + (is (= (apply afn (list {:deer 2 :wolves 3} nil)) + {:deer 0 :wolves 3}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:deer 3 :wolves 2} nil))) + "Rule does not fire when condition is not met"))) + + (testing "Property is less than numeric-value" + (let [afn (compile-rule "if altitude is less than 10 then state should be water")] + (is (= (apply afn (list {:altitude 9} nil)) + {:state :water :altitude 9}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:altitude 10} nil))) + "Rule does not fire when condition is not met"))) + + (testing "Property is less than property" + (let [afn (compile-rule "if wolves are less than deer then deer should be deer - wolves")] + (is (= (apply afn (list {:deer 3 :wolves 2} nil)) + {:deer 1 :wolves 2}) + "Rule fires when condition is met") + (is (nil? (apply afn (list {:deer 2 :wolves 3} nil))) + "Rule does not fire when condition is not met"))) + + (testing "Number neighbours have property equal to value" + (let [afn (compile-rule "if 3 neighbours have state equal to new then state should be water") + world (make-world 3 3)] + (is (= (apply afn (list {:x 0 :y 0} world)) + {:state :water :x 0 :y 0}) + "Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)") + (is (nil? (apply afn (list {:x 1 :y 1} world))) + "Middle cell has eight neighbours, so rule does not fire.")) + (let [afn (compile-rule "if 3 neighbours are new then state should be water") + world (make-world 3 3)] + ;; 'are new' and 'is new' should be the same as 'have state equal to new' + (is (= (apply afn (list {:x 0 :y 0} world)) + {:state :water :x 0 :y 0}) + "Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)") + (is (nil? (apply afn (list {:x 1 :y 1} world))) + "Middle cell has eight neighbours, so rule does not fire.")) + (let [afn (compile-rule "if 3 neighbours is new then state should be water") + world (make-world 3 3)] + ;; 'are new' and 'is new' should be the same as 'have state equal to new' + (is (= (apply afn (list {:x 0 :y 0} world)) + {:state :water :x 0 :y 0}) + "Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)") + (is (nil? (apply afn (list {:x 1 :y 1} world))) + "Middle cell has eight neighbours, so rule does not fire."))) + + (testing "Number neighbours have property more than numeric-value" + ;; if 3 neighbours have altitude more than 10 then state should be beach + (let [afn (compile-rule "if 3 neighbours have altitude more than 10 then state should be beach") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "if x is less than 2 then altitude should be 0")))] + (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 + leaffall")] + (is (= (:fertility + (apply afn + (list {:state :climax + :fertility 0 + :leaffall 1} nil))) + 1) + "Addition is executed"))) + + (testing "Arithmetic action: subtraction of number" + (let [afn (compile-rule "if state is crop then fertility should be fertility - 1")] + (is (= (:fertility + (apply afn (list {:state :crop :fertility 2} nil))) + 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.")) + )) + +(deftest regression-tests + (testing "Rule in default set which failed on switchover to declarative rules" + (let [afn (compile-rule "if state is scrub then 1 chance in 1 state should be forest") + world (transform-world + (make-world 3 3) + (list (compile-rule "if x is 2 then altitude should be 11") + (compile-rule "if x is less than 2 then state should be scrub")))] + (is (= (:state (apply afn (list (get-cell world 1 1) world))) :forest) + "Centre cell is scrub, so rule should fire") + (is (= (apply afn (list (get-cell world 2 1) world)) nil) + "Middle cell of the strip is not scrub, so rule should not fire.")))) + +(deftest regression-2-tests + (testing "Still getting fails althought tests for these fails fail." + (is + (= + (:state + (apply + (compile-rule "if state is scrub then 1 chance in 1 state should be forest") + (list {:state :scrub} {}))) + :forest)))) + diff --git a/test/microworld/parser/generate_test.clj b/test/microworld/parser/generate_test.clj new file mode 100644 index 0000000..a860424 --- /dev/null +++ b/test/microworld/parser/generate_test.clj @@ -0,0 +1,57 @@ +(ns microworld.parser.generate-test + (:use clojure.pprint + microworld.engine.core + microworld.engine.world + microworld.engine.utils + microworld.parser.utils) + (:require [clojure.test :refer :all] + [microworld.parser.generate :refer :all])) + + +(deftest expressions-tests + (testing "Generating primitive expressions." + (is (generate '(:NUMERIC-EXPRESSION (:NUMBER "50"))) 50) + (is (generate '(:NUMERIC-EXPRESSION (:SYMBOL "sealevel"))) + '(:sealevel cell)) + )) + + +(deftest lhs-generators-tests + (testing "Generating left-hand-side fragments of rule functions from appropriate fragments of parse trees" + (is (generate + '(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest"))) + '(= (:state cell) :forest)) + (is (generate + '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10"))) + '(= (:fertility cell) 10)) + (is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:LESS "less"]] (:NUMBER "10"))) + '(< (:fertility cell) 10)) + (is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:MORE "more"]] (:NUMBER "10"))) + '(> (:fertility cell) 10)) + (is (generate '(:CONJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:AND "and") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))) + '(and (= (:state cell) :forest) (= (:fertility cell) 10))) + (is (generate '(:DISJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:OR "or") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))) + '(or (= (:state cell) :forest) (= (:fertility cell) 10))) + (is (generate '(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:DISJUNCT-EXPRESSION (:IN "in") (:DISJUNCT-VALUE (:SYMBOL "grassland") (:OR "or") (:DISJUNCT-VALUE (:SYMBOL "pasture") (:OR "or") (:DISJUNCT-VALUE (:SYMBOL "heath"))))))) + '(let [value (:state cell)] (some (fn [i] (= i value)) (quote (:grassland :pasture :heath))))) + (is (generate '(:PROPERTY-CONDITION (:SYMBOL "altitude") [:EQUIVALENCE [:IS "is"]] (:RANGE-EXPRESSION (:BETWEEN "between") (:NUMERIC-EXPRESSION (:NUMBER "50")) (:AND "and") (:NUMERIC-EXPRESSION (:NUMBER "100"))))) + '(let [lower (min 50 100) upper (max 50 100)] (and (>= (:altitude cell) lower) (<= (:altitude cell) upper)))) + )) + + +(deftest rhs-generators-tests + (testing "Generating right-hand-side fragments of rule functions from appropriate fragments of parse trees" + (is (generate + '(:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax"))) + '(merge cell {:state :climax})) + (is (generate + '(:SIMPLE-ACTION (:SYMBOL "fertility") (:BECOMES "should be") (:NUMBER "10"))) + '(merge cell {:fertility 10})) + )) + + +(deftest full-generation-tests + (testing "Full rule generation from pre-parsed tree" + (is (generate '(:RULE (:IF "if") (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax")))) + '(fn [cell world] (if (= (:state cell) :forest) (merge cell {:state :climax})))) + )) diff --git a/test/mw_parser/declarative_test.clj b/test/mw_parser/declarative_test.clj deleted file mode 100644 index 86cb449..0000000 --- a/test/mw_parser/declarative_test.clj +++ /dev/null @@ -1,517 +0,0 @@ -(ns mw-parser.declarative-test - (:use clojure.pprint - mw-engine.core - mw-engine.world - mw-engine.utils) - (:require [clojure.test :refer :all] - [mw-parser.declarative :refer :all])) - -(deftest rules-tests - (testing "Rule parser - does not test whether generated functions actually work, just that something is generated!" - (is (rule? (parse-rule "if state is forest then state should be climax"))) - (is (rule? (parse-rule "if state is in grassland or pasture or heath then state should be village"))) - (is (rule? (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))) - (is (rule? (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"))) - (is (rule? (parse-rule "if altitude is 100 or fertility is 25 then state should be heath"))) - (is (rule? (parse-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2"))) - (is (rule? (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"))) - (is (rule? (parse-rule "if state is forest and fertility is between 55 and 75 then state should be climax"))) - (is (rule? (parse-rule "if fertility is between 55 and 75 then state should be climax"))) - (is (rule? (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))) - )) - -(deftest neighbours-rules-tests - (testing "Rules which relate to neighbours - hard!" - (is (rule? (parse-rule "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire"))) - (is (rule? (parse-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village"))) - (is (rule? (parse-rule "if 6 neighbours have state equal to water then state should be village"))) - (is (rule? (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village"))) - (is (rule? (parse-rule "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub"))) - (is (rule? (parse-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village"))) - (is (rule? (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village"))) - (is (rule? (parse-rule "if 6 neighbours have state equal to water then state should be village"))) - )) - -(deftest expressions-tests - (testing "Generating primitive expressions." - (is (generate '(:NUMERIC-EXPRESSION (:NUMBER "50"))) 50) - (is (generate '(:NUMERIC-EXPRESSION (:SYMBOL "sealevel"))) - '(:sealevel cell)) - )) - -(deftest lhs-generators-tests - (testing "Generating left-hand-side fragments of rule functions from appropriate fragments of parse trees" - (is (generate - '(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest"))) - '(= (:state cell) :forest)) - (is (generate - '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10"))) - '(= (:fertility cell) 10)) - (is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:LESS "less"]] (:NUMBER "10"))) - '(< (:fertility cell) 10)) - (is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:MORE "more"]] (:NUMBER "10"))) - '(> (:fertility cell) 10)) - (is (generate '(:CONJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:AND "and") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))) - '(and (= (:state cell) :forest) (= (:fertility cell) 10))) - (is (generate '(:DISJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:OR "or") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))) - '(or (= (:state cell) :forest) (= (:fertility cell) 10))) - (is (generate '(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:DISJUNCT-EXPRESSION (:IN "in") (:DISJUNCT-VALUE (:SYMBOL "grassland") (:OR "or") (:DISJUNCT-VALUE (:SYMBOL "pasture") (:OR "or") (:DISJUNCT-VALUE (:SYMBOL "heath"))))))) - '(let [value (:state cell)] (some (fn [i] (= i value)) (quote (:grassland :pasture :heath))))) - (is (generate '(:PROPERTY-CONDITION (:SYMBOL "altitude") [:EQUIVALENCE [:IS "is"]] (:RANGE-EXPRESSION (:BETWEEN "between") (:NUMERIC-EXPRESSION (:NUMBER "50")) (:AND "and") (:NUMERIC-EXPRESSION (:NUMBER "100"))))) - '(let [lower (min 50 100) upper (max 50 100)] (and (>= (:altitude cell) lower) (<= (:altitude cell) upper)))) - )) - -(deftest rhs-generators-tests - (testing "Generating right-hand-side fragments of rule functions from appropriate fragments of parse trees" - (is (generate - '(:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax"))) - '(merge cell {:state :climax})) - (is (generate - '(:SIMPLE-ACTION (:SYMBOL "fertility") (:BECOMES "should be") (:NUMBER "10"))) - '(merge cell {:fertility 10})) - )) - -(deftest full-generation-tests - (testing "Full rule generation from pre-parsed tree" - (is (generate '(:RULE (:IF "if") (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax")))) - '(fn [cell world] (if (= (:state cell) :forest) (merge cell {:state :climax})))) - )) - - -(deftest exception-tests - (testing "Constructions which should cause exceptions to be thrown" - (is (thrown-with-msg? Exception #"^I did not understand.*" - (compile-rule "the quick brown fox jumped over the lazy dog")) - "Exception thrown if rule text does not match grammar") - (is (thrown-with-msg? Exception #"^I did not understand.*" - (compile-rule "if i have a cat on my lap then everything is fine")) - "Exception thrown if rule text does not match grammar") - (is (thrown-with-msg? - Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" - (compile-rule "if state is new then x should be 0")) - "Exception thrown on attempt to set 'x'") - (is (thrown-with-msg? - Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" - (compile-rule "if state is new then y should be 0")) - "Exception thrown on attempt to set 'y'") - )) - -(deftest correctness-tests - ;; these are, in so far as possible, the same as the correctness-tests in core-tests - i.e., the two compilers - ;; compile the same language. - (testing "Simplest possible rule" - (let [afn (compile-rule "if state is new then state should be grassland")] - (is (= (apply afn (list {:state :new} nil)) - {:state :grassland}) - "Rule fires when condition is met") - (is (nil? (apply afn (list {:state :forest} nil))) - "Rule doesn't fire when condition isn't met"))) - - (testing "Condition conjunction rule" - (let [afn (compile-rule "if state is new and altitude is 0 then state should be water")] - (is (= (apply afn (list {:state :new :altitude 0} nil)) - {:state :water :altitude 0}) - "Rule fires when conditions are met") - (is (nil? (apply afn (list {:state :new :altitude 5} nil))) - "Rule does not fire: second condition not met") - (is (nil? (apply afn (list {:state :forest :altitude 0} nil))) - "Rule does not fire: first condition not met"))) - - (testing "Condition disjunction rule" - (let [afn (compile-rule "if state is new or state is waste then state should be grassland")] - (is (= (apply afn (list {:state :new} nil)) - {:state :grassland}) - "Rule fires: first condition met") - (is (= (apply afn (list {:state :waste} nil)) - {:state :grassland}) - "Rule fires: second condition met") - (is (nil? (apply afn (list {:state :forest} nil))) - "Rule does not fire: neither condition met"))) - - (testing "Simple negation rule" - (let [afn (compile-rule "if state is not new then state should be grassland")] - (is (nil? (apply afn (list {:state :new} nil))) - "Rule doesn't fire when condition isn't met") - (is (= (apply afn (list {:state :forest} nil)) - {:state :grassland}) - "Rule fires when condition is met"))) - - (testing "Can't set x or y properties" - (is (thrown-with-msg? - Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" - (compile-rule "if state is new then x should be 0")) - "Exception thrown on attempt to set 'x'") - (is (thrown-with-msg? - Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" - (compile-rule "if state is new then y should be 0")) - "Exception thrown on attempt to set 'y'")) - - (testing "Simple list membership rule" - (let [afn (compile-rule "if state is in heath or scrub or forest then state should be climax")] - (is (= (apply afn (list {:state :heath} nil)) - {:state :climax}) - "Rule fires when condition is met") - (is (= (apply afn (list {:state :scrub} nil)) - {:state :climax}) - "Rule fires when condition is met") - (is (= (apply afn (list {:state :forest} nil)) - {:state :climax}) - "Rule fires when condition is met") - (is (nil? (apply afn (list {:state :grassland} nil))) - "Rule does not fire when condition is not met"))) - - (testing "Negated list membership rule" - (let [afn (compile-rule "if state is not in heath or scrub or forest then state should be climax")] - (is (nil? (apply afn (list {:state :heath} nil))) - "Rule does not fire when condition is not met") - (is (nil? (apply afn (list {:state :scrub} nil))) - "Rule does not fire when condition is not met") - (is (nil? (apply afn (list {:state :forest} nil))) - "Rule does not fire when condition is not met") - (is (= (apply afn (list {:state :grassland} nil)) - {:state :climax}) - "Rule fires when condition is met"))) - - (testing "Property is more than numeric-value" - (let [afn (compile-rule "if altitude is more than 200 then state should be snow")] - (is (= (apply afn (list {:altitude 201} nil)) - {:state :snow :altitude 201}) - "Rule fires when condition is met") - (is (nil? (apply afn (list {:altitude 200} nil))) - "Rule does not fire when condition is not met"))) - -;; TODO: this one is very tricky and will require a rethink of the way conditions are parsed. -;; (testing "Property is more than property" -;; (let [afn (compile-rule "if wolves are more than deer then deer should be 0")] -;; (is (= (apply afn (list {:deer 2 :wolves 3} nil)) -;; {:deer 0 :wolves 3}) -;; "Rule fires when condition is met") -;; (is (nil? (apply afn (list {:deer 3 :wolves 2} nil))) -;; "Rule does not fire when condition is not met"))) - - (testing "Property is less than numeric-value" - (let [afn (compile-rule "if altitude is less than 10 then state should be water")] - (is (= (apply afn (list {:altitude 9} nil)) - {:state :water :altitude 9}) - "Rule fires when condition is met") - (is (nil? (apply afn (list {:altitude 10} nil))) - "Rule does not fire when condition is not met"))) - - (testing "Property is less than property" - (let [afn (compile-rule "if wolves are less than deer then deer should be deer - wolves")] - (is (= (apply afn (list {:deer 3 :wolves 2} nil)) - {:deer 1 :wolves 2}) - "Rule fires when condition is met") - (is (nil? (apply afn (list {:deer 2 :wolves 3} nil))) - "Rule does not fire when condition is not met"))) - - (testing "Number neighbours have property equal to value" - (let [afn (compile-rule "if 3 neighbours have state equal to new then state should be water") - world (make-world 3 3)] - (is (= (apply afn (list {:x 0 :y 0} world)) - {:state :water :x 0 :y 0}) - "Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)") - (is (nil? (apply afn (list {:x 1 :y 1} world))) - "Middle cell has eight neighbours, so rule does not fire.")) - (let [afn (compile-rule "if 3 neighbours are new then state should be water") - world (make-world 3 3)] - ;; 'are new' and 'is new' should be the same as 'have state equal to new' - (is (= (apply afn (list {:x 0 :y 0} world)) - {:state :water :x 0 :y 0}) - "Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)") - (is (nil? (apply afn (list {:x 1 :y 1} world))) - "Middle cell has eight neighbours, so rule does not fire.")) - (let [afn (compile-rule "if 3 neighbours is new then state should be water") - world (make-world 3 3)] - ;; 'are new' and 'is new' should be the same as 'have state equal to new' - (is (= (apply afn (list {:x 0 :y 0} world)) - {:state :water :x 0 :y 0}) - "Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)") - (is (nil? (apply afn (list {:x 1 :y 1} world))) - "Middle cell has eight neighbours, so rule does not fire."))) - - (testing "Number neighbours have property more than numeric-value" - (let [afn (compile-rule "if 3 neighbours have altitude more than 10 then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "if x is less than 2 then altitude should be 0")))] - (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) - "Rule fires when condition is met (strip of altitude 11 down right hand side)") - (is (nil? (apply afn (list {:x 2 :y 1} world))) - "Middle cell of the strip has only two high neighbours, so rule should not fire."))) - - (testing "Number neighbours have property less than numeric-value" - (let [afn (compile-rule "if 5 neighbours have altitude less than 10 then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "if x is less than 2 then altitude should be 0")))] - (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) - "Rule fires when condition is met (strip of altitude 11 down right hand side)") - (is (nil? (apply afn (list {:x 2 :y 1} world))) - "Middle cell of the strip has two high neighbours, so rule should not fire."))) - - (testing "More than number neighbours have property equal to numeric-value" - (let [afn (compile-rule "if more than 2 neighbours have altitude equal to 11 then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "if x is less than 2 then altitude should be 0")))] - (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) - "Rule fires when condition is met (strip of altitude 11 down right hand side)") - (is (nil? (apply afn (list {:x 2 :y 1} world))) - "Middle cell of the strip has only two high neighbours, so rule should not fire."))) - - (testing "More than number neighbours have property equal to symbolic-value" - (let [afn (compile-rule "if more than 2 neighbours have state equal to grassland then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") - (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))] - (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) - "Rule fires when condition is met (strip of altitude 11 down right hand side)") - (is (nil? (apply afn (list {:x 2 :y 1} world))) - "Middle cell of the strip has only two high neighbours, so rule should not fire.")) - (let [afn (compile-rule "if more than 2 neighbours are grassland then state should be beach") - ;; 'are grassland' should mean the same as 'have state equal to grassland'. - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") - (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))] - (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) - "Rule fires when condition is met (strip of altitude 11 down right hand side)") - (is (nil? (apply afn (list {:x 2 :y 1} world))) - "Middle cell of the strip has only two high neighbours, so rule should not fire.")) - ) - - (testing "Fewer than number neighbours have property equal to numeric-value" - (let [afn (compile-rule "if fewer than 3 neighbours have altitude equal to 11 then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "if x is less than 2 then altitude should be 0")))] - (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) - "Rule fires when condition is met (Middle cell of the strip has only two high neighbours)") - (is (nil? (apply afn (list {:x 1 :y 1} world))) - "Middle cell of world has three high neighbours, so rule should not fire."))) - - (testing "Fewer than number neighbours have property equal to symbolic-value" - (let [afn (compile-rule "if fewer than 3 neighbours have state equal to grassland then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") - (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))] - (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) - "Rule fires when condition is met (Middle cell of the strip has only two high neighbours)") - (is (nil? (apply afn (list {:x 1 :y 1} world))) - "Middle cell of world has three high neighbours, so rule should not fire."))) - -;; some neighbours have property equal to value - (testing "Some neighbours have property equal to numeric-value" - (let [afn (compile-rule "if some neighbours have altitude equal to 11 then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "if x is less than 2 then altitude should be 0")))] - (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) - "Rule fires when condition is met (strip of altitude 11 down right hand side)") - (is (nil? (apply afn (list {:x 0 :y 1} world))) - "Left hand side of world has no high neighbours, so rule should not fire."))) - - (testing "Some neighbours have property equal to symbolic-value" - (let [afn (compile-rule "if some neighbours have state equal to grassland then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") - (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))] - (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) - "Rule fires when condition is met (strip of altitude 11 down right hand side)") - (is (nil? (apply afn (list {:x 0 :y 1} world))) - "Left hand side of world has no high neighbours, so rule should not fire."))) - -;; more than number neighbours have property more than numeric-value - (testing "More than number neighbours have property more than symbolic-value" - (let [afn (compile-rule "if more than 2 neighbours have altitude more than 10 then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") - (compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))] - (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) - "Rule fires when condition is met (strip of altitude 11 down right hand side)") - (is (nil? (apply afn (list {:x 2 :y 1} world))) - "Middle cell of the strip has only two high neighbours, so rule should not fire."))) - -;; fewer than number neighbours have property more than numeric-value - (testing "Fewer than number neighbours have property more than numeric-value" - (let [afn (compile-rule "if fewer than 3 neighbours have altitude more than 10 then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "if x is less than 2 then altitude should be 0")))] - (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) - "Rule fires when condition is met (Middle cell of the strip has only two high neighbours)") - (is (nil? (apply afn (list {:x 1 :y 1} world))) - "Middle cell of world has three high neighbours, so rule should not fire."))) - -;; some neighbours have property more than numeric-value - (testing "Some neighbours have property more than numeric-value" - (let [afn (compile-rule "if some neighbours have altitude more than 10 then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "if x is less than 2 then altitude should be 0")))] - (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) - "Rule fires when condition is met (strip of altitude 11 down right hand side)") - (is (nil? (apply afn (list {:x 0 :y 1} world))) - "Left hand side of world has no high neighbours, so rule should not fire."))) - -;; more than number neighbours have property less than numeric-value - (testing "More than number neighbours have property less than numeric-value" - (let [afn (compile-rule "if more than 4 neighbours have altitude less than 10 then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "if x is less than 2 then altitude should be 0")))] - (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) - "Rule fires when condition is met (strip of altitude 11 down right hand side)") - (is (nil? (apply afn (list {:x 2 :y 1} world))) - "Middle cell of the strip has only three low neighbours, so rule should not fire."))) - -;; fewer than number neighbours have property less than numeric-value - (testing "Fewer than number neighbours have property less than numeric-value" - (let [afn (compile-rule "if fewer than 4 neighbours have altitude less than 10 then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is 2 then altitude should be 11") - (compile-rule "if x is less than 2 then altitude should be 0")))] - (is (nil? (apply afn (list {:x 1 :y 1} world))) - "Centre cell has five low neighbours, so rule should not fire") - (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) - "Middle cell of the strip has only three low neighbours, so rule should fire."))) - -;; some neighbours have property less than numeric-value - (testing "Some number neighbours have property less than numeric-value" - (let [afn (compile-rule "if some neighbours have altitude less than 10 then state should be beach") - world (transform-world - (make-world 3 3) - (list (compile-rule "if x is less than 2 then altitude should be 11") - (compile-rule "if x is 2 then altitude should be 0")))] - (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) - "Rule fires when condition is met (strip of altitude 0 down right hand side)") - (is (nil? (apply afn (list {:x 0 :y 1} world))) - "Left of world is all high, so rule should not fire."))) - - -;; 'single action' already tested in 'condition' tests above -;; action and actions - (testing "Conjunction of actions" - (let [afn (compile-rule "if state is new then state should be grassland and fertility should be 0")] - (is (= (apply afn (list {:state :new} nil)) - {:state :grassland :fertility 0}) - "Both actions are executed"))) - -;; 'property should be symbolic-value' and 'property should be numeric-value' -;; already tested in tests above - -;; number chance in number property should be value - (testing "Syntax of probability rule - action of real probability very hard to test" - (let [afn (compile-rule "if state is forest then 5 chance in 5 state should be climax")] - (is (= (:state (apply afn (list {:state :forest} nil))) :climax) - "five chance in five should fire every time")) - (let [afn (compile-rule "if state is forest then 0 chance in 5 state should be climax")] - (is (nil? (apply afn (list {:state :forest} nil))) - "zero chance in five should never fire"))) - -;; property operator numeric-value - (testing "Arithmetic action: addition of number" - (let [afn (compile-rule "if state is climax then fertility should be fertility + 1")] - (is (= (:fertility - (apply afn (list {:state :climax :fertility 0} nil))) - 1) - "Addition is executed"))) - - (testing "Arithmetic action: addition of property value" - (let [afn (compile-rule "if state is climax then fertility should be fertility + leaf-fall")] - (is (= (:fertility - (apply afn - (list {:state :climax - :fertility 0 - :leaf-fall 1} nil))) - 1) - "Addition is executed"))) - - (testing "Arithmetic action: subtraction of number" - (let [afn (compile-rule "if state is crop then fertility should be fertility - 1")] - (is (= (:fertility - (apply afn (list {:state :crop :fertility 2} nil))) - 1) - "Action is executed"))) - - (testing "Arithmetic action: subtraction of property value" - (let [afn (compile-rule "if wolves are more than 0 then deer should be deer - wolves")] - (is (= (:deer - (apply afn - (list {:deer 3 - :wolves 2} nil))) - 1) - "Action is executed"))) - - (testing "Arithmetic action: multiplication by number" - (let [afn (compile-rule "if deer are more than 1 then deer should be deer * 2")] - (is (= (:deer - (apply afn (list {:deer 2} nil))) - 4) - "Action is executed"))) - - (testing "Arithmetic action: multiplication by property value" - (let [afn (compile-rule "if state is crop then deer should be deer * deer")] - (is (= (:deer - (apply afn - (list {:state :crop :deer 2} nil))) - 4) - "Action is executed"))) - - (testing "Arithmetic action: division by number" - (let [afn (compile-rule "if wolves are more than 0 then deer should be deer / 2")] - (is (= (:deer - (apply afn (list {:deer 2 :wolves 1} nil))) - 1) - "Action is executed"))) - - (testing "Arithmetic action: division by property value" - (let [afn (compile-rule "if wolves are more than 0 then deer should be deer / wolves")] - (is (= (:deer - (apply afn - (list {:deer 2 :wolves 2} nil))) - 1) - "Action is executed"))) - -;; simple within distance - (testing "Number neighbours within distance have property equal to value" - (let [afn (compile-rule "if 8 neighbours within 2 have state equal to new then state should be water") - world (make-world 5 5)] - (is (= (apply afn (list {:x 0 :y 0} world)) - {:state :water :x 0 :y 0}) - "Rule fires when condition is met (in a new world all cells are new, corner cell has eight neighbours within two)") - (is (nil? (apply afn (list {:x 1 :y 1} world))) - "Middle cell has twenty-four neighbours within two, so rule does not fire."))) - -;; comparator within distance - (testing "More than number neighbours within distance have property equal to symbolic-value" - (let [afn (compile-rule "if more than 7 neighbours within 2 have state equal to grassland and more than 7 neighbours within 2 have state equal to water then state should be beach") - ;; 5x5 world, strip of high ground two cells wide down left hand side - ;; xxooo - ;; xxooo - ;; xxooo - ;; xxooo - ;; xxooo - world (transform-world - (make-world 5 5) - (list (compile-rule "if x is less than 2 then altitude should be 11 and state should be grassland") - (compile-rule "if x is more than 1 then altitude should be 0 and state should be water")))] - (is (= (:state (apply afn (list {:x 2 :y 2} world))) :beach) - "Rule fires when condition is met (strip of altitude 11 down right hand side)") - (is (nil? (apply afn (list {:x 0 :y 1} world))) - "Middle cell of the strip has only two high neighbours, so rule should not fire.")) - ))