Now almost to the point that the new parser can compile simple rules!
This commit is contained in:
parent
52a4f62310
commit
6166dc254c
|
@ -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")
|
||||
|
|
Loading…
Reference in a new issue