Added arithmetic actions to right hand side. Made 'is' and 'are' synonyms.
This commit is contained in:
parent
6a0967287e
commit
fff777862f
|
@ -1,8 +1,15 @@
|
||||||
;; A very simple parser which parses production rules of the following forms:
|
;; A very simple parser which parses production rules of the following forms:
|
||||||
;;
|
;;
|
||||||
;; "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"
|
;; "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"
|
||||||
;; "if altitude is 100 and fertility is 25 then state should be heath"
|
;; "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3"
|
||||||
;; "if altitude is 100 or fertility is 25 then state should be heath"
|
;; "if altitude is 100 or fertility is 25 then state should be heath"
|
||||||
|
;; "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2"
|
||||||
|
;; "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves"
|
||||||
|
;;
|
||||||
|
;; It should also but does not yet parse rules of the form
|
||||||
|
;; "if 6 neighbours have state is water then state should be fishery"
|
||||||
|
;; "if state is forest or state is climax and some neighbours have state is fire then 3 in 5 chance that state should be fire"
|
||||||
|
;; "if state is pasture and more than 3 neighbours have state is scrub then state should be scrub"
|
||||||
;;
|
;;
|
||||||
;; it generates rules in the form expected by mw-engine.core
|
;; it generates rules in the form expected by mw-engine.core
|
||||||
|
|
||||||
|
@ -14,29 +21,31 @@
|
||||||
(declare parse-not-condition)
|
(declare parse-not-condition)
|
||||||
(declare parse-simple-condition)
|
(declare parse-simple-condition)
|
||||||
|
|
||||||
(defn parse-less-condition [[property is less than value & rest]]
|
(defn parse-less-condition
|
||||||
(cond (and (= is "is") (= less "less") (= than "than"))
|
"Parse '[property] is less than [value]."
|
||||||
[(list '< (list 'get-int 'cell (keyword property)) value)
|
[[property is less than value & rest]]
|
||||||
rest]))
|
(cond (and (member? is '("is" "are")) (= less "less") (= than "than"))
|
||||||
|
[(list '< (list 'get-int 'cell (keyword property)) (read-string value)) rest]))
|
||||||
|
|
||||||
(defn parse-more-condition [[property is more than value & rest]]
|
(defn parse-more-condition
|
||||||
(cond (and (= is "is") (= more "more") (= than "than"))
|
"Parse '[property] is more than [value]."
|
||||||
[(list '> (list 'get-int 'cell (keyword property)) value)
|
[[property is more than value & rest]]
|
||||||
:remainder rest]))
|
(cond (and (member? is '("is" "are")) (= more "more") (= than "than"))
|
||||||
|
[(list '> (list 'get-int 'cell (keyword property)) (read-string value)) rest]))
|
||||||
|
|
||||||
(defn parse-is-condition
|
(defn parse-is-condition
|
||||||
"Parse clauses of the form 'x is y', but not 'x is more than y' or 'x is less than y'.
|
"Parse clauses of the form 'x is y', but not 'x is more than y' or 'x is less than y'.
|
||||||
It is necessary to disambiguate whether value is a numeric or keyword."
|
It is necessary to disambiguate whether value is a numeric or keyword."
|
||||||
[[property is value & rest]]
|
[[property is value & rest]]
|
||||||
(cond (and (= is "is")
|
(cond (and (member? is '("is" "are"))
|
||||||
(not (member? value '("more" "less" "exactly" "not"))))
|
(not (member? value '("more" "less" "exactly" "not"))))
|
||||||
[(cond
|
[(cond
|
||||||
(re-matches #"^[0-9]*$" value)(list '= (list 'get-int 'cell (keyword property)) (. Integer parseInt value))
|
(re-matches #"^[0-9.]*$" value)(list '= (list 'get-int 'cell (keyword property)) (read-string value))
|
||||||
true (list '= (list (keyword property) 'cell) (keyword value)))
|
true (list '= (list (keyword property) 'cell) (keyword value)))
|
||||||
rest]))
|
rest]))
|
||||||
|
|
||||||
(defn parse-not-condition [[property is not & rest]]
|
(defn parse-not-condition [[property is not & rest]]
|
||||||
(cond (and (= is "is") (= not "not"))
|
(cond (and (member? is '("is" "are")) (= not "not"))
|
||||||
(let [partial (parse-simple-condition (cons property (cons is rest)))]
|
(let [partial (parse-simple-condition (cons property (cons is rest)))]
|
||||||
(cond partial
|
(cond partial
|
||||||
(let [[condition remainder] partial]
|
(let [[condition remainder] partial]
|
||||||
|
@ -47,7 +56,6 @@
|
||||||
[tokens]
|
[tokens]
|
||||||
(or (parse-is-condition tokens)
|
(or (parse-is-condition tokens)
|
||||||
(parse-not-condition tokens)
|
(parse-not-condition tokens)
|
||||||
(parse-exactly-condition tokens)
|
|
||||||
(parse-less-condition tokens)
|
(parse-less-condition tokens)
|
||||||
(parse-more-condition tokens)))
|
(parse-more-condition tokens)))
|
||||||
|
|
||||||
|
@ -88,11 +96,24 @@
|
||||||
(= (first tokens) "if")
|
(= (first tokens) "if")
|
||||||
(parse-conditions (rest tokens))))
|
(parse-conditions (rest tokens))))
|
||||||
|
|
||||||
(defn parse-simple-action [previous [property should be value & rest]]
|
(defn parse-arithmetic-action [previous [prop1 should be prop2 operator value & rest]]
|
||||||
|
(if (and (= should "should")
|
||||||
|
(= be "be")
|
||||||
|
(member? operator '("+" "-" "*" "/")))
|
||||||
|
[(list 'merge (or previous 'cell)
|
||||||
|
{(keyword prop1) (list (symbol operator) (list 'get-int 'cell (keyword prop2))
|
||||||
|
(cond
|
||||||
|
(re-matches #"^[0-9.]*$" value) (read-string value)
|
||||||
|
true (list 'get-int 'cell (keyword value))))}) rest]))
|
||||||
|
|
||||||
|
(defn parse-set-action [previous [property should be value & rest]]
|
||||||
(if (and (= should "should") (= be "be"))
|
(if (and (= should "should") (= be "be"))
|
||||||
[(list 'merge (or previous 'cell)
|
[(list 'merge (or previous 'cell)
|
||||||
{(keyword property) (cond (re-matches #"^[0-9]*$" value) (. Integer parseInt value) true (keyword value))}) rest])
|
{(keyword property) (cond (re-matches #"^[0-9.]*$" value) (read-string value) true (keyword value))}) rest]))
|
||||||
)
|
|
||||||
|
(defn parse-simple-action [previous tokens]
|
||||||
|
(or (parse-arithmetic-action previous tokens)
|
||||||
|
(parse-set-action previous tokens)))
|
||||||
|
|
||||||
(defn parse-actions
|
(defn parse-actions
|
||||||
"Parse actions from tokens."
|
"Parse actions from tokens."
|
||||||
|
|
Loading…
Reference in a new issue