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

Substantially closer to the declarative parser fully working, but not

Browse source 
yet perfect.
This commit is contained in:
simon 2016-08-10 13:30:15 +01:00
parent 00e8a25144
commit 1c6ceb899c
2 changed files with 353 additions and 340 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
src/mw_parser/declarative.clj
View file

@ -11,7 +11,7 @@
;; (1) rule text ;; (1) rule text
;; (2) cursor showing where in the rule text the error occurred ;; (2) cursor showing where in the rule text the error occurred
;; (3) the reason for the error ;; (3) the reason for the error
(def bad-parse-error "I did not understand:\n'%s'\n%s\n%s") (def bad-parse-error "I did not understand:\n '%s'\n %s\n %s")
(def grammar (def grammar
@ -171,7 +171,11 @@
(assert-type tree :PROPERTY-CONDITION) (assert-type tree :PROPERTY-CONDITION)
(let [property (generate (nth tree 1)) (let [property (generate (nth tree 1))
qualifier (generate (nth tree 2)) qualifier (generate (nth tree 2))
expression (generate (nth tree 3))] 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 (case expression-type
:DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression) :DISJUNCT-EXPRESSION (generate-disjunct-property-condition tree property qualifier expression)
:RANGE-EXPRESSION (generate-ranged-property-condition tree property expression) :RANGE-EXPRESSION (generate-ranged-property-condition tree property expression)
@ -207,9 +211,13 @@
(defn generate-numeric-expression (defn generate-numeric-expression
[tree] [tree]
(assert-type tree :NUMERIC-EXPRESSION) (assert-type tree :NUMERIC-EXPRESSION)
(case (first (second tree)) (case (count tree)
:SYMBOL (list (keyword (second (second tree))) 'cell) 4 (let [[p operator expression] (rest tree)
(generate (second 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 (defn generate-neighbours-condition
@ -270,6 +278,7 @@
:SIMPLE-ACTION (generate-simple-action tree) :SIMPLE-ACTION (generate-simple-action tree)
:SYMBOL (keyword (second tree)) :SYMBOL (keyword (second tree))
:VALUE (generate (second tree)) :VALUE (generate (second tree))
:OPERATOR (symbol (second tree))
(map generate tree)) (map generate tree))
tree)) tree))

674
test/mw_parser/declarative_test.clj
View file

@ -39,6 +39,10 @@
'(:sealevel cell)) '(:sealevel cell))
)) ))
(deftest comparative-tests
(testing "Parsing comparatives."
))
(deftest lhs-generators-tests (deftest lhs-generators-tests
(testing "Generating left-hand-side fragments of rule functions from appropriate fragments of parse trees" (testing "Generating left-hand-side fragments of rule functions from appropriate fragments of parse trees"
(is (generate (is (generate
@ -100,418 +104,418 @@
;; these are, in so far as possible, the same as the correctness-tests in core-tests - i.e., the two compilers ;; these are, in so far as possible, the same as the correctness-tests in core-tests - i.e., the two compilers
;; compile the same language. ;; compile the same language.
(testing "Simplest possible rule" (testing "Simplest possible rule"
(let [afn (compile-rule "if state is new then state should be grassland")] (let [afn (compile-rule "if state is new then state should be grassland")]
(is (= (apply afn (list {:state :new} nil)) (is (= (apply afn (list {:state :new} nil))
{:state :grassland}) {:state :grassland})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (nil? (apply afn (list {:state :forest} nil))) (is (nil? (apply afn (list {:state :forest} nil)))
"Rule doesn't fire when condition isn't met"))) "Rule doesn't fire when condition isn't met")))
(testing "Condition conjunction rule" (testing "Condition conjunction rule"
(let [afn (compile-rule "if state is new and altitude is 0 then state should be water")] (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)) (is (= (apply afn (list {:state :new :altitude 0} nil))
{:state :water :altitude 0}) {:state :water :altitude 0})
"Rule fires when conditions are met") "Rule fires when conditions are met")
(is (nil? (apply afn (list {:state :new :altitude 5} nil))) (is (nil? (apply afn (list {:state :new :altitude 5} nil)))
"Rule does not fire: second condition not met") "Rule does not fire: second condition not met")
(is (nil? (apply afn (list {:state :forest :altitude 0} nil))) (is (nil? (apply afn (list {:state :forest :altitude 0} nil)))
"Rule does not fire: first condition not met"))) "Rule does not fire: first condition not met")))
(testing "Condition disjunction rule" (testing "Condition disjunction rule"
(let [afn (compile-rule "if state is new or state is waste then state should be grassland")] (let [afn (compile-rule "if state is new or state is waste then state should be grassland")]
(is (= (apply afn (list {:state :new} nil)) (is (= (apply afn (list {:state :new} nil))
{:state :grassland}) {:state :grassland})
"Rule fires: first condition met") "Rule fires: first condition met")
(is (= (apply afn (list {:state :waste} nil)) (is (= (apply afn (list {:state :waste} nil))
{:state :grassland}) {:state :grassland})
"Rule fires: second condition met") "Rule fires: second condition met")
(is (nil? (apply afn (list {:state :forest} nil))) (is (nil? (apply afn (list {:state :forest} nil)))
"Rule does not fire: neither condition met"))) "Rule does not fire: neither condition met")))
(testing "Simple negation rule" (testing "Simple negation rule"
(let [afn (compile-rule "if state is not new then state should be grassland")] (let [afn (compile-rule "if state is not new then state should be grassland")]
(is (nil? (apply afn (list {:state :new} nil))) (is (nil? (apply afn (list {:state :new} nil)))
"Rule doesn't fire when condition isn't met") "Rule doesn't fire when condition isn't met")
(is (= (apply afn (list {:state :forest} nil)) (is (= (apply afn (list {:state :forest} nil))
{:state :grassland}) {:state :grassland})
"Rule fires when condition is met"))) "Rule fires when condition is met")))
(testing "Can't set x or y properties" (testing "Can't set x or y properties"
(is (thrown-with-msg? (is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
(compile-rule "if state is new then x should be 0")) (compile-rule "if state is new then x should be 0"))
"Exception thrown on attempt to set 'x'") "Exception thrown on attempt to set 'x'")
(is (thrown-with-msg? (is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions" Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
(compile-rule "if state is new then y should be 0")) (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" (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-rule "if state is in heath or scrub or forest then state should be climax")]
(is (= (apply afn (list {:state :heath} nil)) (is (= (apply afn (list {:state :heath} nil))
{:state :climax}) {:state :climax})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (= (apply afn (list {:state :scrub} nil)) (is (= (apply afn (list {:state :scrub} nil))
{:state :climax}) {:state :climax})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (= (apply afn (list {:state :forest} nil)) (is (= (apply afn (list {:state :forest} nil))
{:state :climax}) {:state :climax})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (nil? (apply afn (list {:state :grassland} nil))) (is (nil? (apply afn (list {:state :grassland} nil)))
"Rule does not fire when condition is not met"))) "Rule does not fire when condition is not met")))
(testing "Negated list membership rule" (testing "Negated list membership rule"
(let [afn (compile-rule "if state is not in heath or scrub or forest then state should be climax")] (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))) (is (nil? (apply afn (list {:state :heath} nil)))
"Rule does not fire when condition is not met") "Rule does not fire when condition is not met")
(is (nil? (apply afn (list {:state :scrub} nil))) (is (nil? (apply afn (list {:state :scrub} nil)))
"Rule does not fire when condition is not met") "Rule does not fire when condition is not met")
(is (nil? (apply afn (list {:state :forest} nil))) (is (nil? (apply afn (list {:state :forest} nil)))
"Rule does not fire when condition is not met") "Rule does not fire when condition is not met")
(is (= (apply afn (list {:state :grassland} nil)) (is (= (apply afn (list {:state :grassland} nil))
{:state :climax}) {:state :climax})
"Rule fires when condition is met"))) "Rule fires when condition is met")))
(testing "Property is more than numeric-value" (testing "Property is more than numeric-value"
(let [afn (compile-rule "if altitude is more than 200 then state should be snow")] (let [afn (compile-rule "if altitude is more than 200 then state should be snow")]
(is (= (apply afn (list {:altitude 201} nil)) (is (= (apply afn (list {:altitude 201} nil))
{:state :snow :altitude 201}) {:state :snow :altitude 201})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (nil? (apply afn (list {:altitude 200} nil))) (is (nil? (apply afn (list {:altitude 200} nil)))
"Rule does not fire when condition is not met"))) "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"
;; (testing "Property is more than property" (let [afn (compile-rule "if wolves are more than deer then deer should be 0")]
;; (let [afn (compile-rule "if wolves are more than deer then deer should be 0")] (is (= (apply afn (list {:deer 2 :wolves 3} nil))
;; (is (= (apply afn (list {:deer 2 :wolves 3} nil)) {:deer 0 :wolves 3})
;; {:deer 0 :wolves 3}) "Rule fires when condition is met")
;; "Rule fires when condition is met") (is (nil? (apply afn (list {:deer 3 :wolves 2} nil)))
;; (is (nil? (apply afn (list {:deer 3 :wolves 2} nil))) "Rule does not fire when condition is not met")))
;; "Rule does not fire when condition is not met")))
(testing "Property is less than numeric-value" (testing "Property is less than numeric-value"
(let [afn (compile-rule "if altitude is less than 10 then state should be water")] (let [afn (compile-rule "if altitude is less than 10 then state should be water")]
(is (= (apply afn (list {:altitude 9} nil)) (is (= (apply afn (list {:altitude 9} nil))
{:state :water :altitude 9}) {:state :water :altitude 9})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (nil? (apply afn (list {:altitude 10} nil))) (is (nil? (apply afn (list {:altitude 10} nil)))
"Rule does not fire when condition is not met"))) "Rule does not fire when condition is not met")))
(testing "Property is less than property" (testing "Property is less than property"
(let [afn (compile-rule "if wolves are less than deer then deer should be deer - wolves")] (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)) (is (= (apply afn (list {:deer 3 :wolves 2} nil))
{:deer 1 :wolves 2}) {:deer 1 :wolves 2})
"Rule fires when condition is met") "Rule fires when condition is met")
(is (nil? (apply afn (list {:deer 2 :wolves 3} nil))) (is (nil? (apply afn (list {:deer 2 :wolves 3} nil)))
"Rule does not fire when condition is not met"))) "Rule does not fire when condition is not met")))
(testing "Number neighbours have property equal to value" (testing "Number neighbours have property equal to value"
(let [afn (compile-rule "if 3 neighbours have state equal to new then state should be water") (let [afn (compile-rule "if 3 neighbours have state equal to new then state should be water")
world (make-world 3 3)] world (make-world 3 3)]
(is (= (apply afn (list {:x 0 :y 0} world)) (is (= (apply afn (list {:x 0 :y 0} world))
{:state :water :x 0 :y 0}) {:state :water :x 0 :y 0})
"Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)") "Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell has eight neighbours, so rule does not fire.")) "Middle cell has eight neighbours, so rule does not fire."))
(let [afn (compile-rule "if 3 neighbours are new then state should be water") (let [afn (compile-rule "if 3 neighbours are new then state should be water")
world (make-world 3 3)] world (make-world 3 3)]
;; 'are new' and 'is new' should be the same as 'have state equal to new' ;; 'are new' and 'is new' should be the same as 'have state equal to new'
(is (= (apply afn (list {:x 0 :y 0} world)) (is (= (apply afn (list {:x 0 :y 0} world))
{:state :water :x 0 :y 0}) {:state :water :x 0 :y 0})
"Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)") "Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell has eight neighbours, so rule does not fire.")) "Middle cell has eight neighbours, so rule does not fire."))
(let [afn (compile-rule "if 3 neighbours is new then state should be water") (let [afn (compile-rule "if 3 neighbours is new then state should be water")
world (make-world 3 3)] world (make-world 3 3)]
;; 'are new' and 'is new' should be the same as 'have state equal to new' ;; 'are new' and 'is new' should be the same as 'have state equal to new'
(is (= (apply afn (list {:x 0 :y 0} world)) (is (= (apply afn (list {:x 0 :y 0} world))
{:state :water :x 0 :y 0}) {:state :water :x 0 :y 0})
"Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)") "Rule fires when condition is met (in a new world all cells are new, corner cell has three neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell has eight neighbours, so rule does not fire."))) "Middle cell has eight neighbours, so rule does not fire.")))
(testing "Number neighbours have property more than numeric-value" (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") ;; if 3 neighbours have altitude more than 10 then state should be beach
world (transform-world (let [afn (compile-rule "if 3 neighbours have altitude more than 10 then state should be beach")
(make-world 3 3) world (transform-world
(list (compile-rule "if x is 2 then altitude should be 11") (make-world 3 3)
(compile-rule "if x is less than 2 then altitude should be 0")))] (list (compile-rule "if x is 2 then altitude should be 11")
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (compile-rule "if x is less than 2 then altitude should be 0")))]
"Rule fires when condition is met (strip of altitude 11 down right hand side)") (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
(is (nil? (apply afn (list {:x 2 :y 1} world))) "Rule fires when condition is met (strip of altitude 11 down right hand side)")
"Middle cell of the strip has only two high neighbours, so rule should not fire."))) (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" (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-rule "if 5 neighbours have altitude less than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has two high neighbours, so rule should not fire."))) "Middle cell of the strip has two high neighbours, so rule should not fire.")))
(testing "More than number neighbours have property equal to numeric-value" (testing "More than number neighbours have property equal to numeric-value"
(let [afn (compile-rule "if more than 2 neighbours have altitude equal to 11 then state should be beach") (let [afn (compile-rule "if more than 2 neighbours have altitude equal to 11 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has only two high neighbours, so rule should not fire."))) "Middle cell of the strip has only two high neighbours, so rule should not fire.")))
(testing "More than number neighbours have property equal to symbolic-value" (testing "More than number neighbours have property equal to symbolic-value"
(let [afn (compile-rule "if more than 2 neighbours have state equal to grassland then state should be beach") (let [afn (compile-rule "if more than 2 neighbours have state equal to grassland then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has only two high neighbours, so rule should not fire.")) "Middle cell of the strip has only two high neighbours, so rule should not fire."))
(let [afn (compile-rule "if more than 2 neighbours are grassland then state should be beach") (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'. ;; 'are grassland' should mean the same as 'have state equal to grassland'.
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has only two high neighbours, so rule should not fire.")) "Middle cell of the strip has only two high neighbours, so rule should not fire."))
) )
(testing "Fewer than number neighbours have property equal to numeric-value" (testing "Fewer than number neighbours have property equal to numeric-value"
(let [afn (compile-rule "if fewer than 3 neighbours have altitude equal to 11 then state should be beach") (let [afn (compile-rule "if fewer than 3 neighbours have altitude equal to 11 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
"Rule fires when condition is met (Middle cell of the strip has only two high neighbours)") "Rule fires when condition is met (Middle cell of the strip has only two high neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell of world has three high neighbours, so rule should not fire."))) "Middle cell of world has three high neighbours, so rule should not fire.")))
(testing "Fewer than number neighbours have property equal to symbolic-value" (testing "Fewer than number neighbours have property equal to symbolic-value"
(let [afn (compile-rule "if fewer than 3 neighbours have state equal to grassland then state should be beach") (let [afn (compile-rule "if fewer than 3 neighbours have state equal to grassland then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
"Rule fires when condition is met (Middle cell of the strip has only two high neighbours)") "Rule fires when condition is met (Middle cell of the strip has only two high neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell of world has three high neighbours, so rule should not fire."))) "Middle cell of world has three high neighbours, so rule should not fire.")))
;; some neighbours have property equal to value ;; some neighbours have property equal to value
(testing "Some neighbours have property equal to numeric-value" (testing "Some neighbours have property equal to numeric-value"
(let [afn (compile-rule "if some neighbours have altitude equal to 11 then state should be beach") (let [afn (compile-rule "if some neighbours have altitude equal to 11 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire."))) "Left hand side of world has no high neighbours, so rule should not fire.")))
(testing "Some neighbours have property equal to symbolic-value" (testing "Some neighbours have property equal to symbolic-value"
(let [afn (compile-rule "if some neighbours have state equal to grassland then state should be beach") (let [afn (compile-rule "if some neighbours have state equal to grassland then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire."))) "Left hand side of world has no high neighbours, so rule should not fire.")))
;; more than number neighbours have property more than numeric-value ;; more than number neighbours have property more than numeric-value
(testing "More than number neighbours have property more than symbolic-value" (testing "More than number neighbours have property more than symbolic-value"
(let [afn (compile-rule "if more than 2 neighbours have altitude more than 10 then state should be beach") (let [afn (compile-rule "if more than 2 neighbours have altitude more than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11 and state should be grassland") (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")))] (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) (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has only two high neighbours, so rule should not fire."))) "Middle cell of the strip has only two high neighbours, so rule should not fire.")))
;; fewer than number neighbours have property more than numeric-value ;; fewer than number neighbours have property more than numeric-value
(testing "Fewer than number neighbours have property more than numeric-value" (testing "Fewer than number neighbours have property more than numeric-value"
(let [afn (compile-rule "if fewer than 3 neighbours have altitude more than 10 then state should be beach") (let [afn (compile-rule "if fewer than 3 neighbours have altitude more than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
"Rule fires when condition is met (Middle cell of the strip has only two high neighbours)") "Rule fires when condition is met (Middle cell of the strip has only two high neighbours)")
(is (nil? (apply afn (list {:x 1 :y 1} world))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell of world has three high neighbours, so rule should not fire."))) "Middle cell of world has three high neighbours, so rule should not fire.")))
;; some neighbours have property more than numeric-value ;; some neighbours have property more than numeric-value
(testing "Some neighbours have property more than numeric-value" (testing "Some neighbours have property more than numeric-value"
(let [afn (compile-rule "if some neighbours have altitude more than 10 then state should be beach") (let [afn (compile-rule "if some neighbours have altitude more than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left hand side of world has no high neighbours, so rule should not fire."))) "Left hand side of world has no high neighbours, so rule should not fire.")))
;; more than number neighbours have property less than numeric-value ;; more than number neighbours have property less than numeric-value
(testing "More than number neighbours have property less than numeric-value" (testing "More than number neighbours have property less than numeric-value"
(let [afn (compile-rule "if more than 4 neighbours have altitude less than 10 then state should be beach") (let [afn (compile-rule "if more than 4 neighbours have altitude less than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 2 :y 1} world))) (is (nil? (apply afn (list {:x 2 :y 1} world)))
"Middle cell of the strip has only three low neighbours, so rule should not fire."))) "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" (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-rule "if fewer than 4 neighbours have altitude less than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11") (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")))] (compile-rule "if x is less than 2 then altitude should be 0")))]
(is (nil? (apply afn (list {:x 1 :y 1} world))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Centre cell has five low neighbours, so rule should not fire") "Centre cell has five low neighbours, so rule should not fire")
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach) (is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
"Middle cell of the strip has only three low neighbours, so rule should fire."))) "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" (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-rule "if some neighbours have altitude less than 10 then state should be beach")
world (transform-world world (transform-world
(make-world 3 3) (make-world 3 3)
(list (compile-rule "if x is less than 2 then altitude should be 11") (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")))] (compile-rule "if x is 2 then altitude should be 0")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach) (is (= (:state (apply afn (list {:x 1 :y 1} world))) :beach)
"Rule fires when condition is met (strip of altitude 0 down right hand side)") "Rule fires when condition is met (strip of altitude 0 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left of world is all high, so rule should not fire."))) "Left of world is all high, so rule should not fire.")))
;; 'single action' already tested in 'condition' tests above ;; 'single action' already tested in 'condition' tests above
;; action and actions ;; action and actions
(testing "Conjunction of actions" (testing "Conjunction of actions"
(let [afn (compile-rule "if state is new then state should be grassland and fertility should be 0")] (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)) (is (= (apply afn (list {:state :new} nil))
{:state :grassland :fertility 0}) {:state :grassland :fertility 0})
"Both actions are executed"))) "Both actions are executed")))
;; 'property should be symbolic-value' and 'property should be numeric-value' ;; 'property should be symbolic-value' and 'property should be numeric-value'
;; already tested in tests above ;; 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" (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-rule "if state is forest then 5 chance in 5 state should be climax")]
(is (= (:state (apply afn (list {:state :forest} nil))) :climax) (is (= (:state (apply afn (list {:state :forest} nil))) :climax)
"five chance in five should fire every time")) "five chance in five should fire every time"))
(let [afn (compile-rule "if state is forest then 0 chance in 5 state should be climax")] (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))) (is (nil? (apply afn (list {:state :forest} nil)))
"zero chance in five should never fire"))) "zero chance in five should never fire")))
;; property operator numeric-value ;; property operator numeric-value
(testing "Arithmetic action: addition of number" (testing "Arithmetic action: addition of number"
(let [afn (compile-rule "if state is climax then fertility should be fertility + 1")] (let [afn (compile-rule "if state is climax then fertility should be fertility + 1")]
(is (= (:fertility (is (= (:fertility
(apply afn (list {:state :climax :fertility 0} nil))) (apply afn (list {:state :climax :fertility 0} nil)))
1) 1)
"Addition is executed"))) "Addition is executed")))
(testing "Arithmetic action: addition of property value" (testing "Arithmetic action: addition of property value"
(let [afn (compile-rule "if state is climax then fertility should be fertility + leaf-fall")] (let [afn (compile-rule "if state is climax then fertility should be fertility + leaf-fall")]
(is (= (:fertility (is (= (:fertility
(apply afn (apply afn
(list {:state :climax (list {:state :climax
:fertility 0 :fertility 0
:leaf-fall 1} nil))) :leaf-fall 1} nil)))
1) 1)
"Addition is executed"))) "Addition is executed")))
(testing "Arithmetic action: subtraction of number" (testing "Arithmetic action: subtraction of number"
(let [afn (compile-rule "if state is crop then fertility should be fertility - 1")] (let [afn (compile-rule "if state is crop then fertility should be fertility - 1")]
(is (= (:fertility (is (= (:fertility
(apply afn (list {:state :crop :fertility 2} nil))) (apply afn (list {:state :crop :fertility 2} nil)))
1) 1)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: subtraction of property value" (testing "Arithmetic action: subtraction of property value"
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer - wolves")] (let [afn (compile-rule "if wolves are more than 0 then deer should be deer - wolves")]
(is (= (:deer (is (= (:deer
(apply afn (apply afn
(list {:deer 3 (list {:deer 3
:wolves 2} nil))) :wolves 2} nil)))
1) 1)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: multiplication by number" (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-rule "if deer are more than 1 then deer should be deer * 2")]
(is (= (:deer (is (= (:deer
(apply afn (list {:deer 2} nil))) (apply afn (list {:deer 2} nil)))
4) 4)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: multiplication by property value" (testing "Arithmetic action: multiplication by property value"
(let [afn (compile-rule "if state is crop then deer should be deer * deer")] (let [afn (compile-rule "if state is crop then deer should be deer * deer")]
(is (= (:deer (is (= (:deer
(apply afn (apply afn
(list {:state :crop :deer 2} nil))) (list {:state :crop :deer 2} nil)))
4) 4)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: division by number" (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-rule "if wolves are more than 0 then deer should be deer / 2")]
(is (= (:deer (is (= (:deer
(apply afn (list {:deer 2 :wolves 1} nil))) (apply afn (list {:deer 2 :wolves 1} nil)))
1) 1)
"Action is executed"))) "Action is executed")))
(testing "Arithmetic action: division by property value" (testing "Arithmetic action: division by property value"
(let [afn (compile-rule "if wolves are more than 0 then deer should be deer / wolves")] (let [afn (compile-rule "if wolves are more than 0 then deer should be deer / wolves")]
(is (= (:deer (is (= (:deer
(apply afn (apply afn
(list {:deer 2 :wolves 2} nil))) (list {:deer 2 :wolves 2} nil)))
1) 1)
"Action is executed"))) "Action is executed")))
;; simple within distance ;; simple within distance
(testing "Number neighbours within distance have property equal to value" (testing "Number neighbours within distance have property equal to value"
(let [afn (compile-rule "if 8 neighbours within 2 have state equal to new then state should be water") (let [afn (compile-rule "if 8 neighbours within 2 have state equal to new then state should be water")
world (make-world 5 5)] world (make-world 5 5)]
(is (= (apply afn (list {:x 0 :y 0} world)) (is (= (apply afn (list {:x 0 :y 0} world))
{:state :water :x 0 :y 0}) {:state :water :x 0 :y 0})
"Rule fires when condition is met (in a new world all cells are new, corner cell has eight neighbours within two)") "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))) (is (nil? (apply afn (list {:x 1 :y 1} world)))
"Middle cell has twenty-four neighbours within two, so rule does not fire."))) "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" (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-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 ;; 5x5 world, strip of high ground two cells wide down left hand side
;; xxooo ;; xxooo
;; xxooo ;; xxooo
;; xxooo ;; xxooo
;; xxooo ;; xxooo
;; xxooo ;; xxooo
world (transform-world world (transform-world
(make-world 5 5) (make-world 5 5)
(list (compile-rule "if x is less than 2 then altitude should be 11 and state should be grassland") (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")))] (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) (is (= (:state (apply afn (list {:x 2 :y 2} world))) :beach)
"Rule fires when condition is met (strip of altitude 11 down right hand side)") "Rule fires when condition is met (strip of altitude 11 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world))) (is (nil? (apply afn (list {:x 0 :y 1} world)))
"Middle cell of the strip has only two high neighbours, so rule should not fire.")) "Middle cell of the strip has only two high neighbours, so rule should not fire."))
)) ))