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

Flow rule generation very nearly correct!

Browse source 
Not all tests pass; additional conditions are not yet evaluated.
This commit is contained in:
Simon Brooke 2023-07-15 07:27:20 +01:00
parent 2a5d598f28
commit 93a0f3ea1d
8 changed files with 186 additions and 68 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/mw_parser/core.clj
View file

@ -4,7 +4,7 @@
declarative parser, q.v."
:author "Simon Brooke"}
mw-parser.core
(:require [clojure.string :only [split trim triml]]
(:require [clojure.string :refer [split trim triml]]
[mw-engine.utils :refer [member?]])
(:gen-class))
@ -102,7 +102,7 @@
"Parse a token assumed to be the name of a property of the current cell,
whose value is assumed to be an integer."
[[value & remainder]]
(when value [(list 'get-int 'cell (keyword value)) remainder]))
(when value [(list 'mw-engine.utils/get-int 'cell (keyword value)) remainder]))
(defn parse-property-value
"Parse a token assumed to be the name of a property of the current cell."

6
src/mw_parser/flow.clj
View file

@ -25,11 +25,13 @@
"PERCENTAGE := NUMBER #'%';"
"QUANTITY := PERCENTAGE | NUMBER | EXPRESSION | SOME;"
"SOURCE := STATE | STATE SPACE WITH SPACE CONDITIONS;"
"DESTINATION := STATE | STATE SPACE WITH SPACE FLOW-CONDITIONS | STATE SPACE WITHIN SPACE VALUE SPACE WITH SPACE FLOW-CONDITIONS;"
"DESTINATION := TARGET | TARGET SPACE WITH SPACE FLOW-CONDITIONS;"
"DETERMINER := MOST | LEAST;"
"DETERMINER-CONDITION := DETERMINER SPACE PROPERTY | DETERMINER SPACE PROPERTY;"
"DETERMINER-CONDITION := DETERMINER SPACE PROPERTY;"
"FLOW-CONDITIONS := DETERMINER-CONDITION | CONDITIONS"
"RANGE := WITHIN SPACE VALUE;"
"STATE := SYMBOL;"
"TARGET := STATE | STATE SPACE RANGE;"
"TO-HOW := TO | TO-EACH | TO-FIRST;"
"TO-EACH := TO SPACE EACH | TO SPACE ALL;"
"TO-FIRST := TO SPACE FIRST"]))

118
src/mw_parser/generate.clj
View file

