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

Compare commits

merge into: simon:master
Branches Tags
simon:master
simon:develop
simon:0.1.6_MAINTENANCE
simon:0.1.5_MAINTENANCE
simon:feature/1
simon:0.1.3_MAINTENANCE
...
pull from: simon:0.1.6_MAINTENANCE
Branches Tags
simon:develop
simon:0.1.6_MAINTENANCE
simon:0.1.5_MAINTENANCE
simon:feature/1
simon:master
simon:0.1.3_MAINTENANCE

13 commits
master ... 0.1.6_MAIN

Author SHA1 Message Date
Simon Brooke 80e9b2255b Upversioned from 0.1.6-SNAPSHOT to 0.1.6 for release 2017-12-04 18:05:56 +00:00
Simon Brooke 264885f7a2 Ran lein ancient and upversioned all dependencies. 2017-12-04 13:47:26 +00:00
simon 11090d63ef Upversioned from 0.1.5 to 0.1.6-SNAPSHOT 2016-12-27 16:19:27 +00:00
simon 5089615401 Upversioned from 0.1.5-SNAPSHOT to 0.1.5 for release 2016-12-27 16:19:01 +00:00
simon a68a3c9135 Revert to using 'core' parser rather than new declarative parser, which still 
has bugs.
 2016-12-27 15:53:29 +00:00
simon 88d707a32e Fixed all failing tests. Two issues: 
1. The regression test failures were both errors in the tests rather than in
the code under test;
2. The failure in the 'bulk' test relates to the fact that the new declarative
parser cannot cope with trailing whitespace.
 2016-09-23 12:53:00 +01:00
simon ddf967088e Standarised header comments 2016-08-21 13:51:56 +01:00
simon 948bd7e5f2 Standardised header comments in line with current best practice. 2016-08-21 13:50:54 +01:00
simon ca9553fe83 Back to no exceptions in test, still two test failures which need to be investigated. 2016-08-13 23:20:34 +01:00
simon 3168c1b2fb Trying to get code quality up, but in the process I've broken something - 
I think, the simplifier.
 2016-08-13 19:45:43 +01:00
simon d2a73ba408 Major restructuring, switched over to use the new declarative parser. 
Some rules in the bulk test file no longer parse, but all rules in the
demonstration rule-sets do.
 2016-08-10 20:11:17 +01:00
simon 9836cbff50 All tests pass. I should now be able to ditch the old parser and use the 
new, but first I want to do some major code restructuring.
 2016-08-10 19:23:16 +01:00
simon 1c6ceb899c Substantially closer to the declarative parser fully working, but not 
yet perfect.
 2016-08-10 13:30:15 +01:00
13 changed files with 1152 additions and 887 deletions
Show stats Expand all files Collapse all files

8
project.clj
View file

