diff --git a/project.clj b/project.clj index 73fd1c1..d48db45 100644 --- a/project.clj +++ b/project.clj @@ -12,7 +12,7 @@ :url "http://www.gnu.org/licenses/gpl-2.0.html"} :plugins [[lein-marginalia "0.7.1"]] :dependencies [[org.clojure/clojure "1.6.0"] - [org.clojure/tools.trace "0.7.8"] - [instaparse "1.3.5"] + [org.clojure/tools.trace "0.7.9"] + [instaparse "1.4.1"] [mw-engine "0.1.5-SNAPSHOT"] ]) diff --git a/src/mw_parser/declarative.clj b/src/mw_parser/declarative.clj index 8f73c4f..40804c6 100644 --- a/src/mw_parser/declarative.clj +++ b/src/mw_parser/declarative.clj @@ -22,7 +22,8 @@ DISJUNCT-CONDITION := CONDITION SPACE OR SPACE CONDITIONS; CONJUNCT-CONDITION := CONDITION SPACE AND SPACE CONDITIONS; CONDITION := NEIGHBOURS-CONDITION | PROPERTY-CONDITION; - NEIGHBOURS-CONDITION := QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUANTIFIER SPACE NEIGHBOURS IS EXPRESSION | QUALIFIER SPACE NEIGHBOURS-CONDITION; + WITHIN-CONDITION := NEIGHBOURS-CONDITION SPACE WITHIN SPACE NUMERIC-EXPRESSION; + NEIGHBOURS-CONDITION := WITHIN-CONDITION | QUANTIFIER SPACE NEIGHBOURS SPACE IS SPACE PROPERTY-CONDITION | QUANTIFIER SPACE NEIGHBOURS IS EXPRESSION | QUALIFIER SPACE NEIGHBOURS-CONDITION; PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION; EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE; SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE; @@ -46,6 +47,7 @@ NONE := 'no'; ALL := 'all' BETWEEN := 'between'; + WITHIN := 'within'; IN := 'in'; MORE := 'more'; LESS := 'less' | 'fewer'; @@ -178,22 +180,57 @@ :SYMBOL (list (keyword (second (second tree))) 'cell) (generate (second tree)))) -;; (defn generate-neighbours-condition -;; "Generate code for a condition which refers to neighbours." -;; ([tree] -;; (let [q (second tree)] -;; (if (number? q) -;; (generate-neighbours-condition '= q -;; ([comp1 quantity property value remainder comp2 distance] -;; [(list comp1 -;; (list 'count -;; (list 'get-neighbours-with-property-value 'world -;; '(cell :x) '(cell :y) distance -;; (keyword property) (keyword-or-numeric value) comp2)) -;; quantity) -;; remainder]) -;; ([comp1 quantity property value remainder comp2] -;; (gen-neighbours-condition comp1 quantity property value remainder comp2 1))) +(defn generate-neighbours-condition + "Generate code for a condition which refers to neighbours." + ([tree] + (generate-neighbours-condition tree (first (second tree)))) + ([tree quantifier-type] + (let [quantifier (second (second tree)) + pc (generate (nth tree 4))] + (case quantifier-type + :NUMBER (generate-neighbours-condition '= (read-string quantifier) pc 1) + :SOME (generate-neighbours-condition '> 0 pc 1) + :QUANTIFIER + (let [comparative (generate (simplify (second quantifier))) + value (simplify (nth quantifier 5))] + (generate-neighbours-condition comparative value pc 1))))) + ([comp1 quantity property-condition distance] + (list comp1 + (list 'count (list 'remove false (list 'map (list 'fn ['cell] property-condition) '(get-neighbours cell world distance)))) quantity)) + ([comp1 quantity property-condition] + (generate-neighbours-condition comp1 quantity property-condition 1))) + +;; (def s1 "if 3 neighbours have state equal to forest then state should be forest") +;; (def s2 "if some neighbours have state equal to forest then state should be forest") +;; (def s3 "if more than 3 neighbours have state equal to forest then state should be forest") +;; (def s4 "if fewer than 3 neighbours have state equal to forest then state should be forest") +;; (def s5 "if all neighbours have state equal to forest then state should be forest") +;; (def s6 "if more than 3 neighbours within 2 have state equal to forest then state should be forest") + +;; (nth (simplify (parse-rule s1)) 2) +;; (second (nth (simplify (parse-rule s1)) 2)) +;; (nth (simplify (parse-rule s2)) 2) +;; (map simplify (nth (simplify (parse-rule s2)) 2)) +;; ;; (second (nth (simplify (parse-rule s2)) 2)) +;; ;; (nth (simplify (parse-rule s3)) 2) +;; (second (nth (simplify (parse-rule s3)) 2)) +;; (map simplify (second (nth (simplify (parse-rule s3)) 2))) +;; ;; (nth (simplify (parse-rule s4)) 2) +;; ;; (second (nth (simplify (parse-rule s4)) 2)) +;; ;; (nth (simplify (parse-rule s5)) 2) +;; ;; (second (nth (simplify (parse-rule s5)) 2)) +;; ;; (nth (simplify (parse-rule s6)) 2) +;; ;; (second (nth (simplify (parse-rule s6)) 2)) + +;; ;; (generate (nth (nth (simplify (parse-rule s5)) 2) 4)) +;; ;; (generate (nth (simplify (parse-rule s2)) 2)) +;; ;; (generate (nth (simplify (parse-rule s1)) 2)) + + +;; (generate-neighbours-condition '= 3 '(= (:state cell) :forest) 1) +;; (generate-neighbours-condition (nth (simplify (parse-rule s3)) 2)) +;; (generate-neighbours-condition (nth (simplify (parse-rule s2)) 2)) +;; (generate-neighbours-condition (nth (simplify (parse-rule s1)) 2)) (defn generate @@ -209,7 +246,6 @@ :CONDITIONS (generate-conditions tree) :CONJUNCT-CONDITION (generate-conjunct-condition tree) :DISJUNCT-CONDITION (generate-disjunct-condition tree) - :PROPERTY-CONDITION (generate-property-condition tree) :DISJUNCT-EXPRESSION (generate (nth tree 2)) :DISJUNCT-VALUE (generate-disjunct-value tree) :EQUIVALENCE '= @@ -220,10 +256,11 @@ = 'not= > '< < '>) -;; :NEIGHBOURS-CONDITION (generate-neighbours-condition tree) + :NEIGHBOURS-CONDITION (generate-neighbours-condition tree) :NUMERIC-EXPRESSION (generate-numeric-expression tree) :NUMBER (read-string (second tree)) :PROPERTY (list (generate (second tree)) 'cell) ;; dubious - may not be right + :PROPERTY-CONDITION (generate-property-condition tree) :QUALIFIER (generate (second tree)) :RULE (generate-rule tree) :SIMPLE-ACTION (generate-simple-action tree) @@ -271,7 +308,7 @@ :CONDITION (simplify-second-of-two tree) :CONDITIONS (simplify-second-of-two tree) :EXPRESSION (simplify-second-of-two tree) - :QUANTIFIER (simplify-second-of-two tree) +;; :QUANTIFIER (simplify-second-of-two tree) :NOT nil :PROPERTY (simplify-second-of-two tree) :SPACE nil diff --git a/src/mw_parser/simplifier.clj b/src/mw_parser/simplifier.clj new file mode 100644 index 0000000..9943256 --- /dev/null +++ b/src/mw_parser/simplifier.clj @@ -0,0 +1,92 @@ +(ns mw-parser.simplifier + (:use mw-engine.utils + mw-parser.parser)) + +(declare simplify) + +(defn simplify-qualifier + "Given that this `tree` fragment represents a qualifier, what + qualifier is that?" + [tree] + (cond + (empty? tree) nil + (and (coll? tree) + (member? (first tree) '(:EQUIVALENCE :COMPARATIVE))) tree + (coll? (first tree)) (or (simplify-qualifier (first tree)) + (simplify-qualifier (rest tree))) + (coll? tree) (simplify-qualifier (rest tree)) + true tree)) + +(defn simplify-second-of-two + "There are a number of possible simplifications such that if the `tree` has + only two elements, the second is semantically sufficient." + [tree] + (if (= (count tree) 2) (simplify (nth tree 1)) tree)) + + +(defn simplify-some + "'some' is the same as 'more than zero'" + [tree] + [:COMPARATIVE '> 0]) + +(defn simplify-none + "'none' is the same as 'zero'" + [tree] + [:COMPARATIVE '= 0]) + +(defn simplify-all + "'all' isn't actually the same as 'eight', because cells at the edges of the world have + fewer than eight neighbours; but it's a simplifying (ha!) assumption for now." + [tree] + [:COMPARATIVE '= 8]) + +(defn simplify-quantifier + "If this quantifier is a number, 'simplifiy' it into a comparative whose operator is '=' + and whose quantity is that number. This is actually more complicated but makes generation easier." + [tree] + (if (number? (second tree)) [:COMPARATIVE '= (second tree)] (simplify (second tree)))) + +(defn simplify + "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with + semantically identical simpler fragments" + [tree] + (if + (coll? tree) + (case (first tree) + :SPACE nil + :QUALIFIER (simplify-qualifier tree) + :CONDITIONS (simplify-second-of-two tree) + :CONDITION (simplify-second-of-two tree) + :EXPRESSION (simplify-second-of-two tree) + :COMPARATIVE (simplify-second-of-two tree) + :QUANTIFIER (simplify-quantifier tree) + :VALUE (simplify-second-of-two tree) + :PROPERTY (simplify-second-of-two tree) + :ACTIONS (simplify-second-of-two tree) + :ACTION (simplify-second-of-two tree) + :ALL (simplify-all tree) + :SOME (simplify-some tree) + :NONE (simplify-none tree) + (remove nil? (map simplify tree))) + tree)) + +(simplify (parse-rule "if state is climax and 4 neighbours have state equal to fire then 3 chance in 5 state should be fire")) +(simplify (parse-rule "if state is climax and no neighbours have state equal to fire then 3 chance in 5 state should be fire")) + +(simplify (parse-rule "if state is in grassland or pasture or heath and more than 4 neighbours have state equal to water then state should be village")) + +(simplify (parse-rule "if 6 neighbours have state equal to water then state should be village")) + +(simplify (parse-rule "if fertility is between 55 and 75 then state should be climax")) + +(simplify (parse-rule "if state is forest then state should be climax")) + + +(simplify (parse-rule "if state is in grassland or pasture or heath and more than 4 neighbours have state equal to water then state should be village")) +(simplify (parse-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")) +(simplify (parse-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3")) +(simplify (parse-rule "if altitude is 100 or fertility is 25 then state should be heath")) + +(simplify (parse-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2")) +(simplify (parse-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves")) +(simplify (parse-rule "if state is grassland and 4 neighbours have state equal to water then state should be village"))