@ -1,10 +1,8 @@
(ns ^{:doc "Generate Clojure source from simplified parse trees."
:author "Simon Brooke"}
mw-parser.generate
(:require [clojure.pprint :refer [pprint]]
[clojure.tools.trace :refer [deftrace]]
[mw-parser.utils :refer [assert-type TODO]]
[mw-parser.errors :as pe]))
(:require [mw-parser.errors :as pe]
[mw-parser.utils :refer [assert-type search-tree TODO]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@ -233,7 +231,8 @@
(list 'count
(list 'remove 'false?
(list 'map (list 'fn ['cell] property-condition)
(list 'mw-engine.utils/get-neighbours 'world 'cell distance)))) quantity))
(list 'mw-engine.utils/get-neighbours 'world 'cell distance))))
quantity))
([comp1 quantity property-condition]
(generate-neighbours-condition comp1 quantity property-condition 1)))
@ -253,7 +252,11 @@
distance (generate (nth tree 4))
pc (generate (nth tree 6))]
(case quantifier-type
:NUMBER (generate-neighbours-condition '= (read-string (second (second quantifier))) pc distance)
:NUMBER (generate-neighbours-condition
'=
(read-string (second (second quantifier)))
pc
distance)
:SOME (generate-neighbours-condition '> 0 pc distance)
:MORE (let [value (generate (nth quantifier 3))]
(generate-neighbours-condition '> value pc distance))
@ -280,23 +283,100 @@
;;; (fn [cell world])
;;; (if (= (:state cell) (or (:house cell) :house))
(defmacro flow-rule
(defn flow-rule
"Generate a flow rule for this `quantity` of this `property` from this
`source` to this `destination`."
[source property quantity-frag destinations]
`(fn [cell world]
(when (and ~source (pos? cell ~property))
(map
(fn [d] {:source (select-keys cell [:x :y])
:destination (select-keys d [:x :y])
:property ~property
:quantity ~quantity-frag})
~destinations))))
(vary-meta
(list 'fn ['cell 'world]
(list 'when (list 'and source (list 'pos? 'cell property))
(list 'map
(list 'fn ['d]
{:source (list 'select-keys 'cell [:x :y])
:destination (list 'select-keys 'd [:x :y])
:property property
:quantity quantity-frag})
destinations)))
merge
{:rule-type
:flow}))
(defn generate-quantity-accessor
"Generate a code fragment which will generate the appropriate quantity of
the `property` specified in a rule, from this `q-clause`."
[q-clause property]
(case (first q-clause)
;; TODO :EXPRESSION still needed
:NUMBER (generate q-clause)
:PERCENTAGE (let [multiplier (/ (generate (second q-clause)) 100)]
(list '* multiplier (list property 'cell)))
:SOME (list 'rand (list property 'cell))
(throw (ex-info
(format "Unexpected QUANTITY type: `%s`" (first q-clause))
{:clause q-clause
:property property}))))
(defn generate-target-state-filter
[clause targets-frag]
(assert-type clause :DESTINATION)
(list 'filter
(list 'fn ['cell]
(generate-property-condition
(search-tree (search-tree clause :TARGET)
:PROPERTY-CONDITION)))
targets-frag))
(defn generate-dest-accessor
[clause]
(let [dc (search-tree clause :DETERMINER-CONDITION)
range (search-tree clause :RANGE)
distance (if range (generate (nth range 2)) 1)]
(list 'let ['candidates
(generate-target-state-filter
clause
(list 'mw-engine.utils/get-neighbours 'world 'cell distance))]
(if dc
(list 'list
(let [determiner (first (second (search-tree dc :DETERMINER)))
prop (generate (nth dc 2))]
(case determiner
:LEAST (list 'mw-engine.utils/get-least-cell 'candidates prop)
:MOST (list 'mw-engine.utils/get-most-cell 'candidates prop))))
'candidates))))
;; (fn
;; [cell world]
;; (when
;; (and (= (:state cell) (or (:house cell) :house)) (pos? cell :food))
;; (map
;; (fn
;; [d]
;; (assoc
;; {}
;; :source
;; (select-keys cell [:x :y])
;; :destination
;; (select-keys d [:x :y])
;; :property
;; :food
;; :quantity
;; (* 1/10 (:food cell)))
;; {})
;; (let
;; [candidates
;; (filter
;; (fn [cell] (= (:state cell) (or (:house cell) :house)))
;; (mw-engine.utils/get-neighbours world cell 2))]
;; (list (mw-engine.utils/get-least-cell candidates :food))))))
(defn generate-flow
[tree]
(assert-type tree :FLOW-RULE)
(let [clauses (reduce #(assoc %1 (first %2) %2) {} (rest tree))]
(list 'fn ['cell 'world]
(list 'when (generate (:SOURCE clauses))))))
(let [clauses (reduce #(assoc %1 (first %2) %2) {} (rest tree))
source-accessor (generate (:SOURCE clauses))
property (generate (:SYMBOL clauses))
quantity (generate-quantity-accessor (second (:QUANTITY clauses)) property)
dest-accessor (generate-dest-accessor (:DESTINATION clauses))]
(flow-rule source-accessor property quantity dest-accessor)))
;;; Top level; only function anything outside this file (except tests) should
;;; really call.
@ -333,8 +413,10 @@
:PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right
:PROPERTY-CONDITION (generate-property-condition tree)
:QUALIFIER (generate-qualifier tree)
:QUANTITY (generate (second tree))
:RULE (generate-rule tree)
:SIMPLE-ACTION (generate-simple-action tree)
:SOURCE (generate (second tree))
:SYMBOL (keyword (second tree))
:VALUE (generate (second tree))
:WITHIN-CONDITION (generate-within-condition tree)

16
src/mw_parser/simplify.clj
View file

@ -1,6 +1,7 @@
(ns ^{:doc "Simplify a parse tree."
:author "Simon Brooke"}
mw-parser.simplify)
mw-parser.simplify
(:require [mw-parser.utils :refer [search-tree]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
@ -72,16 +73,29 @@
:CONDITIONS (simplify-second-of-two tree)
:DISJUNCT-EXPRESSION (simplify-chained-list tree :DISJUNCT-VALUE :VALUE)
:EXPRESSION (simplify-second-of-two tree)
:FLOW-CONDITIONS (simplify-second-of-two tree)
:IN nil
:PROPERTY (simplify-second-of-two tree)
:PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
:OR nil
:SPACE nil
:STATE (list :PROPERTY-CONDITION
(list :SYMBOL "state")
'(:QUALIFIER
(:EQUIVALENCE
(:IS "is")))
(list :EXPRESSION
(list :VALUE (second tree))))
:THEN nil
:VALUE (simplify-second-of-two tree)
(remove nil? (map simplify tree)))
tree))
;; OK, there is a major unresolved problem. If there is a determiner condition,
;; the tree as parsed from natural language is the wrong shape, and we're
;; going to have to restructure it somewhere to being the determiner upstream
;; of the property conditions. It *may* be possible to do that in `generate`.
(defn simplify-determiner-condition
[tree]
(apply vector

4
src/mw_parser/utils.clj
View file

@ -49,7 +49,9 @@
"If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception."
[tree-fragment type]
(assert (suitable-fragment? tree-fragment type)
(throw (Exception. (format "Expected a %s fragment" type)))))
(throw (ex-info (format "Expected a %s fragment" type)
{:actual tree-fragment
:expected type}))))
(defn search-tree

4
test/mw_parser/core_test.clj
View file

@ -15,7 +15,7 @@
(is (= (first (parse-simple-value '("this" "and" "that"))) :this)
"or else just a keyword")
(is (= (first (parse-simple-value '("this" "and" "that") true))
'(get-int cell :this))
'(mw-engine.utils/get-int cell :this))
"...unless an integer is explicitly sought, in which case it should be something which gets an integer from the current cell")
(is (= (parse-value '()) nil)
"if there's nothing to parse, return nil")
@ -24,7 +24,7 @@
(is (= (first (parse-value '("this" "and" "that"))) :this)
"or else just a keyword")
(is (= (first (parse-value '("this" "and" "that") true))
'(get-int cell :this))
'(mw-engine.utils/get-int cell :this))
"...unless an integer is explicitly sought, in which case it should be something which gets an integer from the current cell")
(is (= (parse-property-value '()) nil)
"if there's nothing to parse, return nil")

65
test/mw_parser/flow_test.clj
View file

@ -1,7 +1,8 @@
(ns mw-parser.flow-test
(:require ;; [clojure.pprint :as pprint]
[clojure.test :refer [deftest is testing]] ;; [mw-engine.core :refer [transform-world]]
[mw-parser.flow :refer [parse-flow simplify-flow]]))
[mw-parser.declarative :refer [parse]]
[mw-parser.simplify :refer [simplify]]))
(deftest parse-flow-tests
(testing "flow-grammar"
@ -31,36 +32,38 @@
(:WITH "with")
(:FLOW-CONDITIONS
(:DETERMINER-CONDITION (:LEAST "least") (:SYMBOL "food")))))
actual (simplify-flow (parse-flow rule))]
actual (simplify (parse rule))]
(is (= actual expected) rule))
(let [rule "flow 10% food from house having food more than 10 to each house within 2 with food less than 4"
expected '(:FLOW-RULE
(:PERCENTAGE (:NUMBER "10") "%")
(:SYMBOL "food")
(:FROM "from")
(:SOURCE
(:PROPERTY-CONDITION
(:SYMBOL "state")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:EXPRESSION (:VALUE [:SYMBOL "house"])))
(:WITH "having")
(:PROPERTY-CONDITION
(:SYMBOL "food")
(:QUALIFIER (:COMPARATIVE-QUALIFIER (:MORE "more") (:THAN "than")))
(:NUMBER "10")))
(:TO-HOW (:TO-EACH (:TO "to") (:EACH "each")))
(:DESTINATION
(:PROPERTY-CONDITION
(:SYMBOL "state")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:EXPRESSION (:VALUE [:SYMBOL "house"])))
(:WITHIN "within")
(:VALUE (:NUMBER "2"))
(:WITH "with")
(:FLOW-CONDITIONS
(:PROPERTY-CONDITION
(:SYMBOL "food")
(:QUALIFIER (:COMPARATIVE-QUALIFIER (:LESS "less") (:THAN "than")))
(:NUMBER "4")))))
actual (simplify-flow (parse-flow rule))]
expected '(:FLOW-RULE
(:FLOW "flow")
(:QUANTITY (:PERCENTAGE (:NUMBER "10") "%"))
(:SYMBOL "food")
(:FROM "from")
(:SOURCE
(:PROPERTY-CONDITION
(:SYMBOL "state")
(:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:EXPRESSION (:VALUE [:SYMBOL "house"])))
(:WITH "having")
(:PROPERTY-CONDITION
(:SYMBOL "food")
(:QUALIFIER
(:COMPARATIVE-QUALIFIER (:MORE "more") (:THAN "than")))
(:NUMBER "10")))
(:TO-HOW (:TO-EACH (:TO "to") (:EACH "each")))
(:DESTINATION
(:TARGET
(:PROPERTY-CONDITION
(:SYMBOL "state") (:QUALIFIER (:EQUIVALENCE (:IS "is")))
(:EXPRESSION (:VALUE [:SYMBOL "house"])))
(:RANGE (:WITHIN "within") (:NUMBER "2")))
(:WITH "with")
(:PROPERTY-CONDITION
(:SYMBOL "food")
(:QUALIFIER
(:COMPARATIVE-QUALIFIER (:LESS "less") (:THAN "than")))
(:NUMBER "4"))))
actual (simplify (parse rule))]
(is (= actual expected) rule))))

37
test/mw_parser/generate_test.clj
View file

@ -1,19 +1,17 @@
(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)))
[mw-parser.generate :refer [generate]]
[mw-parser.declarative :refer [parse]]
[mw-parser.simplify :refer [simplify]]))
(deftest expressions-tests
(testing "Generating primitive expressions."
(is (= (generate '(:NUMERIC-EXPRESSION (:NUMBER "50"))) 50))
(is (= (generate '(:NUMERIC-EXPRESSION (:SYMBOL "sealevel")))
'(:sealevel cell)))))
(let [actual (generate '(:NUMERIC-EXPRESSION (:NUMBER "50")))
expected 50]
(is (= actual expected)))
(let [actual (generate '(:NUMERIC-EXPRESSION (:SYMBOL "sealevel")))
expected '(:sealevel cell)]
(is (= actual expected)))))
(deftest lhs-generators-tests
(testing "Generating left-hand-side fragments of rule functions from appropriate fragments of parse trees"
@ -85,3 +83,20 @@
actual-meta (meta actual)]
(is (= actual expected))
(is (= actual-meta expected-meta)))))
(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)))
(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)))))