@ -1,4 +1,4 @@
(defproject mw-parser "0.1.5-SNAPSHOT"
(defproject mw-parser "0.1.6"
:description "Parser for production rules for MicroWorld engine"
:url "http://www.journeyman.cc/microworld"
:manifest {
@ -11,8 +11,8 @@
: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"]
[instaparse "1.4.8"]
[mw-engine "0.1.6"]
])

10
resources/rules.txt
View file

@ -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

33
src/mw_parser/bulk.clj
View file

@ -1,13 +1,36 @@
;; 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
(ns ^{:doc "parse multiple rules from a stream, possibly a file."
:author "Simon Brooke"}
mw-parser.bulk
(:use mw-parser.core
mw-engine.utils
clojure.java.io
[clojure.string :only [split trim]])
(:import (java.io BufferedReader StringReader)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; mw-parser: a rule parser for MicroWorld.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2014 Simon Brooke
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn comment?
"Is this `line` a comment?"
[line]
@ -18,7 +41,7 @@
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"))))
(map #(parse-rule (trim %)) (remove comment? (split string #"\n"))))
(defn parse-file
"Parse rules from successive lines in the file loaded from this `filename`.

187
src/mw_parser/core.clj
View file

@ -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
(ns ^{:doc "A very simple parser which parses production rules."
:author "Simon Brooke"}
mw-parser.core
(:use mw-engine.utils
[clojure.string :only [split trim triml]])
(:gen-class)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; mw-parser: a rule parser for MicroWorld.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2014 Simon Brooke
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; A very simple parser which parses production rules of the following forms:
;;;;
;;;; * "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"
;;;; * "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"
;;;; * "if altitude is 100 or fertility is 25 then state should be heath"
;;;; * "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2"
;;;; * "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"
;;;; * "if state is grassland and 4 neighbours have state equal to water then state should be village"
;;;; * "if state is forest and fertility is between 55 and 75 then state should be climax"
;;;; * "if 6 neighbours have state equal to water then state should be village"
;;;; * "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village"
;;;; * "if state is forest or state is climax and some neighbours have state equal to fire then 3 in 5 chance that state should be fire"
;;;; * "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub"
;;;; *
;;;;
;;;; it generates rules in the form expected by `mw-engine.core`, q.v.
;;;;
;;;; It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil.
;;;; Very occasionally it generates a wrong rule - one which is not a correct translation of the rule
;;;; semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a
;;;; design fault.
;;;;
;;;; More significantly it does not generate useful error messages on failure.
;;;;
;;;; This parser is now obsolete, but is retained in the codebase for now in
;;;; case it is of use to anyone. Prefer the declarative.clj parser.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare parse-conditions)
(declare parse-not-condition)
(declare parse-simple-condition)
;; a regular expression which matches string representation of 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,27 +411,27 @@
(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
@ -417,7 +444,7 @@
(do
(use 'mw-engine.utils)
(let [afn (eval (parse-rule rule-text))]
(cond
(cond
(and afn return-tuple?)(list afn (trim rule-text))
true afn))))
([rule-text]

376
src/mw_parser/declarative.clj
View file

@ -1,29 +1,48 @@
(ns mw-parser.declarative
(:use mw-engine.utils
[clojure.string :only [split trim triml]])
(:require [instaparse.core :as insta]))
(ns ^{:doc "A very simple parser which parses production rules."
:author "Simon Brooke"}
mw-parser.declarative
(:require [instaparse.core :as insta]
[clojure.string :refer [split trim triml]]
[mw-parser.errors :as pe]
[mw-parser.generate :as pg]
[mw-parser.simplify :as ps]
[mw-parser.utils :refer [rule?]]))
;; 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")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; mw-parser: a rule parser for MicroWorld.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2014 Simon Brooke
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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 ;
CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | 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;
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;
@ -31,7 +50,7 @@
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-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 ;
@ -59,310 +78,41 @@
IS := 'is' | 'are' | 'have' | 'has';
NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+';
SYMBOL := #'[a-z]+';
ACTIONS := ACTION | ACTION SPACE 'and' SPACE ACTIONS
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 := #' *'"
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 := #' *'";
)
(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))))
"Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules,
into Clojure source, and then compile it into an anonymous
function object, getting round the problem of binding mw-engine.utils in
the compiling environment. If `return-tuple?` is present and true, return
a list comprising the anonymous function compiled, and the function from
which it was compiled.
Throws an exception if parsing fails."
([rule-text return-tuple?]
(assert (string? rule-text))
(let [rule (trim rule-text)
tree (ps/simplify (parse-rule rule))
afn (if (rule? tree) (eval (pg/generate tree))
;; else
(pe/throw-parse-exception tree))]
(if return-tuple?
(list afn rule)
;; else
afn)))
([rule-text]
(compile-rule rule-text false)))

68
src/mw_parser/errors.clj Normal file
View file

@ -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"}
mw-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))))

316
src/mw_parser/generate.clj Normal file
View file

@ -0,0 +1,316 @@
(ns ^{:doc "Generate Clojure source from simplified parse trees."
:author "Simon Brooke"}
mw-parser.generate
(:require [mw-engine.utils :refer []]
[mw-parser.utils :refer [assert-type TODO]]
[mw-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 'mw-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))

92
src/mw_parser/simplifier.clj
View file

@ -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"))

81
src/mw_parser/simplify.clj Normal file
View file

@ -0,0 +1,81 @@
(ns ^{:doc "Simplify a parse tree."
:author "Simon Brooke"}
mw-parser.simplify
(:require [mw-engine.utils :refer [member?]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; mw-parser: a rule parser for MicroWorld.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2014 Simon Brooke
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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))

64
src/mw_parser/utils.clj Normal file
View file

@ -0,0 +1,64 @@
(ns ^{:doc "Utilities used in more than one namespace within the parser."
:author "Simon Brooke"}
mw-parser.utils)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; mw-parser: a rule parser for MicroWorld.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2014 Simon Brooke
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn 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))))))

15
test/mw_parser/bulk_test.clj
View file

