From 0716b517cb4029a52b7c3dc4fae2319d79c83085 Mon Sep 17 00:00:00 2001 From: simon Date: Thu, 10 Mar 2016 08:31:04 +0000 Subject: [PATCH] This again doesn't compile, with the same error - can't take nth of symbol - as previously, and again I don't know why. --- project.clj | 3 +- src/cljs/mw3/core.cljs | 1 + src/cljs/mw3/parser.cljc | 356 +++++++++++++++++++++++++++++++++++++++ src/cljs/mw3/utils.cljc | 274 ++++++++++++++++++++++++++++++ 4 files changed, 633 insertions(+), 1 deletion(-) create mode 100644 src/cljs/mw3/parser.cljc create mode 100644 src/cljs/mw3/utils.cljc diff --git a/project.clj b/project.clj index 98116b9..1fdfb7e 100644 --- a/project.clj +++ b/project.clj @@ -16,7 +16,8 @@ [secretary "1.2.3"] [environ "1.0.2"] [prismatic/dommy "1.1.0"] - [immoh/dommy.template "0.2.0"]] + [immoh/dommy.template "0.2.0"] + [com.lucasbradstreet/instaparse-cljs "1.4.1.0"]] :plugins [[lein-cljsbuild "1.1.1"] [lein-environ "1.0.1"]] diff --git a/src/cljs/mw3/core.cljs b/src/cljs/mw3/core.cljs index 33de0c2..eb2dc9b 100644 --- a/src/cljs/mw3/core.cljs +++ b/src/cljs/mw3/core.cljs @@ -1,4 +1,5 @@ (ns ^:figwheel-always mw3.core + (:use mw3.utils) (:use-macros [dommy.template :only [node deftemplate]]) (:require-macros [cljs.core.async.macros :refer [go]]) (:require diff --git a/src/cljs/mw3/parser.cljc b/src/cljs/mw3/parser.cljc new file mode 100644 index 0000000..7567b9a --- /dev/null +++ b/src/cljs/mw3/parser.cljc @@ -0,0 +1,356 @@ +(ns ^:figwheel-always mw3.core + (:use mw3.utils + [clojure.string :only [split trim triml]]) + (:require [instaparse.core :as insta])) + +;; error thrown when an attempt is made to set a reserved property +(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. Slots are for +;; (1) rule text +;; (2) cursor showing where in the rule text the error occurred +;; (3) the reason for the error +(defn bad-parse-error + [rule-text cursor reason] + (str "I did not understand:\n'" rule-text "'\n" cursor "\n" reason)) + +(def grammar + ;; 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; + CONDITION := NEIGHBOURS-CONDITION | PROPERTY-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; + 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; + NEGATED-QUALIFIER := QUALIFIER SPACE NOT | NOT SPACE QUALIFIER; + COMPARATIVE-QUALIFIER := IS SPACE COMPARATIVE SPACE THAN; + QUALIFIER := COMPARATIVE-QUALIFIER | NEGATED-QUALIFIER | EQUIVALENCE | IS SPACE QUALIFIER; + QUANTIFIER := NUMBER | SOME | NONE | ALL | COMPARATIVE SPACE THAN SPACE NUMBER; + 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'; + NOT := 'not'; + AND := 'and'; + SOME := 'some'; + NONE := 'no'; + ALL := 'all' + BETWEEN := 'between'; + WITHIN := 'within'; + IN := 'in'; + MORE := 'more'; + LESS := 'less' | 'fewer'; + OPERATOR := '+' | '-' | '*' | '/'; + NEIGHBOURS := 'neighbour' | 'neighbor' | 'neighbours' | 'neighbors'; + PROPERTY := SYMBOL; + VALUE := SYMBOL | NUMBER; + 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 + ACTION := SIMPLE-ACTION | PROBABLE-ACTION; + PROBABLE-ACTION := VALUE SPACE 'chance in' SPACE VALUE SPACE SIMPLE-ACTION; + SIMPLE-ACTION := SYMBOL SPACE BECOMES SPACE EXPRESSION + BECOMES := 'should be' + SPACE := #' *'" + ) + +(defn TODO + "Marker to indicate I'm not yet finished!" + [message] + message) + +(declare generate simplify) + +(defn suitable-fragment? + "Return `true` if `tree-fragment` appears to be a tree fragment of the expected `type`." + [tree-fragment type] + (and (coll? tree-fragment)(= (first tree-fragment) type))) + +(defn assert-type + "If `tree-fragment` is not a tree fragment of the expected `type`, throw an exception." + [tree-fragment type] + (assert (suitable-fragment? tree-fragment type) + (throw (error (str "Expected a " type " fragment"))))) + +(defn generate-rule + "From this `tree`, assumed to be a syntactically correct rule specification, + generate and return the appropriate rule as a function of two arguments." + [tree] + (assert-type tree :RULE) + (list 'fn ['cell 'world] (list 'if (generate (nth tree 2)) (generate (nth tree 3))))) + +(defn generate-conditions + "From this `tree`, assumed to be a syntactically correct conditions clause, + generate and return the appropriate clojure fragment." + [tree] + (assert-type tree :CONDITIONS) + (generate (nth tree 1))) + +(defn generate-condition + [tree] + (assert-type tree :CONDITION) + (generate (nth tree 1))) + +(defn generate-conjunct-condition + [tree] + (assert-type tree :CONJUNCT-CONDITION) + (list 'and (generate (nth tree 1))(generate (nth tree 3)))) + +(defn generate-disjunct-condition + "Generate a property condition where the expression is a disjunct expression" + [tree] + (assert-type tree :DISJUNCT-CONDITION) + (list 'or (generate (nth tree 1))(generate (nth tree 3)))) + +(defn generate-ranged-property-condition + "Generate a property condition where the expression is a numeric range" + [tree property expression] + (assert-type tree :PROPERTY-CONDITION) + (assert-type (nth tree 3) :RANGE-EXPRESSION) + (let [l1 (generate (nth expression 2)) + l2 (generate (nth expression 4)) + pv (list property 'cell)] + (list 'let ['lower (list 'min l1 l2) + 'upper (list 'max l1 l2)] + (list 'and (list '>= pv 'lower)(list '<= pv 'upper))))) + +(defn generate-disjunct-condition-4 + "Generate a property condition where the expression is a disjunct expression" + [tree property qualifier expression] + (let [e (list 'some (list 'fn ['i] '(= i value)) (list 'quote expression))] + (list 'let ['value (list property 'cell)] + (if (= qualifier '=) e + (list 'not e))))) + +(defn generate-property-condition + ([tree] + (assert-type tree :PROPERTY-CONDITION) + (generate-property-condition tree (first (nth tree 3)))) + ([tree expression-type] + (assert-type tree :PROPERTY-CONDITION) + (let [property (generate (nth tree 1)) + qualifier (generate (nth tree 2)) + expression (generate (nth tree 3))] + (case expression-type + :DISJUNCT-EXPRESSION (generate-disjunct-condition-4 tree property qualifier expression) + :RANGE-EXPRESSION (generate-ranged-property-condition tree property expression) + (list qualifier (list property 'cell) expression))))) + +(defn generate-simple-action + [tree] + (assert-type tree :SIMPLE-ACTION) + (let [property (generate (nth tree 1)) + expression (generate (nth tree 3))] + (if (or (= property :x) (= property :y)) + (throw (error reserved-properties-error)) + (list 'merge 'cell {property expression})))) + +(defn generate-multiple-actions + [tree] + nil) +;; (assert (and (coll? tree)(= (first tree) :ACTIONS)) "Expected an ACTIONS fragment") +;; (conj 'do (map + +(defn generate-disjunct-value + "Generate a disjunct value. Essentially what we need here is to generate a + flat list of values, since the `member` has already been taken care of." + [tree] + (assert-type tree :DISJUNCT-VALUE) + (if (= (count tree) 4) + (cons (generate (second tree)) (generate (nth tree 3))) + (list (generate (second tree))))) + +(defn generate-numeric-expression + [tree] + (assert-type tree :NUMERIC-EXPRESSION) + (case (first (second tree)) + :SYMBOL (list (keyword (second (second tree))) 'cell) + (generate (second tree)))) + +(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 + "Generate code for this (fragment of a) parse tree" + [tree] + (if + (coll? tree) + (case (first tree) + :ACTIONS (generate-multiple-actions tree) + :COMPARATIVE (generate (second tree)) + :COMPARATIVE-QUALIFIER (generate (nth tree 2)) + :CONDITION (generate-condition tree) + :CONDITIONS (generate-conditions tree) + :CONJUNCT-CONDITION (generate-conjunct-condition tree) + :DISJUNCT-CONDITION (generate-disjunct-condition tree) + :DISJUNCT-EXPRESSION (generate (nth tree 2)) + :DISJUNCT-VALUE (generate-disjunct-value tree) + :EQUIVALENCE '= + :EXPRESSION (generate (second tree)) + :LESS '< + :MORE '> + :NEGATED-QUALIFIER (case (generate (second tree)) + = 'not= + > '< + < '>) + :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) + :SYMBOL (keyword (second tree)) + :VALUE (generate (second tree)) + (map generate tree)) + tree)) + + +(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 rule? + "Return true if the argument appears to be a parsed rule tree, else false." + [maybe-rule] + (and (coll? maybe-rule) (= (first maybe-rule) :RULE))) + +(defn simplify + "Simplify/canonicalise this `tree`. Opportunistically replace complex fragments with + semantically identical simpler fragments" + [tree] + (if + (coll? tree) + (case (first tree) + :ACTION (simplify-second-of-two tree) + :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) +;; :QUANTIFIER (simplify-second-of-two tree) + :NOT nil + :PROPERTY (simplify-second-of-two tree) + :SPACE nil + :THEN nil + ;; :QUALIFIER (simplify-qualifier tree) + :VALUE (simplify-second-of-two tree) + (remove nil? (map simplify tree))) + tree)) + +(def parse-rule + "Parse the argument, assumed to be a string in the correct syntax, and return a parse tree." + (insta/parser grammar)) + +(defn explain-parse-error-reason + "Attempt to explain the reason for the parse error." + [reason] + (str "Expecting one of (" (apply str (map #(str (:expecting %) " ") (first reason))) ")")) + +(defn throw-parse-exception + "Construct a helpful error message from this `parser-error`, and throw an exception with that message." + [parser-error] + (assert (coll? parser-error) "Expected a paser error structure?") + (let + [ + ;; the error structure is a list, such that each element is a list of two items, and + ;; the first element in each sublist is a keyword. Easier to work with it as a map + error-map (reduce (fn [map item](merge map {(first item)(rest item)})) {} parser-error) + text (first (:text error-map)) + reason (explain-parse-error-reason (:reason error-map)) + ;; rules have only one line, by definition; we're interested in the column + column (if (:column error-map)(first (:column error-map)) 0) + ;; create a cursor to point to that column + cursor (apply str (reverse (conj (repeat column " ") "^"))) + message (bad-parse-error text cursor reason) + ] + (throw (error message)))) + +(defn compile-rule + "Compile this `rule`, assumed to be a string with appropriate syntax, into a function of two arguments, + a `cell` and a `world`, having the same semantics." + [rule] + (assert (string? rule)) + (let [tree (simplify (parse-rule rule))] + (if (rule? tree) (eval (generate tree)) + (throw-parse-exception tree)))) diff --git a/src/cljs/mw3/utils.cljc b/src/cljs/mw3/utils.cljc new file mode 100644 index 0000000..16a8e12 --- /dev/null +++ b/src/cljs/mw3/utils.cljc @@ -0,0 +1,274 @@ +(ns ^:figwheel-always mw3.utils) + +(defn error + [message] + #?(:cljs (js/Error. message) + :clj (Exception. message))) + +(defn nth + "I'm getting a compilation error saying `nth` isn't defined; so I'm defining it." + [collection index] + {:pre [(and (coll? collection) (integer? index) (or (zero? index) (pos? index)))]} + (cond + (empty? collection) nil + (zero? index) (first collection) + :true (nth (rest collection) (dec index)))) + +(defn abs + "Surprisingly, Clojure doesn't seem to have an abs function, or else I've + missed it. So here's one of my own. Maps natural numbers onto themselves, + and negative integers onto natural numbers. Also maps negative real numbers + onto positive real numbers. + + * `n` a number, on the set of real numbers." + [n] + (if (neg? n) (- 0 n) n)) + +(defn member? + "True if elt is a member of col." + [elt col] (some #(= elt %) col)) + +(defn get-int-or-zero + "Return the value of this `property` from this `map` if it is a integer; + otherwise return zero." + [map property] + (let [value (map property)] + (if (integer? value) value 0))) + +(defn init-generation + "Return a cell like this `cell`, but having a value for :generation, zero if + the cell passed had no integer value for generation, otherwise the value + taken from the cell passed. The `world` argument is present only for + consistency with the rule engine and is ignored." + [world cell] + (merge cell {:generation (get-int-or-zero cell :generation)})) + + +(defn in-bounds + "True if x, y are in bounds for this world (i.e., there is a cell at x, y) + else false. + + * `world` a world as defined above; + * `x` a number which may or may not be a valid x coordinate within that world; + * `y` a number which may or may not be a valid y coordinate within that world." + [world x y] + (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world))))) + +#?(:cljs + ;; conditional compilation: JavaScript doesn't do parallel mapping. + (defn map-world + "Wholly non-parallel map world implementation" + ([world function] + (map-world world function nil)) + ([world function additional-args] + (into [] + (map (fn [row] + (into [] (map + #(apply function + (cons world (cons % additional-args))) + row))) + world)))) + :clj + (defn map-world + "Apply this `function` to each cell in this `world` to produce a new world. + the arguments to the function will be the world, the cell, and any + `additional-args` supplied. Note that we parallel map over rows but + just map over cells within a row. That's because it isn't worth starting + a new thread for each cell, but there may be efficiency gains in + running rows in parallel." + ([world function] + (map-world world function nil)) + ([world function additional-args] + (into [] + (pmap (fn [row] + (into [] (map + #(apply function + (cons world (cons % additional-args))) + row))) + world))))) + +(defn get-cell + "Return the cell a x, y in this world, if any. + + * `world` a world as defined above; + * `x` a number which may or may not be a valid x coordinate within that world; + * `y` a number which may or may not be a valid y coordinate within that world." + [world x y] + (cond (in-bounds world x y) + (nth (nth world y) x))) + +(defn get-int + "Get the value of a property expected to be an integer from a map; if not present (or not an integer) return 0. + + * `map` a map; + * `key` a symbol or keyword, presumed to be a key into the `map`." + [map key] + (cond (map? map) + (let [v (map key)] + (cond (and v (integer? v)) v + true 0)) + true (throw (error "No map passed?")))) + +(defn population + "Return the population of this species in this cell. Currently a synonym for + `get-int`, but may not always be (depending whether species are later + implemented as actors) + + * `cell` a map; + * `species` a keyword representing a species which may populate that cell." + [cell species] + (get-int cell species)) + +(defn cartesian-product [x-seq y-seq] + (map (fn [n] (map #(list n %)) x-seq) y-seq)) + ;; not right, but nearly + +(def memo-get-neighbours + "Memoised get neighbours is more efficient when running deeply recursive + algorithms on the same world. But it's less efficient when running the + engine in its normal iterative style, because then we will rarely call + get naighbours on the same cell of the same world twice." + (memoize + (fn [world x y depth] + (remove nil? + (map #(get-cell world (first %) (first (rest %))) + (remove #(= % (list x y)) + (cartesian-product + (range (- x depth) (+ x depth 1)) + (range (- y depth) (+ y depth 1))))))))) + +(defn get-neighbours + "Get the neighbours to distance depth of a cell in this world. + + Several overloads: + * `world` a world, as described in world.clj; + * `cell` a cell within that world + Gets immediate neighbours of the specified cell. + + * `world` a world, as described in world.clj; + * `cell` a cell within that world + * `depth` an integer representing the depth to search from the + `cell` + Gets neighbours within the specified distance of the cell. + + * `world` a world, as described in world.clj; + * `x` an integer representing an x coordinate in that world; + * `y` an integer representing an y coordinate in that world; + * `depth` an integer representing the distance from [x,y] that + should be searched + Gets the neighbours within the specified distance of the cell at + coordinates [x,y] in this world." + ([world x y depth] + (remove nil? + (map #(get-cell world (first %) (first (rest %))) + (remove #(= % (list x y)) + (cartesian-product + (range (- x depth) (+ x depth 1)) + (range (- y depth) (+ y depth 1))))))) + ([world cell depth] + (memo-get-neighbours world (:x cell) (:y cell) depth)) + ([world cell] + (get-neighbours world cell 1))) + +;; (defn get-neighbours-with-property-value +;; "Get the neighbours to distance depth of the cell at x, y in this world which +;; have this value for this property. + +;; * `world` a world, as described in `world.clj`; +;; * `cell` a cell within that world; +;; * `depth` an integer representing the distance from [x,y] that +;; should be searched (optional); +;; * `property` a keyword representing a property of the neighbours; +;; * `value` a value of that property (or, possibly, the name of another); +;; * `op` a comparator function to use in place of `=` (optional). + +;; It gets messy." +;; ([world x y depth property value op] +;; (filter +;; #(eval +;; (list op +;; (or (get % property) (get-int % property)) +;; value)) +;; (get-neighbours world x y depth))) +;; ([world x y depth property value] +;; (get-neighbours-with-property-value world x y depth property value =)) +;; ([world cell depth property value] +;; (get-neighbours-with-property-value world (:x cell) (:y cell) depth +;; property value)) +;; ([world cell property value] +;; (get-neighbours-with-property-value world cell 1 +;; property value))) + +(defn get-neighbours-with-state + "Get the neighbours to distance depth of the cell at x, y in this world which + have this state. + + * `world` a world, as described in `world.clj`; + * `cell` a cell within that world; + * `depth` an integer representing the distance from [x,y] that + should be searched; + * `state` a keyword representing a state in the world." + ([world x y depth state] + (filter #(= (:state %) state) (get-neighbours world x y depth))) + ([world cell depth state] + (get-neighbours-with-state world (:x cell) (:y cell) depth state)) + ([world cell state] + (get-neighbours-with-state world cell 1 state))) + +(defn get-least-cell + "Return the cell from among these `cells` which has the lowest numeric value + for this `property`; if the property is absent or not a number, use this + `default`" + ([cells property default] + (cond + (empty? cells) nil + true (let [downstream (get-least-cell (rest cells) property default)] + (cond (< + (or (property (first cells)) default) + (or (property downstream) default)) (first cells) + true downstream)))) + ([cells property] + (get-least-cell cells property #?(:cljs 900719925474099 + :clj (Integer/MAX_VALUE))))) + + +(defn- set-cell-property + "If this `cell`s x and y properties are equal to these `x` and `y` values, + return a cell like this cell but with the value of this `property` set to + this `value`. Otherwise, just return this `cell`." + [cell x y property value] + (cond + (and (= x (:x cell)) (= y (:y cell))) + (merge cell {property value :rule "Set by user"}) + true + cell)) + +(defn set-property + "Return a world like this `world` but with the value of exactly one `property` + of one `cell` changed to this `value`" + ([world cell property value] + (set-property world (:x cell) (:y cell) property value)) + ([world x y property value] + (apply + vector ;; we want a vector of vectors, not a list of lists, for efficiency + (map + (fn [row] + (apply + vector + (map #(set-cell-property % x y property value) + row))) + world)))) + +(defn merge-cell + "Return a world like this `world`, but merge the values from this `cell` with + those from the cell in the world with the same co-ordinates" + [world cell] + (if (in-bounds world (:x cell) (:y cell)) + (map-world world + #(if + (and + (= (:x cell)(:x %2)) + (= (:y cell)(:y %2))) + (merge %2 cell) + %2)) + world))