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

Trying to get code quality up, but in the process I've broken something -

Browse source 
I think, the simplifier.
This commit is contained in:
simon 2016-08-13 19:45:43 +01:00
parent d2a73ba408
commit 3168c1b2fb
9 changed files with 298 additions and 183 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
src/mw_parser/bulk.clj
View file

@ -1,13 +1,32 @@
;; parse multiple rules from a stream, possibly a file - although the real
;; objective is to parse rules out of a block of text from a textarea
(ns mw-parser.bulk
(ns ^{:doc "parse multiple rules from a stream, possibly a file."
:author "Simon Brooke"}
mw-parser.bulk
(:use mw-parser.declarative
mw-engine.utils
clojure.java.io
[clojure.string :only [split trim]])
(:import (java.io BufferedReader StringReader)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;; USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn comment?
"Is this `line` a comment?"
[line]

145
src/mw_parser/core.clj
View file

@ -1,3 +1,30 @@
(ns ^{:doc "A very simple parser which parses production rules."
:author "Simon Brooke"}
mw-parser.core
(:use mw-engine.utils
[clojure.string :only [split trim triml]])
(:gen-class)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;; USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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"
@ -11,35 +38,31 @@
;; * "if state is in grassland or pasture or heath and 4 neighbours are water then state should be village"
;; * "if state is forest or state is climax and some neighbours have state equal to fire then 3 in 5 chance that state should be fire"
;; * "if state is pasture and more than 3 neighbours have state equal to scrub then state should be scrub"
;; *
;; *
;;
;; it generates rules in the form expected by `mw-engine.core`, q.v.
;;
;; It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil.
;; It is, as I say, very simple; it generates a complete rule, or it fails completely, returning nil.
;; Very occasionally it generates a wrong rule - one which is not a correct translation of the rule
;; semantics - but that is buggy behaviour, which I'll try to fix over the next few weeks, not a
;; design fault.
;;
;; More significantly it does not generate useful error messages on failure.
;;
;; This is the parser that is actually used currently; but see also insta.clj,
;; This is the parser that is actually used currently; but see also insta.clj,
;; which is potentially a much better parser but does not quite work yet.
(ns mw-parser.core
(:use mw-engine.utils
[clojure.string :only [split trim triml]])
(:gen-class)
)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare parse-conditions)
(declare parse-not-condition)
(declare parse-simple-condition)
;; a regular expression which matches string representation of numbers
;; a regular expression which matches string representation of positive numbers
(def re-number #"^[0-9.]*$")
;; error thrown when an attempt is made to set a reserved property
(def reserved-properties-error
(def reserved-properties-error
"The properties 'x' and 'y' of a cell are reserved and should not be set in rule actions")
;; error thrown when a rule cannot be parsed
(def bad-parse-error "I did not understand '%s'")
@ -48,12 +71,12 @@
"If this token appears to represent an explicit number, return that number;
otherwise, make a keyword of it and return that."
[token]
(cond
(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
;; 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
;;
@ -70,7 +93,7 @@
(if (and value (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,
"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]))
@ -115,12 +138,12 @@
[(cons value others) remainder])
true
[(list value) tokens]))))
(defn parse-value
(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
(or
(parse-disjunct-value tokens expect-int)
(parse-simple-value tokens expect-int)))
([tokens]
@ -158,18 +181,18 @@
(list '> value1 property value2)) rest])))
(defn- parse-is-condition
"Parse clauses of the form 'x is y', 'x is in y or z...',
"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
(cond
(member? IS '("is" "are"))
(let [tokens (cons property (cons value rest))]
(cond
(cond
(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
(defn- parse-not-condition
"Parse the negation of a simple condition."
[[property IS NOT & rest]]
(cond (and (member? IS '("is" "are")) (= NOT "not"))
@ -179,11 +202,11 @@
[(list 'not condition) remainder])))))
(defn- gen-neighbours-condition
([comp1 quantity property value remainder comp2 distance]
[(list comp1
([comp1 quantity property value remainder comp2 distance]
[(list comp1
(list 'count
(list 'get-neighbours-with-property-value 'world
'(cell :x) '(cell :y) distance
(list 'get-neighbours-with-property-value 'world
'(cell :x) '(cell :y) distance
(keyword property) (keyword-or-numeric value) comp2))
quantity)
remainder])
@ -195,21 +218,21 @@
[[MORE THAN n NEIGHBOURS WITHIN distance have-or-are & rest]]
(let [quantity (first (parse-numeric-value (list n)))
comparator (cond (= MORE "more") '>
(member? MORE '("fewer" "less")) '<)]
(member? MORE '("fewer" "less")) '<)]
(cond
(not= WITHIN "within")
(parse-comparator-neighbours-condition
(flatten
(parse-comparator-neighbours-condition
(flatten
;; two tokens were mis-parsed as 'within distance' that weren't
;; actually 'within' and a distance. Splice in 'within 1' and try
;; again.
(list MORE THAN n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
(and quantity
(and quantity
comparator
(= THAN "than")
(= NEIGHBOURS "neighbours"))
(cond
(= have-or-are "are")
(= have-or-are "are")
(let [[value & remainder] rest
dist (gen-token-value distance true)]
(gen-neighbours-condition comparator quantity :state value remainder = dist))
@ -217,16 +240,16 @@
(let [[property comp1 comp2 value & remainder] rest
dist (gen-token-value distance true)]
(cond (and (= comp1 "equal") (= comp2 "to"))
(gen-neighbours-condition comparator quantity property
(gen-neighbours-condition comparator quantity property
value remainder = dist)
(and (= comp1 "more") (= comp2 "than"))
(gen-neighbours-condition comparator quantity property
(gen-neighbours-condition comparator quantity property
value remainder > dist)
(and (= comp1 "less") (= comp2 "than"))
(gen-neighbours-condition comparator quantity property
(gen-neighbours-condition comparator quantity property
value remainder < dist)
))))))
(defn parse-some-neighbours-condition
[[SOME NEIGHBOURS & rest]]
(cond
@ -236,18 +259,18 @@
(defn parse-simple-neighbours-condition
"Parse conditions of the form '...6 neighbours are [condition]'"
[[n NEIGHBOURS WITHIN distance have-or-are & rest]]
(let [quantity (first (parse-numeric-value (list n)))]
(let [quantity (first (parse-numeric-value (list n)))]
(cond
(and quantity (= NEIGHBOURS "neighbours"))
(cond
(not= WITHIN "within")
(parse-simple-neighbours-condition
(flatten
(flatten
;; two tokens were mis-parsed as 'within distance' that weren't
;; actually 'within' and a distance. Splice in 'within 1' and try
;; again.
(list n NEIGHBOURS "within" "1" WITHIN distance have-or-are rest)))
(= have-or-are "are")
(= have-or-are "are")
(let [[value & remainder] rest
dist (gen-token-value distance true)]
(gen-neighbours-condition '= quantity :state value remainder = dist))
@ -255,16 +278,16 @@
(let [[property comp1 comp2 value & remainder] rest
dist (gen-token-value distance true)]
(cond (and (= comp1 "equal") (= comp2 "to"))
(gen-neighbours-condition '= quantity property value remainder =
(gen-neighbours-condition '= quantity property value remainder =
dist)
(and (= comp1 "more") (= comp2 "than"))
(gen-neighbours-condition '= quantity property value remainder >
(gen-neighbours-condition '= quantity property value remainder >
dist)
(and (= comp1 "less") (= comp2 "than"))
(gen-neighbours-condition '= quantity property value remainder <
(gen-neighbours-condition '= quantity property value remainder <
dist)
))))))
(defn parse-neighbours-condition
"Parse conditions referring to neighbours"
[tokens]
@ -320,30 +343,30 @@
(= IF "if")
(parse-conditions tokens)))
(defn- parse-arithmetic-action
(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]]
(cond
(member? prop1 '("x" "y"))
(throw
(throw
(Exception. reserved-properties-error))
(and (= SHOULD "should")
(= BE "be")
(member? operator '("+" "-" "*" "/")))
[(list 'merge (or previous 'cell)
{(keyword prop1) (list 'int
{(keyword prop1) (list 'int
(list (symbol operator) (list 'get-int 'cell (keyword prop2))
(cond
(re-matches re-number value) (read-string value)
true (list 'get-int 'cell (keyword value)))))}) rest]))
(defn- parse-set-action
(defn- parse-set-action
"Parse actions of the form '[property] should be [value].'"
[previous [property SHOULD BE value & rest]]
(cond
(cond
(member? property '("x" "y"))
(throw
(throw
(Exception. reserved-properties-error))
(and (= SHOULD "should") (= BE "be"))
[(list 'merge (or previous 'cell)
@ -362,19 +385,19 @@
(parse-actions left (rest remainder))
true (list left)))))
(defn- parse-probability
(defn- parse-probability
"Parse a probability of an action from this collection of tokens"
[previous [n CHANCE IN m & tokens]]
(cond
(cond
(and (= CHANCE "chance")(= IN "in"))
(let [[action remainder] (parse-actions previous tokens)]
(cond action
[(list 'cond
(list '<
(list 'rand
[(list 'cond
(list '<
(list 'rand
(first (parse-simple-value (list m) true)))
(first (parse-simple-value (list n) true)))
action) remainder]))))
(first (parse-simple-value (list n) true)))
action) remainder]))))
(defn- parse-right-hand-side
"Parse the right hand side ('then...') of a production rule."
@ -384,27 +407,27 @@
(parse-probability nil tokens)
(parse-actions nil tokens))))
(defn parse-rule
"Parse a complete rule from this `line`, expected to be either a string or a
(defn parse-rule
"Parse a complete rule from this `line`, expected to be either a string or a
sequence of string tokens. Return the rule in the form of an S-expression.
Throws an exception if parsing fails."
[line]
(cond
(string? line)
(string? line)
(let [rule (parse-rule (split (triml line) #"\s+"))]
(cond rule rule
true (throw (Exception. (format bad-parse-error line)))))
true
true
(let [[left remainder] (parse-left-hand-side line)
[right junk] (parse-right-hand-side remainder)]
(cond
(cond
;; there should be a valide left hand side and a valid right hand side
;; there shouldn't be anything left over (junk should be empty)
(and left right (empty? junk))
(list 'fn ['cell 'world] (list 'if left right))))))
(defn compile-rule
(defn compile-rule
"Parse this `rule-text`, a string conforming to the grammar of MicroWorld rules,
into Clojure source, and then compile it into an anonymous
function object, getting round the problem of binding mw-engine.utils in
@ -417,7 +440,7 @@
(do
(use 'mw-engine.utils)
(let [afn (eval (parse-rule rule-text))]
(cond
(cond
(and afn return-tuple?)(list afn (trim rule-text))
true afn))))
([rule-text]

45
src/mw_parser/declarative.clj
View file

@ -1,11 +1,31 @@
(ns mw-parser.declarative
(:use mw-engine.utils
mw-parser.utils
[mw-parser.errors :as pe]
[mw-parser.generate :as pg]
[mw-parser.simplify :as ps]
[clojure.string :only [split trim triml]])
(:require [instaparse.core :as insta]))
(ns ^{:doc "A very simple parser which parses production rules."
:author "Simon Brooke"}
mw-parser.declarative
(:require [instaparse.core :as insta]
[clojure.string :refer [split trim triml]]
[mw-parser.errors :as pe]
[mw-parser.generate :as pg]
[mw-parser.simplify :as ps]
[mw-parser.utils :refer [rule?]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;; USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def grammar
@ -93,3 +113,12 @@
(compile-rule rule-text false)))
(ps/simplify
(parse-rule
"if more than 2 neighbours have altitude equal to 11 then state should be beach"))
(pg/generate
(ps/simplify
(parse-rule
"if more than 2 neighbours have altitude equal to 11 then state should be beach")))

25
src/mw_parser/errors.clj
View file

@ -1,4 +1,27 @@
(ns mw-parser.errors)
(ns ^{:doc "Display parse errors in a format which makes it easy for the user
to see where the error occurred."
:author "Simon Brooke"}
mw-parser.errors)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;; USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; error thrown when an attempt is made to set a reserved property
(def reserved-properties-error

56
src/mw_parser/generate.clj
View file

@ -1,8 +1,29 @@
(ns mw-parser.generate
(:use mw-engine.utils
mw-parser.utils
(ns ^{:doc "Generate Clojure source from simplified parse trees."
:author "Simon Brooke"}
mw-parser.generate
(:require [mw-engine.utils :refer []]
[mw-parser.utils :refer [assert-type TODO]]
[mw-parser.errors :as pe]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;; USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare generate generate-action)
@ -24,6 +45,8 @@
(defn generate-condition
"From this `tree`, assumed to be a syntactically correct condition clause,
generate and return the appropriate clojure fragment."
[tree]
(assert-type tree :CONDITION)
(generate (second tree)))
@ -31,18 +54,24 @@
(defn generate-conjunct-condition
[tree]
"From this `tree`, assumed to be a syntactically conjunct correct condition clause,
generate and return the appropriate clojure fragment."
(assert-type tree :CONJUNCT-CONDITION)
(cons 'and (map generate (rest tree))))
(defn generate-disjunct-condition
"From this `tree`, assumed to be a syntactically correct disjunct condition clause,
generate and return the appropriate clojure fragment."
[tree]
(assert-type tree :DISJUNCT-CONDITION)
(cons 'or (map generate (rest tree))))
(defn generate-ranged-property-condition
"Generate a property condition where the expression is a numeric range"
"From this `tree`, assumed to be a syntactically property condition clause for
this `property` where the `expression` is a numeric range, generate and return
the appropriate clojure fragment."
[tree property expression]
(assert-type tree :PROPERTY-CONDITION)
(assert-type (nth tree 3) :RANGE-EXPRESSION)
@ -55,7 +84,9 @@
(defn generate-disjunct-property-condition
"Generate a property condition where the expression is a disjunct expression.
"From this `tree`, assumed to be a syntactically property condition clause
where the expression is a a disjunction, generate and return
the appropriate clojure fragment.
TODO: this is definitely still wrong!"
([tree]
(let [property (generate (second tree))
@ -70,6 +101,8 @@
(defn generate-property-condition
"From this `tree`, assumed to be a syntactically property condition clause,
generate and return the appropriate clojure fragment."
([tree]
(assert-type tree :PROPERTY-CONDITION)
(if
@ -100,6 +133,8 @@
(defn generate-qualifier
"From this `tree`, assumed to be a syntactically correct qualifier,
generate and return the appropriate clojure fragment."
[tree]
(if
(= (count tree) 2)
@ -109,6 +144,8 @@
(defn generate-simple-action
"From this `tree`, assumed to be a syntactically correct simple action,
generate and return the appropriate clojure fragment."
([tree]
(assert-type tree :SIMPLE-ACTION)
(generate-simple-action tree []))
@ -126,6 +163,8 @@
(defn generate-probable-action
"From this `tree`, assumed to be a syntactically correct probable action,
generate and return the appropriate clojure fragment."
([tree]
(assert-type tree :PROBABLE-ACTION)
(generate-probable-action tree []))
@ -142,6 +181,8 @@
(defn generate-action
"From this `tree`, assumed to be a syntactically correct action,
generate and return the appropriate clojure fragment."
[tree others]
(case (first tree)
:ACTIONS (generate-action (first tree) others)
@ -151,6 +192,8 @@
(defn generate-multiple-actions
"From this `tree`, assumed to be one or more syntactically correct actions,
generate and return the appropriate clojure fragment."
[tree]
(assert-type tree :ACTIONS)
(generate-action (first (rest tree)) (second (rest tree))))
@ -166,6 +209,8 @@
(defn generate-numeric-expression
"From this `tree`, assumed to be a syntactically correct numeric expression,
generate and return the appropriate clojure fragment."
[tree]
(assert-type tree :NUMERIC-EXPRESSION)
(case (count tree)
@ -182,6 +227,7 @@
([tree]
(assert-type tree :NEIGHBOURS-CONDITION)
(case (first (second tree))
:NUMBER (read-string (second (second tree)))
:QUANTIFIER (generate-neighbours-condition tree (first (second (second tree))))
:QUALIFIER (cons (generate (second tree)) (rest (generate (nth tree 2))))))
([tree quantifier-type]

92
src/mw_parser/simplifier.clj
View file

@ -1,92 +0,0 @@
(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"))

56
src/mw_parser/simplify.clj
View file

@ -1,12 +1,33 @@
(ns mw-parser.simplify
(:use mw-engine.utils
mw-parser.utils))
(ns ^{:doc "Simplify a parse tree."
:author "Simon Brooke"}
mw-parser.simplify
(:require [mw-engine.utils :refer [member?]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;; USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare simplify)
(defn simplify-qualifier
"Given that this `tree` fragment represents a qualifier, what
qualifier is that?"
qualifier is that?"
[tree]
(cond
(empty? tree) nil
@ -19,9 +40,16 @@
(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."
only two elements, the second is semantically sufficient."
[tree]
(if (= (count tree) 2) (simplify (second tree)) tree))
(if (= (count tree) 2) (simplify (nth tree 1)) tree))
(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
@ -31,18 +59,24 @@
(if
(coll? tree)
(case (first tree)
;; '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."
;; TODO: fix this so it actually works.
:ALL [:COMPARATIVE '= 8]
:ACTION (simplify-second-of-two tree)
:ACTIONS (cons (first tree) (simplify (rest tree)))
:CHANCE-IN nil
:ACTIONS (simplify-second-of-two tree)
:COMPARATIVE (simplify-second-of-two tree)
:CONDITION (simplify-second-of-two tree)
:CONDITIONS (simplify-second-of-two tree)
:EXPRESSION (simplify-second-of-two tree)
:NONE [:COMPARATIVE '= 0]
:NUMBER tree
:PROPERTY (simplify-second-of-two tree)
:PROPERTY-CONDITION-OR-EXPRESSION (simplify-second-of-two tree)
:QUALIFIER (simplify-qualifier tree)
:QUANTIFIER (simplify-quantifier tree)
:SOME [:COMPARATIVE '> 0]
:SPACE nil
:THEN nil
:AND nil
:VALUE (simplify-second-of-two tree)
(remove nil? (map simplify tree)))
tree))

23
src/mw_parser/utils.clj
View file

@ -1,4 +1,25 @@
(ns mw-parser.utils)
(ns ^{:doc "Utilities used in more than one namespace within the parser."
:author "Simon Brooke"}
mw-parser.utils)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License
;; as published by the Free Software Foundation; either version 2
;; of the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;; USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn rule?

12
test/mw_parser/declarative_test.clj
View file

@ -472,3 +472,15 @@
(is (nil? (apply afn (list {:x 0 :y 1} world)))
"Middle cell of the strip has only two high neighbours, so rule should not fire."))
))
(deftest regression-tests
(testing "Rule in default set which failed on switchover to declarative rules"
(let [afn (compile-rule "if state is scrub then 1 chance in 5 state should be forest")
world (transform-world
(make-world 3 3)
(list (compile-rule "if x is 2 then altitude should be 11")
(compile-rule "if x is less than 2 then state should be scrub")))]
(is (= (:state (apply afn (list {:x 1 :y 1} world))) :forest)
"Centre cell is scrub, so rule should fire")
(is (= (:state (apply afn (list {:x 2 :y 1} world))) :beach)
"Middle cell of the strip is not scrub, so rule should not fire."))))