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

Added the simplifier, although it's not currently used, I don't think

Browse source
This commit is contained in:
simon 2016-03-04 01:02:17 +00:00
parent 717097070a
commit 547edbe56a
3 changed files with 151 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
project.clj
View file

@ -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"]
])

77
src/mw_parser/declarative.clj
View file

@ -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

92
src/mw_parser/simplifier.clj Normal file
View file

@ -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"))