Much progress (including simple neighbour conditions) but still problems
with list conditions.
This commit is contained in:
parent
fff777862f
commit
3545e6f129
|
|
@ -1,5 +1,5 @@
|
|||
(defproject mw-parser "0.1.0-SNAPSHOT"
|
||||
:description "FIXME: write description"
|
||||
:description "Parser for production rules for MicroWorld engine"
|
||||
:url "http://example.com/FIXME"
|
||||
:license {:name "Eclipse Public License"
|
||||
:url "http://www.eclipse.org/legal/epl-v10.html"}
|
||||
|
|
|
|||
|
|
@ -1,15 +1,18 @@
|
|||
;; 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 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 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"
|
||||
;; * "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"
|
||||
;; * "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 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"
|
||||
;; * "if state is grassland and 4 neighbours have state equal to water then state should be village"
|
||||
;;
|
||||
;; 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 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"
|
||||
;; * "if state is forest and fertility is between 55 and 75 then state should be climax"
|
||||
;;
|
||||
;; it generates rules in the form expected by mw-engine.core
|
||||
|
||||
|
|
@ -21,99 +24,239 @@
|
|||
(declare parse-not-condition)
|
||||
(declare parse-simple-condition)
|
||||
|
||||
;; a regular expression which matches string representation of numbers
|
||||
(def re-number #"^[0-9.]*$")
|
||||
|
||||
(defn keyword-or-numeric
|
||||
"If this token appears to represent an explicit number, return that number;
|
||||
otherwise, make a keyword of it and return that."
|
||||
[token]
|
||||
(cond
|
||||
(re-matches re-number token) (read-string token)
|
||||
(keyword? token) token
|
||||
true (keyword token)))
|
||||
|
||||
;; Generally all functions in this file with names beginning 'parse-' take a
|
||||
;; sequence of tokens (and in some cases other optional arguments) and return a
|
||||
;; vector comprising
|
||||
;;
|
||||
;; # A code fragment parsed from the front of the sequence of tokens, and
|
||||
;; # the remaining tokens which were not consumed in constructing that sequence.
|
||||
;;
|
||||
;; In every case if the function cannot parse the desired construct from the
|
||||
;; front of the sequence of tokens it returns nil.
|
||||
|
||||
(defn parse-numeric-value
|
||||
"Parse a number."
|
||||
[[value & remainder]]
|
||||
(if (re-matches re-number value) [(read-string value) remainder]))
|
||||
|
||||
(defn parse-property-int
|
||||
"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]]
|
||||
(if value [(list '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."
|
||||
[[value & remainder]]
|
||||
(if value [(list (keyword value) 'cell) remainder]))
|
||||
|
||||
(defn parse-simple-value
|
||||
"Parse a value from the first of these `tokens`. If `expect-int` is true, return
|
||||
an integer or something which will evaluate to an integer."
|
||||
([tokens expect-int]
|
||||
(or
|
||||
(parse-numeric-value tokens)
|
||||
(cond expect-int
|
||||
(parse-property-int tokens)
|
||||
true (parse-property-value tokens))))
|
||||
([tokens]
|
||||
(parse-simple-value tokens false)))
|
||||
|
||||
(defn parse-disjunct-value
|
||||
"Parse a list of values from among these `tokens`. If `expect-int` is true, return
|
||||
an integer or something which will evaluate to an integer.
|
||||
|
||||
NOTE: contrary to the general behaviour of `parse-` functions, this one
|
||||
returns a vector [nil unconsumed-tokens] when it cannot find any further
|
||||
disjuncts. TODO: doesn't work."
|
||||
[[OR & tokens] expect-int]
|
||||
(cond
|
||||
(member? OR '("in" "or"))
|
||||
(cond expect-int
|
||||
(let [[member r] (parse-simple-value tokens)
|
||||
[others remainder] (parse-disjunct-value r expect-int)]
|
||||
(cond member [(cons member others) remainder])
|
||||
true
|
||||
(let [[member r] tokens
|
||||
[others remainder] (parse-disjunct-value r expect-int)]
|
||||
(cond member [(cons (keyword member) others) remainder]
|
||||
true [(list member) r]))))
|
||||
true [nil (cons OR tokens)]))
|
||||
|
||||
(defn parse-value
|
||||
"Parse a value from among these `tokens`. If `expect-int` is true, return
|
||||
an integer or something which will evaluate to an integer."
|
||||
([tokens expect-int]
|
||||
(or
|
||||
(parse-disjunct-value tokens expect-int)
|
||||
(parse-simple-value tokens)))
|
||||
([tokens]
|
||||
(parse-value tokens false)))
|
||||
|
||||
(defn parse-member-condition
|
||||
[[property IN & rest]]
|
||||
(if (= IN "in")
|
||||
(let [[l & remainder] (parse-disjunct-value (cons "in" rest) false)]
|
||||
[(list 'member? (keyword property) l) remainder])))
|
||||
|
||||
(defn parse-less-condition
|
||||
"Parse '[property] is less than [value]."
|
||||
[[property is less than value & rest]]
|
||||
(cond (and (member? is '("is" "are")) (= less "less") (= than "than"))
|
||||
"Parse '[property] less than [value]'."
|
||||
[[property LESS THAN value & rest]]
|
||||
(cond (and (= LESS "less") (= THAN "than"))
|
||||
[(list '< (list 'get-int 'cell (keyword property)) (read-string value)) rest]))
|
||||
|
||||
(defn parse-more-condition
|
||||
"Parse '[property] is more than [value]."
|
||||
[[property is more than value & rest]]
|
||||
(cond (and (member? is '("is" "are")) (= more "more") (= than "than"))
|
||||
"Parse '[property] more than [value]'."
|
||||
[[property MORE THAN value & rest]]
|
||||
(cond (and (= MORE "more") (= THAN "than"))
|
||||
[(list '> (list 'get-int 'cell (keyword property)) (read-string value)) rest]))
|
||||
|
||||
(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'.
|
||||
It is necessary to disambiguate whether value is a numeric or keyword."
|
||||
[[property is value & rest]]
|
||||
(cond (and (member? is '("is" "are"))
|
||||
(not (member? value '("more" "less" "exactly" "not"))))
|
||||
[(cond
|
||||
(re-matches #"^[0-9.]*$" value)(list '= (list 'get-int 'cell (keyword property)) (read-string value))
|
||||
true (list '= (list (keyword property) 'cell) (keyword value)))
|
||||
rest]))
|
||||
(defn parse-between-condition
|
||||
[[p BETWEEN v1 AND v2 & rest]]
|
||||
(cond (and (= BETWEEN "between") (= AND "and") (not (nil? v2)))
|
||||
(let [property (first (parse-simple-value (list p) true))
|
||||
value1 (first (parse-simple-value (list v1) true))
|
||||
value2 (first (parse-simple-value (list v2) true))]
|
||||
[(list 'or
|
||||
(list '< value1 property value2)
|
||||
(list '> value1 property value2)) rest])))
|
||||
|
||||
(defn parse-not-condition [[property is not & rest]]
|
||||
(cond (and (member? is '("is" "are")) (= not "not"))
|
||||
(let [partial (parse-simple-condition (cons property (cons is rest)))]
|
||||
(cond partial
|
||||
(let [[condition remainder] partial]
|
||||
[(list 'not condition) remainder])))))
|
||||
(defn parse-is-condition
|
||||
"Parse clauses of the form 'x is y', 'x is in y or z...',
|
||||
'x is between y and z', 'x is more than y' or 'x is less than y'.
|
||||
It is necessary to disambiguate whether value is a numeric or keyword."
|
||||
[[property IS value & rest]]
|
||||
(cond
|
||||
(member? IS '("is" "are"))
|
||||
(let [tokens (cons property (cons value rest))]
|
||||
(cond
|
||||
(= value "in") (parse-member-condition tokens)
|
||||
(= value "between") (parse-between-condition tokens)
|
||||
(= value "more") (parse-more-condition tokens)
|
||||
(= value "less") (parse-less-condition tokens)
|
||||
(re-matches re-number value) [(list '= (list 'get-int 'cell (keyword property)) (read-string value)) rest]
|
||||
value [(list '= (list (keyword property) 'cell) (keyword value)) rest]))))
|
||||
|
||||
(defn parse-not-condition
|
||||
"Parse the negation of a simple condition."
|
||||
[[property IS NOT & rest]]
|
||||
(cond (and (member? IS '("is" "are")) (= NOT "not"))
|
||||
(let [partial (parse-simple-condition (cons property (cons "is" rest)))]
|
||||
(cond partial
|
||||
(let [[condition remainder] partial]
|
||||
[(list 'not condition) remainder])))))
|
||||
|
||||
(defn gen-neighbours-condition
|
||||
[comparator quantity property value remainder]
|
||||
[(list comparator quantity
|
||||
(list 'count
|
||||
(list 'get-neighbours-with-property-value 'world 'cell
|
||||
(keyword property) (keyword-or-numeric value))))
|
||||
remainder])
|
||||
|
||||
(defn parse-simple-neighbours-condition
|
||||
[[n NEIGHBOURS have-or-are & rest]]
|
||||
(let [quantity (first (parse-numeric-value (list n)))]
|
||||
(cond
|
||||
(and quantity (= NEIGHBOURS "neighbours"))
|
||||
(cond
|
||||
(= have-or-are "are")
|
||||
(let [[value & remainder] rest]
|
||||
(gen-neighbours-condition '= quantity :state value remainder))
|
||||
(= have-or-are "have")
|
||||
(let [[property EQUAL TO value & remainder] rest]
|
||||
(cond (and (= EQUAL "equal") (= TO "to"))
|
||||
(gen-neighbours-condition '= quantity property value remainder)))))))
|
||||
|
||||
(defn parse-neighbours-condition
|
||||
"Parse conditions referring to neighbours"
|
||||
[tokens]
|
||||
(or
|
||||
(parse-simple-neighbours-condition tokens)
|
||||
;; (parse-more-than-neighbours-condition tokens)
|
||||
;; (parse-fewer-than-neighbours-condition tokens)
|
||||
))
|
||||
|
||||
(defn parse-simple-condition
|
||||
"Parse conditions of the form '[property] [comparison] [value]'."
|
||||
[tokens]
|
||||
(or (parse-is-condition tokens)
|
||||
(parse-not-condition tokens)
|
||||
(parse-less-condition tokens)
|
||||
(parse-more-condition tokens)))
|
||||
(or
|
||||
(parse-simple-neighbours-condition tokens)
|
||||
(parse-member-condition tokens)
|
||||
(parse-not-condition tokens)
|
||||
(parse-is-condition tokens)
|
||||
(parse-less-condition tokens)
|
||||
(parse-more-condition tokens)))
|
||||
|
||||
(defn parse-disjunction-condition
|
||||
"Parse '... or [condition]' from `tokens`, there `left` is the already parsed first disjunct."
|
||||
[left tokens]
|
||||
(let [partial (parse-conditions tokens)]
|
||||
(if
|
||||
partial
|
||||
(let [[right remainder] partial]
|
||||
[(list 'or left right) remainder]))))
|
||||
|
||||
(defn parse-conjunction-condition
|
||||
"Parse '... and [condition]' from `tokens`, there `left` is the already parsed first conjunct."
|
||||
"Parse '... or [condition]' from `tokens`, where `left` is the already parsed first disjunct."
|
||||
[left tokens]
|
||||
(let [partial (parse-conditions tokens)]
|
||||
(if partial
|
||||
(let [[right remainder] partial]
|
||||
[(list 'and left right) remainder]
|
||||
))))
|
||||
(let [[right remainder] partial]
|
||||
[(list 'or left right) remainder]))))
|
||||
|
||||
(defn parse-conjunction-condition
|
||||
"Parse '... and [condition]' from `tokens`, where `left` is the already parsed first conjunct."
|
||||
[left tokens]
|
||||
(let [partial (parse-conditions tokens)]
|
||||
(if partial
|
||||
(let [[right remainder] partial]
|
||||
[(list 'and left right) remainder]))))
|
||||
|
||||
(defn parse-conditions
|
||||
"Parse conditions from `tokens`, where conditions may be linked by either 'and' or 'or'."
|
||||
[tokens]
|
||||
(let [partial (parse-simple-condition tokens)]
|
||||
(if partial
|
||||
(let [[left [next & remainder]] partial]
|
||||
(cond
|
||||
(= next "and") (parse-conjunction-condition left remainder)
|
||||
(= next "or") (parse-disjunction-condition left remainder)
|
||||
true partial)
|
||||
))))
|
||||
(let [[left [next & remainder]] partial]
|
||||
(cond
|
||||
(= next "and") (parse-conjunction-condition left remainder)
|
||||
(= next "or") (parse-disjunction-condition left remainder)
|
||||
true partial)))))
|
||||
|
||||
(defn parse-left-hand-side
|
||||
"Parse the left hand side ('if...') of a production rule."
|
||||
[tokens]
|
||||
(if
|
||||
[tokens]
|
||||
(if
|
||||
(= (first tokens) "if")
|
||||
(parse-conditions (rest tokens))))
|
||||
|
||||
(defn parse-arithmetic-action [previous [prop1 should be prop2 operator value & rest]]
|
||||
(defn parse-arithmetic-action
|
||||
"Parse actions of the form '[property] should be [property] [arithmetic-operator] [value]',
|
||||
e.g. 'fertility should be fertility + 1', or 'deer should be deer - wolves'."
|
||||
[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]))
|
||||
(re-matches re-number value) (read-string value)
|
||||
true (list 'get-int 'cell (keyword value))))}) rest]))
|
||||
|
||||
(defn parse-set-action [previous [property should be value & rest]]
|
||||
(defn parse-set-action
|
||||
"Parse actions of the form '[property] should be [value].'"
|
||||
[previous [property should be value & rest]]
|
||||
(if (and (= should "should") (= be "be"))
|
||||
[(list 'merge (or previous 'cell)
|
||||
{(keyword property) (cond (re-matches #"^[0-9.]*$" value) (read-string value) true (keyword value))}) rest]))
|
||||
{(keyword property) (cond (re-matches re-number 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)))
|
||||
(or (parse-arithmetic-action previous tokens)
|
||||
(parse-set-action previous tokens)))
|
||||
|
||||
(defn parse-actions
|
||||
"Parse actions from tokens."
|
||||
|
|
@ -130,7 +273,9 @@
|
|||
(if (= (first tokens) "then")
|
||||
(parse-actions nil (rest tokens))))
|
||||
|
||||
(defn parse-rule [line]
|
||||
(defn parse-rule
|
||||
"Parse a complete rule from this string or sequence of string tokens."
|
||||
[line]
|
||||
(cond
|
||||
(string? line) (parse-rule (split (triml line) #"\s+"))
|
||||
true (let [[left remainder] (parse-left-hand-side line)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,20 @@
|
|||
(ns mw-parser.core-test
|
||||
(:use mw-engine.utils)
|
||||
(:require [clojure.test :refer :all]
|
||||
[mw-parser.core :refer :all]))
|
||||
|
||||
(deftest a-test
|
||||
(testing "FIXME, I fail."
|
||||
(is (= 0 1))))
|
||||
|
||||
(deftest rules-tests
|
||||
(testing "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"
|
||||
(is (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))
|
||||
(is (let [cell (apply (eval (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3"))
|
||||
(list {:state :forest :altitude 99} nil))]
|
||||
(and (= (:state cell) :climax) (= (:deer cell) 3))))
|
||||
))
|
||||
|
||||
|
||||
;; * "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 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"
|
||||
;;
|
||||
Loading…
Reference in a new issue