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

Continued work on cleaning up the parser

Browse source
This commit is contained in:
Simon Brooke 2023-07-18 22:11:11 +01:00
parent 4de7b0beb4
commit 4b721219bd
5 changed files with 173 additions and 154 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
src/mw_parser/bulk.clj
View file

@ -1,10 +1,9 @@
(ns ^{:doc "parse multiple rules from a stream, possibly a file."
:author "Simon Brooke"}
mw-parser.bulk
(:require [clojure.string :refer [split trim]]
[mw-engine.utils :refer [member?]]
[mw-parser.declarative :refer [compile-rule]])
(:import (java.io BufferedReader StringReader)))
(:require [clojure.string :refer [split]]
[mw-parser.declarative :refer [compile]]
[mw-parser.utils :refer [comment?]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@ -29,16 +28,12 @@
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn comment?
"Is this `line` a comment?"
[line]
(or (empty? (trim line)) (member? (first line) '(nil \# \;))))
(defn parse-string
"Parse rules from successive lines in this `string`, assumed to have multiple
lines delimited by the new-line character. Return a list of S-expressions."
[string]
(map compile-rule
(map compile
(remove comment? (split string #"\n"))))
(defn parse-file
@ -47,14 +42,8 @@
[filename]
(parse-string (slurp filename)))
(defn compile-string
"Compile each non-comment line of this `string` into an executable anonymous
function, and return the sequence of such functions."
[string]
(map #(compile-rule % true) (remove comment? (split string #"\n"))))
(defn compile-file
"Compile each non-comment line of the file indicated by this `filename` into
an executable anonymous function, and return the sequence of such functions."
[filename]
(compile-string (slurp filename)))
(compile (slurp filename) true))

42
src/mw_parser/declarative.clj
View file

@ -1,13 +1,12 @@
(ns ^{:doc "A very simple parser which parses production rules."
:author "Simon Brooke"}
mw-parser.declarative
(:require [clojure.string :refer [join split trim]]
(:require [clojure.string :refer [join split split-lines trim]]
[instaparse.core :refer [parser]]
[mw-parser.errors :refer [throw-parse-exception]]
[mw-parser.flow :refer [flow-grammar]]
[mw-parser.generate :refer [generate]]
[mw-parser.simplify :refer [simplify]]
[mw-parser.utils :refer [rule?]]
[mw-parser.utils :refer [comment?]]
[trptr.java-wrapper.locale :refer [get-default]])
(:import [java.util Locale]))
@ -148,7 +147,7 @@
";;" nil
(throw (ex-info "Rule text was not recognised" {:text text}))))))
(defn compile-rule
(defn compile
"Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules,
into Clojure source, and then compile it into an anonymous
function object, getting round the problem of binding mw-engine.utils in
@ -158,20 +157,23 @@
Throws an exception if parsing fails."
([rule-text return-tuple?]
(let [src (trim rule-text)
parse-tree (simplify (parse src))
fn' (generate parse-tree)
afn (try
(if (= 'fn (first fn'))
(vary-meta (eval fn') merge (meta fn'))
(throw (Exception. (format "Parse of `%s` did not return a functionn" src))))
(catch Exception any (throw (ex-info (.getMessage any)
{:src src
:parse parse-tree
:fn fn'}))))]
(if
return-tuple?
(list afn (trim rule-text))
afn)))
(let [lines (remove comment? (split-lines rule-text))]
(if (> (count lines) 1)
(map #(compile % return-tuple?) lines)
(let [src (trim rule-text)
parse-tree (simplify (parse src))
fn' (generate parse-tree)
afn (try
(if (= 'fn (first fn'))
(vary-meta (eval fn') merge (meta fn'))
(throw (Exception. (format "Parse of `%s` did not return a functionn" src))))
(catch Exception any (throw (ex-info (.getMessage any)
{:src src
:parse parse-tree
:fn fn'}))))]
(if
return-tuple?
(vary-meta (list afn src fn') merge (meta afn))
afn)))))
([rule-text]
(compile-rule rule-text false)))
(compile rule-text false)))

8
src/mw_parser/utils.clj
View file

@ -1,6 +1,8 @@
(ns ^{:doc "Utilities used in more than one namespace within the parser."
:author "Simon Brooke"}
mw-parser.utils)
mw-parser.utils
(:require [clojure.string :refer [trim]]
[mw-engine.utils :refer [member?]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@ -25,6 +27,10 @@
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn comment?
"Is this `line` a comment?"
[line]
(or (empty? (trim line)) (member? (first line) '(nil \# \;))))
(defn suitable-fragment?
"Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`."

166
test/mw_parser/declarative_test.clj
View file

@ -3,7 +3,7 @@
[mw-engine.core :refer [transform-world]]
[mw-engine.utils :refer [get-cell]]
[mw-engine.world :refer [make-world]]
[mw-parser.declarative :refer [compile-rule parse-rule]]
[mw-parser.declarative :refer [compile parse-rule]]
[mw-parser.utils :refer [rule?]]))
(deftest rules-tests
@ -34,18 +34,18 @@
(deftest exception-tests
(testing "Constructions which should cause exceptions to be thrown"
(is (thrown-with-msg? Exception #"^I did not understand.*"
(compile-rule "the quick brown fox jumped over the lazy dog"))
(compile "the quick brown fox jumped over the lazy dog"))
"Exception thrown if rule text does not match grammar")
(is (thrown-with-msg? Exception #"^I did not understand.*"
(compile-rule "if i have a cat on my lap then everything is fine"))
(compile "if i have a cat on my lap then everything is fine"))
"Exception thrown if rule text does not match grammar")
(is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
(compile-rule "if state is new then x should be 0"))
(compile "if state is new then x should be 0"))
"Exception thrown on attempt to set 'x'")
(is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
(compile-rule "if state is new then y should be 0"))
(compile "if state is new then y should be 0"))
"Exception thrown on attempt to set 'y'")))
@ -53,7 +53,7 @@
;; 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")]
(let [afn (compile "if state is new then state should be grassland")]
(is (= (apply afn (list {:state :new} nil))
{:state :grassland})
"Rule fires when condition is met")
@ -61,7 +61,7 @@
"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")]
(let [afn (compile "if state is new and altitude is 0 then state should be water")]
(is (= (apply afn (list {:state :new :altitude 0} nil))
{:state :water :altitude 0})
"Rule fires when conditions are met")
@ -71,7 +71,7 @@
"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")]
(let [afn (compile "if state is new or state is waste then state should be grassland")]
(is (= (apply afn (list {:state :new} nil))
{:state :grassland})
"Rule fires: first condition met")
@ -82,7 +82,7 @@
"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")]
(let [afn (compile "if state is not new then state should be grassland")]
(is (nil? (apply afn (list {:state :new} nil)))
"Rule doesn't fire when condition isn't met")
(is (= (apply afn (list {:state :forest} nil))
@ -92,15 +92,15 @@
(testing "Can't set x or y properties"
(is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
(compile-rule "if state is new then x should be 0"))
(compile "if state is new then x should be 0"))
"Exception thrown on attempt to set 'x'")
(is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
(compile-rule "if state is new then y should be 0"))
(compile "if state is new then y should be 0"))
"Exception thrown on attempt to set 'y'"))
(testing "Simple list membership rule"
(let [afn (compile-rule "if state is in heath or scrub or forest then state should be climax")]
(let [afn (compile "if state is in heath or scrub or forest then state should be climax")]
(is (= (apply afn (list {:state :heath} nil))
{:state :climax})
"Rule fires when condition is met")
@ -114,7 +114,7 @@
"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")]
(let [afn (compile "if state is not in heath or scrub or forest then state should be climax")]
(is (nil? (apply afn (list {:state :heath} nil)))
"Rule does not fire when condition is not met")
(is (nil? (apply afn (list {:state :scrub} nil)))
@ -126,7 +126,7 @@
"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")]
(let [afn (compile "if altitude is more than 200 then state should be snow")]
(is (= (apply afn (list {:altitude 201} nil))
{:state :snow :altitude 201})
"Rule fires when condition is met")
@ -134,7 +134,7 @@
"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")]
(let [afn (compile "if wolves are more than deer then deer should be 0")]
(is (= (apply afn (list {:deer 2 :wolves 3} nil))
{:deer 0 :wolves 3})
"Rule fires when condition is met")
@ -142,7 +142,7 @@
"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")]
(let [afn (compile "if altitude is less than 10 then state should be water")]
(is (= (apply afn (list {:altitude 9} nil))
{:state :water :altitude 9})
"Rule fires when condition is met")
@ -150,7 +150,7 @@
"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")]
(let [afn (compile "if wolves are less than deer then deer should be deer - wolves")]
(is (= (apply afn (list {:deer 3 :wolves 2} nil))
{:deer 1 :wolves 2})
"Rule fires when condition is met")
@ -158,14 +158,14 @@
"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")
(let [afn (compile "if 3 neighbours have state equal to new then state should be water")
world (make-world 3 3)]
(is (= (apply afn (list {:x 0 :y 0} world))
{:state :water :x 0 :y 0})
"Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell has eight neighbours, so rule does not fire."))
(let [afn (compile-rule "if 3 neighbours are new then state should be water")
(let [afn (compile "if 3 neighbours are new then state should be water")
world (make-world 3 3)]
;; 'are new' and 'is new' should be the same as 'have state equal to new'
(is (= (apply afn (list {:x 0 :y 0} world))
@ -173,7 +173,7 @@
"Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell has eight neighbours, so rule does not fire."))
(let [afn (compile-rule "if 3 neighbours is new then state should be water")
(let [afn (compile "if 3 neighbours is new then state should be water")
world (make-world 3 3)]
;; 'are new' and 'is new' should be the same as 'have state equal to new'
(is (= (apply afn (list {:x 0 :y 0} world))
@ -184,76 +184,76 @@
(testing "Number neighbours have property more than numeric-value"
;; if 3 neighbours have altitude more than 10 then state should be beach
(let [afn (compile-rule "if 3 neighbours have altitude more than 10 then state should be beach")
(let [afn (compile "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")))]
(list (compile "if x is 2 then altitude should be 11")
(compile "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")
(let [afn (compile "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")))]
(list (compile "if x is 2 then altitude should be 11")
(compile "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")
(let [afn (compile "if more than 2 neighbours have altitude equal to 11 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(list (compile "if x is 2 then altitude should be 11")
(compile "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")
(let [afn (compile "if more than 2 neighbours have state equal to grassland then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-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")))]
(list (compile "if x is 2 then altitude should be 11 and state should be grassland")
(compile "if x is less than 2 then altitude should be 0 and state should be water")))]
(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")
(let [afn (compile "if more than 2 neighbours are grassland then state should be beach")
;; 'are grassland' should mean the same as 'have state equal to grassland'.
world (transform-world
(make-world 3 3)
(list (compile-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")))]
(list (compile "if x is 2 then altitude should be 11 and state should be grassland")
(compile "if x is less than 2 then altitude should be 0 and state should be water")))]
(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")
(let [afn (compile "if fewer than 3 neighbours have altitude equal to 11 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then altitude should be 0")))]
(list (compile "if x is 2 then altitude should be 11")
(compile "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")
(let [afn (compile "if fewer than 3 neighbours have state equal to grassland then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-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")))]
(list (compile "if x is 2 then altitude should be 11 and state should be grassland")
(compile "if x is less than 2 then altitude should be 0 and state should be water")))]
(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)))
@ -261,22 +261,22 @@
;; 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")
(let [afn (compile "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")))]
(list (compile "if x is 2 then altitude should be 11")
(compile "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")
(let [afn (compile "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")))]
(list (compile "if x is 2 then altitude should be 11 and state should be grassland")
(compile "if x is less than 2 then altitude should be 0 and state should be water")))]
(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)))
@ -284,11 +284,11 @@
;; 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")
(let [afn (compile "if more than 2 neighbours have altitude more than 10 then state should be beach")
world (transform-world
(make-world 3 3)
(list (compile-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")))]
(list (compile "if x is 2 then altitude should be 11 and state should be grassland")
(compile "if x is less than 2 then altitude should be 0 and state should be water")))]
(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)))
@ -296,11 +296,11 @@
;; fewer than number neighbours have property more than numeric-value
(testing "Fewer than number neighbours have property more than numeric-value"
(let [afn (compile-rule "if fewer than 3 neighbours have altitude more than 10 then state should be beach")
(let [afn (compile "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")))]
(list (compile "if x is 2 then altitude should be 11")
(compile "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)))
@ -308,11 +308,11 @@
;; some neighbours have property more than numeric-value
(testing "Some neighbours have property more than numeric-value"
(let [afn (compile-rule "if some neighbours have altitude more than 10 then state should be beach")
(let [afn (compile "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")))]
(list (compile "if x is 2 then altitude should be 11")
(compile "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)))
@ -320,11 +320,11 @@
;; more than number neighbours have property less than numeric-value
(testing "More than number neighbours have property less than numeric-value"
(let [afn (compile-rule "if more than 4 neighbours have altitude less than 10 then state should be beach")
(let [afn (compile "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")))]
(list (compile "if x is 2 then altitude should be 11")
(compile "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)))
@ -332,11 +332,11 @@
;; fewer than number neighbours have property less than numeric-value
(testing "Fewer than number neighbours have property less than numeric-value"
(let [afn (compile-rule "if fewer than 4 neighbours have altitude less than 10 then state should be beach")
(let [afn (compile "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")))]
(list (compile "if x is 2 then altitude should be 11")
(compile "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)
@ -344,11 +344,11 @@
;; 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")
(let [afn (compile "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")))]
(list (compile "if x is less than 2 then altitude should be 11")
(compile "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)))
@ -358,7 +358,7 @@
;; '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")]
(let [afn (compile "if state is new then state should be grassland and fertility should be 0")]
(is (= (apply afn (list {:state :new} nil))
{:state :grassland :fertility 0})
"Both actions are executed")))
@ -368,23 +368,23 @@
;; number chance in number property should be value
(testing "Syntax of probability rule - action of real probability very hard to test"
(let [afn (compile-rule "if state is forest then 5 chance in 5 state should be climax")]
(let [afn (compile "if state is forest then 5 chance in 5 state should be climax")]
(is (= (:state (apply afn (list {:state :forest} nil))) :climax)
"five chance in five should fire every time"))
(let [afn (compile-rule "if state is forest then 0 chance in 5 state should be climax")]
(let [afn (compile "if state is forest then 0 chance in 5 state should be climax")]
(is (nil? (apply afn (list {:state :forest} nil)))
"zero chance in five should never fire")))
;; property operator numeric-value
(testing "Arithmetic action: addition of number"
(let [afn (compile-rule "if state is climax then fertility should be fertility + 1")]
(let [afn (compile "if state is climax then fertility should be fertility + 1")]
(is (= (:fertility
(apply afn (list {:state :climax :fertility 0} nil)))
1)
"Addition is executed")))
(testing "Arithmetic action: addition of property value"
(let [afn (compile-rule "if state is climax then fertility should be fertility + leaffall")]
(let [afn (compile "if state is climax then fertility should be fertility + leaffall")]
(is (= (:fertility
(apply afn
(list {:state :climax
@ -394,14 +394,14 @@
"Addition is executed")))
(testing "Arithmetic action: subtraction of number"
(let [afn (compile-rule "if state is crop then fertility should be fertility - 1")]
(let [afn (compile "if state is crop then fertility should be fertility - 1")]
(is (= (:fertility
(apply afn (list {:state :crop :fertility 2} nil)))
1)
"Action is executed")))
(testing "Arithmetic action: subtraction of property value"
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer - wolves")]
(let [afn (compile "if wolves are more than 0 then deer should be deer - wolves")]
(is (= (:deer
(apply afn
(list {:deer 3
@ -410,14 +410,14 @@
"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")]
(let [afn (compile "if deer are more than 1 then deer should be deer * 2")]
(is (= (:deer
(apply afn (list {:deer 2} nil)))
4)
"Action is executed")))
(testing "Arithmetic action: multiplication by property value"
(let [afn (compile-rule "if state is crop then deer should be deer * deer")]
(let [afn (compile "if state is crop then deer should be deer * deer")]
(is (= (:deer
(apply afn
(list {:state :crop :deer 2} nil)))
@ -425,14 +425,14 @@
"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")]
(let [afn (compile "if wolves are more than 0 then deer should be deer / 2")]
(is (= (:deer
(apply afn (list {:deer 2 :wolves 1} nil)))
1)
"Action is executed")))
(testing "Arithmetic action: division by property value"
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer / wolves")]
(let [afn (compile "if wolves are more than 0 then deer should be deer / wolves")]
(is (= (:deer
(apply afn
(list {:deer 2 :wolves 2} nil)))
@ -441,7 +441,7 @@
;; 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")
(let [afn (compile "if 8 neighbours within 2 have state equal to new then state should be water")
world (make-world 5 5)]
(is (= (apply afn (list {:x 0 :y 0} world))
{:state :water :x 0 :y 0})
@ -451,7 +451,7 @@
;; 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")
(let [afn (compile "if more than 7 neighbours within 2 have state equal to grassland and more than 7 neighbours within 2 have state equal to water then state should be beach")
;; 5x5 world, strip of high ground two cells wide down left hand side
;; xxooo
;; xxooo
@ -460,8 +460,8 @@
;; 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")))]
(list (compile "if x is less than 2 then altitude should be 11 and state should be grassland")
(compile "if x is more than 1 then altitude should be 0 and state should be water")))]
(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)))
@ -469,11 +469,11 @@
(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")
(let [afn (compile "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")))]
(list (compile "if x is 2 then altitude should be 11")
(compile "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)

82
test/mw_parser/generate_test.clj
View file

@ -1,7 +1,10 @@
(ns mw-parser.generate-test
(:require [clojure.test :refer [deftest is testing]]
(:require [clojure.pprint :as pprint]
[clojure.test :refer [deftest is testing]]
[mw-engine.core :refer [apply-rule]]
[mw-engine.utils :refer [get-cell]]
[mw-parser.declarative :refer [compile parse]]
[mw-parser.generate :refer [generate]]
[mw-parser.declarative :refer [parse]]
[mw-parser.simplify :refer [simplify]]))
(deftest expressions-tests
@ -17,18 +20,18 @@
(testing "Generating left-hand-side fragments of rule functions from appropriate fragments of parse trees"
(let [expected '(= (:state cell) (or (:forest cell) :forest))
actual (generate
'(:PROPERTY-CONDITION
(:SYMBOL "state")
[:EQUIVALENCE [:IS "is"]]
(:SYMBOL "forest")))]
'(:PROPERTY-CONDITION
(:SYMBOL "state")
[:EQUIVALENCE [:IS "is"]]
(:SYMBOL "forest")))]
(is (= actual expected)))
(is (= (generate
'(:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))
'(= (:fertility cell) 10)))
'(: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)))
'(< (:fertility cell) 10)))
(is (= (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:MORE "more"]] (:NUMBER "10")))
'(> (:fertility cell) 10)))
'(> (:fertility cell) 10)))
(is (= (generate '(:CONJUNCT-CONDITION
(:PROPERTY-CONDITION
(:SYMBOL "state")
@ -38,9 +41,9 @@
(:SYMBOL "fertility")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:NUMBER "10"))))
'(and (= (:state cell) (or (:forest cell) :forest)) (= (:fertility cell) 10))))
'(and (= (:state cell) (or (:forest cell) :forest)) (= (:fertility cell) 10))))
(is (= (generate '(:DISJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") (:EQUIVALENCE (:IS "is")) (:SYMBOL "forest")) (:PROPERTY-CONDITION (:SYMBOL "fertility") (:EQUIVALENCE (:IS "is")) (:NUMBER "10"))))
'(or (= (:state cell) (or (:forest cell) :forest)) (= (:fertility cell) 10))))
'(or (= (:state cell) (or (:forest cell) :forest)) (= (:fertility cell) 10))))
(is (= (generate '(:PROPERTY-CONDITION
(:SYMBOL "state")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
@ -48,18 +51,18 @@
(:SYMBOL "heath")
(:SYMBOL "scrub")
(:SYMBOL "forest"))))
'(#{:scrub :forest :heath} (:state cell))))
'(#{:scrub :forest :heath} (:state cell))))
(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)))))))
'(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})))
'(: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})))))
'(: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"
@ -87,16 +90,35 @@
(deftest metadata-tests
(testing "Rules have correct metadata"
(let [expected :production
actual (:rule-type
(meta
(generate
(simplify
(parse "if state is house then state should be waste")))))]
(is (= actual expected)))
actual (:rule-type
(meta
(generate
(simplify
(parse "if state is house then state should be waste")))))]
(is (= actual expected)))
(let [expected :flow
actual (:rule-type
(meta
(generate
(simplify
(parse "flow 10% food from house to house within 2 with least food")))))]
(is (= actual expected)))))
actual (:rule-type
(meta
(generate
(simplify
(parse "flow 10% food from house to house within 2 with least food")))))]
(is (= actual expected)))))
(deftest chance-bug-test
(testing "exception thrown when evaluating``"
(let [cell {:y 1, :generation 10,
:state :scrub, :gradient 85,
:x 1, :altitude 92}
world [[{:y 0, :state :new, :x 0} {:y 0, :state :new, :x 1} {:y 0, :state :new, :x 2}]
[{:y 1, :state :new, :x 0} cell {:y 1, :state :new, :x 2}]
[{:y 2, :state :new, :x 0} {:y 2, :state :new, :x 1} {:y 2, :state :new, :x 2}]]
rule (compile "if state is scrub then 1 chance in 5 state should be forest")
expected #{:scrub :forest}
cell' (reduce
(fn [c i] (merge (or (apply-rule world c rule) c) {:i i}))
cell
(range 20))
actual (:state cell')]
(pprint/pprint cell')
(is (expected actual)))))