@ -7,18 +7,19 @@
(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 #(= % 'fn)
(map first
(parse-file
(as-file "resources/rules.txt")))))
"all parsed rules should be lambda sexprs")
(is (= (count (compile-file (as-file "resources/rules.txt"))) 15)
"Should compile all rules and throw no exceptions")
(is (empty?
(remove ifn?
(map first
(compile-file
(remove ifn?
(map first
(compile-file
(as-file "resources/rules.txt")))))
"all compiled rules should be ifns")
))

732
test/mw_parser/declarative_test.clj
View file

@ -2,7 +2,8 @@
(:use clojure.pprint
mw-engine.core
mw-engine.world
mw-engine.utils)
mw-engine.utils
mw-parser.utils)
(:require [clojure.test :refer :all]
[mw-parser.declarative :refer :all]))
@ -32,51 +33,6 @@
(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"
@ -96,422 +52,436 @@
"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")))
(let [afn (compile-rule "if state is new then state should be grassland")]
(is (= (apply afn (list {:state :new} nil))
{:state :grassland})
"Rule fires when condition is met")
(is (nil? (apply afn (list {:state :forest} nil)))
"Rule doesn't fire when condition isn't met")))
(testing "Condition conjunction rule"
(let [afn (compile-rule "if state is new and altitude is 0 then state should be water")]
(is (= (apply afn (list {:state :new :altitude 0} nil))
{:state :water :altitude 0})
"Rule fires when conditions are met")
(is (nil? (apply afn (list {:state :new :altitude 5} nil)))
"Rule does not fire: second condition not met")
(is (nil? (apply afn (list {:state :forest :altitude 0} nil)))
"Rule does not fire: first condition not met")))
(let [afn (compile-rule "if state is new and altitude is 0 then state should be water")]
(is (= (apply afn (list {:state :new :altitude 0} nil))
{:state :water :altitude 0})
"Rule fires when conditions are met")
(is (nil? (apply afn (list {:state :new :altitude 5} nil)))
"Rule does not fire: second condition not met")
(is (nil? (apply afn (list {:state :forest :altitude 0} nil)))
"Rule does not fire: first condition not met")))
(testing "Condition disjunction rule"
(let [afn (compile-rule "if state is new or state is waste then state should be grassland")]
(is (= (apply afn (list {:state :new} nil))
{:state :grassland})
"Rule fires: first condition met")
(is (= (apply afn (list {:state :waste} nil))
{:state :grassland})
"Rule fires: second condition met")
(is (nil? (apply afn (list {:state :forest} nil)))
"Rule does not fire: neither condition met")))
(let [afn (compile-rule "if state is new or state is waste then state should be grassland")]
(is (= (apply afn (list {:state :new} nil))
{:state :grassland})
"Rule fires: first condition met")
(is (= (apply afn (list {:state :waste} nil))
{:state :grassland})
"Rule fires: second condition met")
(is (nil? (apply afn (list {:state :forest} nil)))
"Rule does not fire: neither condition met")))
(testing "Simple negation rule"
(let [afn (compile-rule "if state is not new then state should be grassland")]
(is (nil? (apply afn (list {:state :new} nil)))
"Rule doesn't fire when condition isn't met")
(is (= (apply afn (list {:state :forest} nil))
{:state :grassland})
"Rule fires when condition is met")))
(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?
(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 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'"))
"Exception thrown on attempt to set 'y'"))
(testing "Simple list membership rule"
(let [afn (compile-rule "if state is in heath or scrub or forest then state should be climax")]
(is (= (apply afn (list {:state :heath} nil))
{:state :climax})
"Rule fires when condition is met")
(is (= (apply afn (list {:state :scrub} nil))
{:state :climax})
"Rule fires when condition is met")
(is (= (apply afn (list {:state :forest} nil))
{:state :climax})
"Rule fires when condition is met")
(is (nil? (apply afn (list {:state :grassland} nil)))
"Rule does not fire when condition is not met")))
(let [afn (compile-rule "if state is in heath or scrub or forest then state should be climax")]
(is (= (apply afn (list {:state :heath} nil))
{:state :climax})
"Rule fires when condition is met")
(is (= (apply afn (list {:state :scrub} nil))
{:state :climax})
"Rule fires when condition is met")
(is (= (apply afn (list {:state :forest} nil))
{:state :climax})
"Rule fires when condition is met")
(is (nil? (apply afn (list {:state :grassland} nil)))
"Rule does not fire when condition is not met")))
(testing "Negated list membership rule"
(let [afn (compile-rule "if state is not in heath or scrub or forest then state should be climax")]
(is (nil? (apply afn (list {:state :heath} nil)))
"Rule does not fire when condition is not met")
(is (nil? (apply afn (list {:state :scrub} nil)))
"Rule does not fire when condition is not met")
(is (nil? (apply afn (list {:state :forest} nil)))
"Rule does not fire when condition is not met")
(is (= (apply afn (list {:state :grassland} nil))
{:state :climax})
"Rule fires when condition is met")))
(let [afn (compile-rule "if state is not in heath or scrub or forest then state should be climax")]
(is (nil? (apply afn (list {:state :heath} nil)))
"Rule does not fire when condition is not met")
(is (nil? (apply afn (list {:state :scrub} nil)))
"Rule does not fire when condition is not met")
(is (nil? (apply afn (list {:state :forest} nil)))
"Rule does not fire when condition is not met")
(is (= (apply afn (list {:state :grassland} nil))
{:state :climax})
"Rule fires when condition is met")))
(testing "Property is more than numeric-value"
(let [afn (compile-rule "if altitude is more than 200 then state should be snow")]
(is (= (apply afn (list {:altitude 201} nil))
{:state :snow :altitude 201})
"Rule fires when condition is met")
(is (nil? (apply afn (list {:altitude 200} nil)))
"Rule does not fire when condition is not met")))
(let [afn (compile-rule "if altitude is more than 200 then state should be snow")]
(is (= (apply afn (list {:altitude 201} nil))
{:state :snow :altitude 201})
"Rule fires when condition is met")
(is (nil? (apply afn (list {:altitude 200} nil)))
"Rule does not fire when condition is not met")))
;; 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 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")))
(let [afn (compile-rule "if altitude is less than 10 then state should be water")]
(is (= (apply afn (list {:altitude 9} nil))
{:state :water :altitude 9})
"Rule fires when condition is met")
(is (nil? (apply afn (list {:altitude 10} nil)))
"Rule does not fire when condition is not met")))
(testing "Property is less than property"
(let [afn (compile-rule "if wolves are less than deer then deer should be deer - wolves")]
(is (= (apply afn (list {:deer 3 :wolves 2} nil))
{:deer 1 :wolves 2})
"Rule fires when condition is met")
(is (nil? (apply afn (list {:deer 2 :wolves 3} nil)))
"Rule does not fire when condition is not met")))
(let [afn (compile-rule "if wolves are less than deer then deer should be deer - wolves")]
(is (= (apply afn (list {:deer 3 :wolves 2} nil))
{:deer 1 :wolves 2})
"Rule fires when condition is met")
(is (nil? (apply afn (list {:deer 2 :wolves 3} nil)))
"Rule does not fire when condition is not met")))
(testing "Number neighbours have property equal to value"
(let [afn (compile-rule "if 3 neighbours have state equal to new then state should be water")
world (make-world 3 3)]
(is (= (apply afn (list {:x 0 :y 0} world))
{:state :water :x 0 :y 0})
"Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell has eight neighbours, so rule does not fire."))
(let [afn (compile-rule "if 3 neighbours are new then state should be water")
world (make-world 3 3)]
;; '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.")))
(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.")))
;; 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.")))
(let [afn (compile-rule "if 5 neighbours have altitude less than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has two high neighbours, so rule should not fire.")))
(testing "More than number neighbours have property equal to numeric-value"
(let [afn (compile-rule "if more than 2 neighbours have altitude equal to 11 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has only two high neighbours, so rule should not fire.")))
(let [afn (compile-rule "if more than 2 neighbours have altitude equal to 11 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has only two high neighbours, so rule should not fire.")))
(testing "More than number neighbours have property equal to symbolic-value"
(let [afn (compile-rule "if more than 2 neighbours have state equal to grassland then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland")
(compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has only two high neighbours, so rule should not fire."))
(let [afn (compile-rule "if more than 2 neighbours are grassland then state should be beach")
;; '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."))
)
(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.")))
(let [afn (compile-rule "if fewer than 3 neighbours have altitude equal to 11 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
"Rule fires when condition is met (Middle cell of the strip has only two high neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell of world has three high neighbours, so rule should not fire.")))
(testing "Fewer than number neighbours have property equal to symbolic-value"
(let [afn (compile-rule "if fewer than 3 neighbours have state equal to grassland then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland")
(compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))]
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
"Rule fires when condition is met (Middle cell of the strip has only two high neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell of world has three high neighbours, so rule should not fire.")))
(let [afn (compile-rule "if fewer than 3 neighbours have state equal to grassland then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland")
(compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))]
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
"Rule fires when condition is met (Middle cell of the strip has only two high neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell of world has three high neighbours, so rule should not fire.")))
;; some neighbours have property equal to value
;; some neighbours have property equal to value
(testing "Some neighbours have property equal to numeric-value"
(let [afn (compile-rule "if some neighbours have altitude equal to 11 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire.")))
(let [afn (compile-rule "if some neighbours have altitude equal to 11 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire.")))
(testing "Some neighbours have property equal to symbolic-value"
(let [afn (compile-rule "if some neighbours have state equal to grassland then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland")
(compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire.")))
(let [afn (compile-rule "if some neighbours have state equal to grassland then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland")
(compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire.")))
;; more than number neighbours have property more than numeric-value
;; more than number neighbours have property more than numeric-value
(testing "More than number neighbours have property more than symbolic-value"
(let [afn (compile-rule "if more than 2 neighbours have altitude more than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland")
(compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has only two high neighbours, so rule should not fire.")))
(let [afn (compile-rule "if more than 2 neighbours have altitude more than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland")
(compile-rule "if x is less than 2 then altitude should be 0 and state should be water")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has only two high neighbours, so rule should not fire.")))
;; fewer than number neighbours have property more than numeric-value
;; fewer than number neighbours have property more than numeric-value
(testing "Fewer than number neighbours have property more than numeric-value"
(let [afn (compile-rule "if fewer than 3 neighbours have altitude more than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
"Rule fires when condition is met (Middle cell of the strip has only two high neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell of world has three high neighbours, so rule should not fire.")))
(let [afn (compile-rule "if fewer than 3 neighbours have altitude more than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
"Rule fires when condition is met (Middle cell of the strip has only two high neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell of world has three high neighbours, so rule should not fire.")))
;; some neighbours have property more than numeric-value
;; some neighbours have property more than numeric-value
(testing "Some neighbours have property more than numeric-value"
(let [afn (compile-rule "if some neighbours have altitude more than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire.")))
(let [afn (compile-rule "if some neighbours have altitude more than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire.")))
;; more than number neighbours have property less than numeric-value
;; more than number neighbours have property less than numeric-value
(testing "More than number neighbours have property less than numeric-value"
(let [afn (compile-rule "if more than 4 neighbours have altitude less than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has only three low neighbours, so rule should not fire.")))
(let [afn (compile-rule "if more than 4 neighbours have altitude less than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has only three low neighbours, so rule should not fire.")))
;; fewer than number neighbours have property less than numeric-value
;; fewer than number neighbours have property less than numeric-value
(testing "Fewer than number neighbours have property less than numeric-value"
(let [afn (compile-rule "if fewer than 4 neighbours have altitude less than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Centre cell has five low neighbours, so rule should not fire")
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
"Middle cell of the strip has only three low neighbours, so rule should fire.")))
(let [afn (compile-rule "if fewer than 4 neighbours have altitude less than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Centre cell has five low neighbours, so rule should not fire")
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
"Middle cell of the strip has only three low neighbours, so rule should fire.")))
;; some neighbours have property less than numeric-value
;; some neighbours have property less than numeric-value
(testing "Some number neighbours have property less than numeric-value"
(let [afn (compile-rule "if some neighbours have altitude less than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is less than 2 then altitude should be 11")
(compile-rule "if x is 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 0 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left of world is all high, so rule should not fire.")))
(let [afn (compile-rule "if some neighbours have altitude less than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is less than 2 then altitude should be 11")
(compile-rule "if x is 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 0 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left of world is all high, so rule should not fire.")))
;; 'single action' already tested in 'condition' tests above
;; action and actions
;; 'single action' already tested in 'condition' tests above
;; action and actions
(testing "Conjunction of actions"
(let [afn (compile-rule "if state is new then state should be grassland and fertility should be 0")]
(is (= (apply afn (list {:state :new} nil))
{:state :grassland :fertility 0})
"Both actions are executed")))
(let [afn (compile-rule "if state is new then state should be grassland and fertility should be 0")]
(is (= (apply afn (list {:state :new} nil))
{:state :grassland :fertility 0})
"Both actions are executed")))
;; 'property should be symbolic-value' and 'property should be numeric-value'
;; already tested in tests above
;; 'property should be symbolic-value' and 'property should be numeric-value'
;; already tested in tests above
;; number chance in number property should be value
;; number chance in number property should be value
(testing "Syntax of probability rule - action of real probability very hard to test"
(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")))
(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
;; property operator numeric-value
(testing "Arithmetic action: addition of number"
(let [afn (compile-rule "if state is climax then fertility should be fertility + 1")]
(is (= (:fertility
(apply afn (list {:state :climax :fertility 0} nil)))
1)
"Addition is executed")))
(let [afn (compile-rule "if state is climax then fertility should be fertility + 1")]
(is (= (:fertility
(apply afn (list {:state :climax :fertility 0} nil)))
1)
"Addition is executed")))
(testing "Arithmetic action: addition of property value"
(let [afn (compile-rule "if state is climax then fertility should be fertility + leaf-fall")]
(is (= (:fertility
(apply afn
(list {:state :climax
:fertility 0
:leaf-fall 1} nil)))
1)
"Addition is executed")))
(let [afn (compile-rule "if state is climax then fertility should be fertility + 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")))
(let [afn (compile-rule "if state is crop then fertility should be fertility - 1")]
(is (= (:fertility
(apply afn (list {:state :crop :fertility 2} nil)))
1)
"Action is executed")))
(testing "Arithmetic action: subtraction of property value"
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer - wolves")]
(is (= (:deer
(apply afn
(list {:deer 3
:wolves 2} nil)))
1)
"Action is executed")))
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer - wolves")]
(is (= (:deer
(apply afn
(list {:deer 3
:wolves 2} nil)))
1)
"Action is executed")))
(testing "Arithmetic action: multiplication by number"
(let [afn (compile-rule "if deer are more than 1 then deer should be deer * 2")]
(is (= (:deer
(apply afn (list {:deer 2} nil)))
4)
"Action is executed")))
(let [afn (compile-rule "if deer are more than 1 then deer should be deer * 2")]
(is (= (:deer
(apply afn (list {:deer 2} nil)))
4)
"Action is executed")))
(testing "Arithmetic action: multiplication by property value"
(let [afn (compile-rule "if state is crop then deer should be deer * deer")]
(is (= (:deer
(apply afn
(list {:state :crop :deer 2} nil)))
4)
"Action is executed")))
(let [afn (compile-rule "if state is crop then deer should be deer * deer")]
(is (= (:deer
(apply afn
(list {:state :crop :deer 2} nil)))
4)
"Action is executed")))
(testing "Arithmetic action: division by number"
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer / 2")]
(is (= (:deer
(apply afn (list {:deer 2 :wolves 1} nil)))
1)
"Action is executed")))
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer / 2")]
(is (= (:deer
(apply afn (list {:deer 2 :wolves 1} nil)))
1)
"Action is executed")))
(testing "Arithmetic action: division by property value"
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer / wolves")]
(is (= (:deer
(apply afn
(list {:deer 2 :wolves 2} nil)))
1)
"Action is executed")))
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer / wolves")]
(is (= (:deer
(apply afn
(list {:deer 2 :wolves 2} nil)))
1)
"Action is executed")))
;; simple within distance
;; simple within distance
(testing "Number neighbours within distance have property equal to value"
(let [afn (compile-rule "if 8 neighbours within 2 have state equal to new then state should be water")
world (make-world 5 5)]
(is (= (apply afn (list {:x 0 :y 0} world))
{:state :water :x 0 :y 0})
"Rule fires when condition is met (in a new world all cells are new, corner cell has eight neighbours within two)")
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell has twenty-four neighbours within two, so rule does not fire.")))
(let [afn (compile-rule "if 8 neighbours within 2 have state equal to new then state should be water")
world (make-world 5 5)]
(is (= (apply afn (list {:x 0 :y 0} world))
{:state :water :x 0 :y 0})
"Rule fires when condition is met (in a new world all cells are new, corner cell has eight neighbours within two)")
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell has twenty-four neighbours within two, so rule does not fire.")))
;; comparator within distance
;; 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."))
(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."))))

57
test/mw_parser/generate_test.clj Normal file
View file

@ -0,0 +1,57 @@
(ns mw-parser.generate-test
(:use clojure.pprint
mw-engine.core
mw-engine.world
mw-engine.utils
mw-parser.utils)
(:require [clojure.test :refer :all]
[mw-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}))))
))