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

Major overhaul of the parsing of disjunct expressions

Browse source 
... which it turns out have NEVER worked, and badly written tests were masking the problem. Also tagging rules with metadata as first step towards mixing production and flow rules.
This commit is contained in:
Simon Brooke 2023-07-12 20:31:07 +01:00
parent fb39f1ee9c
commit 256f9efd5e
16 changed files with 4997 additions and 778 deletions
Download patch file Download diff file Expand all files Collapse all files

14
test/mw_parser/core_test.clj
View file

@ -1,9 +1,10 @@
(ns mw-parser.core-test
(:use clojure.pprint
mw-engine.core
mw-engine.world)
(:require [clojure.test :refer :all]
[mw-parser.core :refer :all]))
(:require [clojure.test :refer [deftest is testing]]
[mw-engine.core :refer [transform-world]]
[mw-engine.world :refer [make-world]]
[mw-parser.core :refer [compile-rule parse-property-value
parse-rule parse-simple-value
parse-value]]))
(deftest primitives-tests
(testing "Simple functions supporting the parser"
@ -356,8 +357,7 @@
"Rule fires when condition is met (strip of altitude 0 down right hand side)")
(is (nil? (apply afn (list {:x 0 :y 1} world)))
"Left of world is all high, so rule should not fire.")))
;; 'single action' already tested in 'condition' tests above
;; action and actions
(testing "Conjunction of actions"

112
test/mw_parser/generate_test.clj
View file

@ -1,57 +1,87 @@
(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]))
(ns mw-parser.generate-test
(:require [clojure.test :refer [deftest is testing]]
[mw-parser.generate :refer [generate]]))
;; TODO: these tests are badly written and many (all?!?) of them were not
;; actually firing. rewrite ALL to the pattern:
;;
;; (let [actual ...
;; expected ...]
;; (is (= actual expected)))
(deftest expressions-tests
(testing "Generating primitive expressions."
(is (generate '(:NUMERIC-EXPRESSION (:NUMBER "50"))) 50)
(is (generate '(:NUMERIC-EXPRESSION (:SYMBOL "sealevel")))
'(:sealevel cell))
))
(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
(let [expected '(= (:state cell) (or (:forest cell) :forest))
actual (generate
'(: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))
(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))))
))
'(= (: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")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:SYMBOL "forest"))
(:PROPERTY-CONDITION
(:SYMBOL "fertility")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:NUMBER "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))))
(is (= (generate '(:PROPERTY-CONDITION
(:SYMBOL "state")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:DISJUNCT-EXPRESSION
(:SYMBOL "heath")
(:SYMBOL "scrub")
(:SYMBOL "forest"))))
'(#{: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)))))))
(deftest rhs-generators-tests
(testing "Generating right-hand-side fragments of rule functions from appropriate fragments of parse trees"
(is (generate
(is (= (generate
'(:SIMPLE-ACTION (:SYMBOL "state") (:BECOMES "should be") (:SYMBOL "climax")))
'(merge cell {:state :climax}))
(is (generate
'(merge cell {:state :climax})))
(is (= (generate
'(:SIMPLE-ACTION (:SYMBOL "fertility") (:BECOMES "should be") (:NUMBER "10")))
'(merge cell {:fertility 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}))))
))
(let [rule '(:RULE
(:IF "if")
(:PROPERTY-CONDITION
(:SYMBOL "state")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:SYMBOL "forest"))
(:ACTIONS
(:SIMPLE-ACTION
(:SYMBOL "state")
(:BECOMES "should be")
(:SYMBOL "climax"))))
expected '(fn [cell world]
(when
(= (:state cell) (or (:forest cell) :forest))
(merge cell {:state :climax})))
actual (generate rule)
expected-meta {:rule-type :production}
actual-meta (meta actual)]
(is (= actual expected))
(is (= actual-meta expected-meta)))))

98
test/mw_parser/simplify_test.clj Normal file
View file

@ -0,0 +1,98 @@
(ns mw-parser.simplify-test
(:require [clojure.test :refer [deftest is testing]]
[mw-parser.declarative :refer [parse-rule]]
[mw-parser.simplify :refer [simplify]]
[mw-parser.utils :refer [search-tree]]))
((deftest disjunct-condition-test
(testing "Generation of disjunct conditions has been producing wrong
output -- in a way which didn't actually alter the
correctness of the rule -- since the beginning, and because
of inadequate and badly written tests, I didn't know it."
(let [expected '(:DISJUNCT-CONDITION
(:PROPERTY-CONDITION
(:SYMBOL "state")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:SYMBOL "forest"))
(:PROPERTY-CONDITION
(:SYMBOL "fertility")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:NUMBER "10")))
actual (simplify [:DISJUNCT-CONDITION
[:CONDITION
[:PROPERTY-CONDITION
[:PROPERTY [:SYMBOL "state"]]
[:SPACE " "]
[:QUALIFIER [:EQUIVALENCE [:IS "is"]]]
[:SPACE " "]
[:EXPRESSION [:VALUE [:SYMBOL "forest"]]]]]
[:SPACE " "]
[:OR "or"]
[:SPACE " "]
[:CONDITIONS
[:CONDITION
[:PROPERTY-CONDITION
[:PROPERTY [:SYMBOL "fertility"]]
[:SPACE " "]
[:QUALIFIER [:EQUIVALENCE [:IS "is"]]]
[:SPACE " "]
[:EXPRESSION [:VALUE [:NUMBER "10"]]]]]]])]
(is (= actual expected))))))
(deftest conjunct-condition-test
(testing "Conjunct conditions were failing in more or less the same way"
(let [expected '(:CONJUNCT-CONDITION
(:PROPERTY-CONDITION
(:SYMBOL "state")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:SYMBOL "forest"))
(:PROPERTY-CONDITION
(:SYMBOL "fertility")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:NUMBER "10")))
actual (simplify [:CONJUNCT-CONDITION
[:CONDITION
[:PROPERTY-CONDITION
[:PROPERTY [:SYMBOL "state"]]
[:SPACE " "]
[:QUALIFIER [:EQUIVALENCE [:IS "is"]]]
[:SPACE " "]
[:EXPRESSION [:VALUE [:SYMBOL "forest"]]]]]
[:SPACE " "]
[:AND "and"]
[:SPACE " "]
[:CONDITIONS
[:CONDITION
[:PROPERTY-CONDITION
[:PROPERTY [:SYMBOL "fertility"]]
[:SPACE " "]
[:QUALIFIER [:EQUIVALENCE [:IS "is"]]]
[:SPACE " "]
[:EXPRESSION [:VALUE [:NUMBER "10"]]]]]]])]
(is (= actual expected)))))
((deftest unchained-disjuncts-test
(testing "Disjunct values should not be chained"
(let [wrong '(:DISJUNCT-EXPRESSION
(:IN "in")
(:DISJUNCT-VALUE
(:SYMBOL "heath")
(:DISJUNCT-VALUE
(:SYMBOL "scrub")
(:DISJUNCT-VALUE (:SYMBOL "forest")))))
parse-tree (search-tree
(parse-rule
"if state is not in heath or scrub or forest then state should be climax")
:DISJUNCT-EXPRESSION)
actual (simplify parse-tree)]
(is (not (= wrong actual))))
(let [expected '(:DISJUNCT-EXPRESSION
(:SYMBOL "heath")
(:SYMBOL "scrub")
(:SYMBOL "forest"))
parse-tree (search-tree
(parse-rule
"if state is not in heath or scrub or forest then state should be climax")
:DISJUNCT-EXPRESSION)
actual (simplify parse-tree)]
(is (= expected actual))))))