Further substantial progress made, but it still doesn't completely work.

This commit is contained in:
Simon Brooke 2015-12-29 14:11:36 +00:00
parent b08881a99e
commit 77c7dc4a91
2 changed files with 98 additions and 42 deletions

View file

@ -31,53 +31,71 @@
(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
(is (generate
'(:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")))
'(= (:state cell) :forest))
(is (generate-property-condition
(is (generate
'(:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "10")))
'(= (:fertility cell) 10))
(is (generate-property-condition '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:LESS "less"]] (:NUMBER "10")))
(is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:LESS "less"]] (:NUMBER "10")))
'(< (:fertility cell) 10))
(is (generate-property-condition '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:MORE "more"]] (:NUMBER "10")))
(is (generate '(:PROPERTY-CONDITION (:SYMBOL "fertility") [:COMPARATIVE [:MORE "more"]] (:NUMBER "10")))
'(> (:fertility cell) 10))
(is (generate-conjunct-condition '(:CONJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:AND "and") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "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 '(:DISJUNCT-CONDITION (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:OR "or") (:PROPERTY-CONDITION (:SYMBOL "fertility") [:EQUIVALENCE [:IS "is"]] (:NUMBER "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 left-hand-side fragments of rule functions from appropriate fragments of parse trees"
(is (generate-simple-action
(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
(is (generate
'(:SIMPLE-ACTION (:SYMBOL "fertility") (:BECOMES "should be") (:NUMBER "10")))
'(merge cell {:fertility 10}))
))
(deftest full-generation-tests
(testing "Full rule generation from pre-parsed tree"
(is (generate '(:RULE (:IF "if") (:PROPERTY-CONDITION (:SYMBOL "state") [:EQUIVALENCE [:IS "is"]] (:SYMBOL "forest")) (:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax"))))
'(fn [cell world] (if (= (:state cell) :forest) (merge cell {:state :climax}))))
))
(deftest exception-tests
(testing "Constructions which should cause exceptions to be thrown"
(is (thrown-with-msg? Exception #"^I did not understand.*"
(compile-rule "the quick brown fox jumped over the lazy dog"))
"Exception thrown if rule text does not match grammar")
;; (is (thrown-with-msg?
;; Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
;; (compile-rule "if state is new then x should be 0"))
;; "Exception thrown on attempt to set 'x'")
;; (is (thrown-with-msg?
;; Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
;; (compile-rule "if state is new then y should be 0"))
;; "Exception thrown on attempt to set 'y'")
;; (is (thrown? Exception (compile-rule "if state is new then x should be 0"))
;; "Can't set x property to number, as this would break the world")
;; (is (thrown? Exception (compile-rule "if state is new then y should be 0"))
;; "Can't set y property to number, as this would break the world")
;; (is (thrown? Exception (compile-rule "if state is new then x should be heath"))
;; "Can't set x property to symbol, as this would break the world")
;; (is (thrown? Exception (compile-rule "if state is new then y should be heath"))
;; "Can't set y property to symbol, as this would break the world")
(is (thrown-with-msg? Exception #"^I did not understand.*"
(compile-rule "if i have a cat on my lap then everything is fine"))
"Exception thrown if rule text does not match grammar")
(is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
(compile-rule "if state is new then x should be 0"))
"Exception thrown on attempt to set 'x'")
(is (thrown-with-msg?
Exception #"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions"
(compile-rule "if state is new then y should be 0"))
"Exception thrown on attempt to set 'y'")
))
(deftest compilation-tests
(testing "Full compilation of rules"
))