Now almost to the point that the new parser can compile simple rules!

This commit is contained in:
Simon Brooke 2015-02-13 22:25:53 +00:00
parent 52a4f62310
commit 6166dc254c

View file

@ -5,28 +5,43 @@
(def grammar
"RULE := 'if' SPACE CONDITIONS SPACE 'then' SPACE ACTIONS;
;; in order to simplify translation into other natural languages, all
;; TOKENS within the parser should be unambiguous
"RULE := IF SPACE CONDITIONS SPACE THEN SPACE ACTIONS;
CONDITIONS := DISJUNCT-CONDITION | CONJUNCT-CONDITION | PROPERTY-CONDITION | NEIGHBOURS-CONDITION ;
DISJUNCT-CONDITION := CONDITION SPACE 'or' SPACE CONDITIONS;
CONJUNCT-CONDITION := CONDITION SPACE 'and' SPACE CONDITIONS;
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;
PROPERTY-CONDITION := PROPERTY SPACE QUALIFIER SPACE EXPRESSION;
EXPRESSION := SIMPLE-EXPRESSION | RANGE-EXPRESSION | NUMERIC-EXPRESSION | DISJUNCT-EXPRESSION | VALUE;
SIMPLE-EXPRESSION := QUALIFIER SPACE EXPRESSION | VALUE;
DISJUNCT-EXPRESSION := 'in' SPACE DISJUNCT-VALUE;
RANGE-EXPRESSION := 'between' SPACE NUMERIC-EXPRESSION SPACE 'and' SPACE NUMERIC-EXPRESSION;
DISJUNCT-EXPRESSION := IN SPACE DISJUNCT-VALUE;
RANGE-EXPRESSION := BETWEEN SPACE NUMERIC-EXPRESSION SPACE AND SPACE NUMERIC-EXPRESSION;
NUMERIC-EXPRESSION := VALUE | VALUE SPACE OPERATOR SPACE NUMERIC-EXPRESSION;
QUALIFIER := COMPARATIVE SPACE 'than' | EQUIVALENCE | IS SPACE QUALIFIER;
NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';
QUANTIFIER := NUMBER | 'some' | 'no' | 'all';
EQUIVALENCE := IS SPACE 'equal to' | 'equal to' | IS ;
COMPARATIVE := 'more' | 'less' | 'fewer';
QUALIFIER := COMPARATIVE SPACE THAN | EQUIVALENCE | IS SPACE QUALIFIER;
QUANTIFIER := NUMBER | SOME | NONE | ALL;
EQUIVALENCE := IS SPACE EQUAL | EQUAL | IS ;
COMPARATIVE := MORE | LESS;
DISJUNCT-VALUE := VALUE | VALUE SPACE OR SPACE DISJUNCT-VALUE;
IF := 'if';
THEN := 'then';
THAN := 'than';
OR := 'or';
AND := 'and';
SOME := 'some';
NONE := 'no';
ALL := 'all'
BETWEEN := 'between';
IN := 'in';
MORE := 'more';
LESS := 'less' | 'fewer';
OPERATOR := '+' | '-' | '*' | '/';
NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors';
PROPERTY := SYMBOL;
DISJUNCT-VALUE := VALUE | VALUE SPACE 'or' SPACE DISJUNCT-VALUE;
VALUE := SYMBOL | NUMBER;
IS := 'is' | 'are' | 'have';
EQUAL := 'equal to';
IS := 'is' | 'are' | 'have' | 'has';
NUMBER := #'[0-9]+' | #'[0-9]+.[0-9]+';
SYMBOL := #'[a-z]+';
ACTIONS := ACTION | ACTION SPACE 'and' SPACE ACTIONS
@ -42,7 +57,7 @@
message)
(declare generate)
(declare generate simplify)
(defn generate-rule
"From this `tree`, assumed to be a syntactically correct rule specification,
@ -70,58 +85,93 @@
[tree]
(list 'or (generate (nth tree 1))(generate (nth tree 3))))
(defn generate-qualifier
"Return more than (>), less than (<) or equal to (=) depending on the `qualifier`."
[qualifier]
(TODO "not written yet")
tree)
(defn generate-property-condition
[tree]
(let [property (generate (nth tree 1))
qualifier (generate (nth tree 2))
expression (generate (nth tree 3))]
(list qualifier (list (keyword property) 'cell) expression)))
(list qualifier (list property 'cell) expression)))
(defn generate-simple-action
[tree]
(let [property (generate (nth tree 1))
expression (generate (nth tree 3))]
(list 'merge 'cell {property expression})))
(defn generate
"Generate code for this (fragment of a) parse tree"
[tree]
(if
(coll? tree)
(case (first tree)
:RULE (generate-rule tree)
:CONDITIONS (generate-conditions tree)
:CONDITION (generate-condition tree)
;; :NEIGHBOURS-CONDITION (generate-neighbours-condition tree)
;; :NEIGHBOURS-CONDITION (generate-neighbours-condition tree)
:DISJUNCT-CONDITION (generate-disjunct-condition tree)
:CONJUNCT-CONDITION (generate-conjunct-condition tree)
:PROPERTY-CONDITION (generate-property-condition tree)
;; :EXPRESSION (generate-expression tree)
;; :SIMPLE-EXPRESSION
:SIMPLE-ACTION (generate-simple-action tree)
:SYMBOL (keyword (second tree))
:NUMBER (read-string (second tree))
:EQUIVALENCE '=
:MORE '>
:LESS '<
;; :EXPRESSION (generate-expression tree)
;; :SIMPLE-EXPRESSION
(map generate tree))
tree))
(defn prune-tree
"Simplify/canonicalise the `tree`. Opportunistically replace complex fragments with
semantically identical simpler fragments"
[tree]
(TODO "not written yet")
tree)
(defn clean-tree
"Returns a structure which is structurally equivalent to `tree` but which has
the noise tokens (spaces) removed. As a side effect this new structure is a
list, not a vector, but that is not a desideratum and you should not rely in it."
(defn simplify-qualifier
"Given that this `tree` fragment represents a qualifier, what
qualifier is that?"
[tree]
(cond
(and (coll? tree) (= (first tree) :SPACE)) nil
(coll? tree) (remove nil? (map clean-tree tree))
(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))
(def rule-parser
(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
"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-second-of-two 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)
(remove nil? (map simplify tree)))
tree))
(def parse-rule
(insta/parser grammar))
(defn compile-rule [rule]
(generate (prune-tree (clean-tree (rule-parser rule)))))
(defn compile-rule
[rule]
nil)
;; (generate (prune-tree (parse-rule rule))))
@ -129,20 +179,20 @@
(compile-rule "if state is climax and some neighbours have state equal to fire then 3 chance in 5 state should be fire")
(rule-parser "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village")
(compile-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village")
(rule-parser "if 6 neighbours have state equal to water then state should be village")
(compile-rule "if 6 neighbours have state equal to water then state should be village")
(rule-parser "if fertility is between 55 and 75 then state should be climax")
(compile-rule "if fertility is between 55 and 75 then state should be climax")
(rule-parser "if state is forest then state should be climax")
(compile-rule "if state is forest then state should be climax")
(rule-parser "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village")
(rule-parser "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")
(rule-parser "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3")
(rule-parser "if altitude is 100 or fertility is 25 then state should be heath")
(compile-rule "if state is in grassland or pasture or heath and 4 neighbours have state equal to water then state should be village")
(compile-rule "if altitude is less than 100 and state is forest then state should be climax and deer should be 3")
(compile-rule "if altitude is 100 or fertility is 25 then state should be heath and fertility should be 24.3")
(compile-rule "if altitude is 100 or fertility is 25 then state should be heath")
(rule-parser "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2")
(rule-parser "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves")
(rule-parser "if state is grassland and 4 neighbours have state equal to water then state should be village")
(compile-rule "if deer is more than 2 and wolves is 0 and fertility is more than 20 then deer should be deer + 2")
(compile-rule "if deer is more than 1 and wolves is more than 1 then deer should be deer - wolves")
(compile-rule "if state is grassland and 4 neighbours have state equal to water then state should be village")