More work on flow rules. All rules must now have metadata

Better error capturing!

src/cljc/mw_engine/core.clj

@@ -22,7 +22,9 @@
             further rules can be applied to that cell."
       :author "Simon Brooke"}
  mw-engine.core
-  (:require [mw-engine.utils :refer [get-int-or-zero map-world]]
+  (:require [clojure.string :refer [starts-with?]]
+            [mw-engine.flow :refer [flow-world]]
+            [mw-engine.utils :refer [get-int-or-zero map-world rule-type]]
             [taoensso.timbre :as l]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -55,23 +57,21 @@
    an ifn, or a list (ifn source-text). This function deals with despatching
    on those two possibilities. `world` is also passed in in order to be able
    to access neighbours."
-  ([world cell rule]
+  [world cell rule]
-   (cond
+  (cond
-     (ifn? rule) (apply-rule world cell rule nil)
+    (ifn? rule) (apply rule (list cell world))
-     (seq? rule) (let [[afn src] rule] (apply-rule world cell afn src))))
+    (seq? rule) (let [[afn src lisp] rule
-  ([world cell rule source]
+                      result (apply-rule world cell afn)]
-   (let [result (apply rule (list cell world))]
+                  (when result
-     (cond
+                    (merge result {:rule src
-       (and result source) (merge result {:rule source})
+                                   :lisp lisp})))))
-       :else result))))
 
 (defn- apply-rules
   "Derive a cell from this `cell` of this `world` by applying these `rules`."
   [world cell rules]
-  (cond (empty? rules) cell
+  (or
-        :else (let [result (apply-rule world cell (first rules))]
+   (first (remove nil? (map #(apply-rule world cell %) rules)))
-                (cond result result
+   cell))
-                      :else (apply-rules world cell (rest rules))))))
 
 (defn- transform-cell
   "Derive a cell from this `cell` of this `world` by applying these `rules`. If an
@@ -83,33 +83,45 @@
      {:generation (+ (get-int-or-zero cell :generation) 1)})
     (catch Exception e
       (merge cell {:error
-                   (format "%s at generation %d when in state %s"
+                   (format "%s with message `%s` at generation %d when in state %s"
+                           (-> e .getClass .getName)
                            (.getMessage e)
                            (:generation cell)
                            (:state cell))
-                   :stacktrace (map #(.toString %) (.getStackTrace e))
+                   :stacktrace ;; (remove #(starts-with? % "clojure.") 
+                                       (map #(.toString %) (.getStackTrace e))
+                               ;;)
                    :state :error}))))
 
 (defn transform-world
-  "Return a world derived from this `world` by applying these `rules` to each cell."
+  "Return a world derived from this `world` by applying the production rules 
-  ([world rules]
+  found among these `rules` to each cell."
-   (map-world world transform-cell (list rules))))
+  [world rules]
+  (map-world world transform-cell
+             ;; Yes, that `list` is there for a reason! 
+             (list
+              (filter
+               #(= :production (rule-type %))
+               rules))))
 
 (defn run-world
   "Run this world with these rules for this number of generations.
 
-  * `world` a world as discussed above;
+   * `world` a world as discussed above;
-  * `init-rules` a sequence of rules as defined above, to be run once to initialise the world;
+   * `init-rules` a sequence of rules as defined above, to be run once to initialise the world;
-  * `rules` a sequence of rules as defined above, to be run iteratively for each generation;
+   * `rules` a sequence of rules as defined above, to be run iteratively for each generation;
-  * `generations` an (integer) number of generations.
+   * `generations` an (integer) number of generations.
-
+   
-  Return the final generation of the world."
+   **NOTE THAT** all rules **must** be tagged with `rule-type` metadata, or thet **will not**
-  [world init-rules rules generations]
+   be executed.
-  (reduce (fn [world iteration]
-            (l/info "Running iteration " iteration)
-            (transform-world world rules))
-          (transform-world world init-rules)
-          (range generations)))
-
-
 
+   Return the final generation of the world."
+  ([world rules generations]
+   (run-world world rules rules (dec generations)))
+  ([world init-rules rules generations]
+   (reduce (fn [world iteration]
+             (l/info "Running iteration " iteration)
+             (let [w' (transform-world world rules)]
+               (flow-world w' rules)))
+           (transform-world world init-rules)
+           (range generations))))

src/cljc/mw_engine/flow.clj

@@ -22,7 +22,8 @@
    there's a planning stage, in which all the flows to be executed are computed
    without changing the world, and then an execution stage, where they're all 
    executed. This namespace deals with mainly with execution."
-  (:require [mw-engine.utils :refer [get-cell get-num in-bounds? merge-cell]]
+  (:require [mw-engine.utils :refer [get-cell get-num in-bounds? merge-cell
+                                     rule-type]]
             [taoensso.timbre :refer [info warn]]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -104,7 +105,7 @@
           d' (assoc dest p (+ (get-num dest p) q))]
       (if (= q (:quantity flow))
         (info (format "Moving %f units of %s from %d,%d to %d,%d"
-                    (float q) (name p) sx sy dx dy))
+                      (float q) (name p) sx sy dx dy))
         (warn (format "Moving %s from %d,%d to %d,%d; %f units ordered but only %f available"
                       (name p) sx sy dx dy (float (:quantity flow)) (float q))))
       (merge-cell (merge-cell world s') d'))
@@ -118,6 +119,28 @@
   [world flows]
   (reduce execute world (filter #(flow? % world) flows)))
 
+(defn plan-flows
+  "Plan, but do not execute, all the flows in this `world` implied by these
+   `flow-rules` (which are expected to be pre-compiled). Return the list of
+   plans, as flow objects."
+  [world flow-rules]
+  (assert (every? #(= :flow (rule-type %)) flow-rules))
+  (remove nil?
+          (flatten
+           (map ;; across all the cells
+            (fn [cell]
+              (map ;; across all the rules
+               (fn [rule] (apply rule (list cell world)))
+               flow-rules))
+            (flatten world)))))
+
+(defn flow-world
+      "Return a world derived from this `world` by applying the flow rules 
+      found among these `rules` to each cell, and executing all the flows
+       planned."
+  [world rules]
+  (execute-flows world (plan-flows world (filter #(= :flow (rule-type %)) rules))))
+
 ;; building blocks for compiled flow rules
 
 (defmacro create-location

src/cljc/mw_engine/heightmap.clj

@@ -32,6 +32,12 @@
 ;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defn abs 
+  "Prior to Clojure 1.11, there is no native `abs` function. Afterwards, there
+   is."
+  [n] 
+  (Math/abs n))
+
 (defn tag-property
   "Set the value of this `property` of this cell from the corresponding pixel of this `heightmap`.
    If the heightmap you supply is smaller than the world, this will break.

src/cljc/mw_engine/utils.clj

@@ -299,3 +299,8 @@
                   (merge %2 cell)
                   %2))
     world))
+
+(defn rule-type
+  "Return the rule-type of this compiled `rule`."
+  [rule]
+  (:rule-type (meta rule)))

src/cljc/mw_engine/world.clj

@@ -35,6 +35,24 @@
 ;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defn cell?
+  "Return `true` if `obj` is a cell, as understood by MicroWorld, else `false`."
+  [obj]
+  (and (map? obj) ;; it's a map...
+       ;; TODO: it's worth checking (and this does not) that cells have the
+       ;; right co-ordinates!
+       (pos-int? (:x obj)) ;; with an x co-ordinate...
+       (pos-int? (:y obj)) ;; and a y co-ordinate...
+       (keyword? (:state obj)))) ;; and a state which is a keyword.
+
+(defn world?
+  "Return `true` if `obj` is a world, as understood by MicroWorld, else `false`."
+  [obj]
+  (and (coll? obj) ;; it's a collection...
+       (every? coll? obj) ;; of collections...
+       (= 1 (count (set (map count obj)))) ;; all of which are the same length...
+       (every? cell? (flatten obj)))) ;; and every element of each of those is a cell.
+
 (defmacro make-cell
   "Create a minimal default cell at x, y
 

test/mw_engine/core_test.clj

@@ -1,24 +1,43 @@
 (ns mw-engine.core-test
   (:require [clojure.test :refer [deftest is testing]]
-            [mw-engine.core :refer [apply-rule]]))
+            [mw-engine.core :refer [apply-rule transform-world]]
+            [mw-engine.world :refer [make-world]]))
 
 (deftest apply-rule-test
   (testing "Application of a single rule"
-           (let [afn (eval 
+    (let [afn (vary-meta
-                       (fn [cell _world]
+               (eval
-                         (cond 
+               (fn [cell _world]
-                           (= (:state cell) :new) 
+                 (cond
-                           (merge cell {:state :grassland}))))
+                   (= (:state cell) :new)
-                 pair (list afn "Test source")]
+                   (merge cell {:state :grassland}))))
-             (is (nil? (apply-rule nil {:state :water} afn))
+               merge {:rule-type :production})
-                 "Rule shouldn't fire when state is wrong")
+          pair (list afn "Test source")]
-             (is (nil? (apply-rule nil {:state :water} pair))
+      (is (nil? (apply-rule nil {:state :water} afn))
-                 "Rule shouldn't fire when state is wrong")
+          "Rule shouldn't fire when state is wrong")
-             (is (= (:state (apply-rule nil {:state :new} afn)) :grassland)
+      (is (nil? (apply-rule nil {:state :water} pair))
-                 "Rule should fire when state is correct")
+          "Rule shouldn't fire when state is wrong")
-             (is (= (:state (apply-rule nil {:state :new} pair)) :grassland)
+      (is (= (:state (apply-rule nil {:state :new} afn)) :grassland)
-                 "Rule should fire when state is correct")
+          "Rule should fire when state is correct")
-             (is (nil? (:rule (apply-rule nil {:state :new} afn)))
+      (is (= (:state (apply-rule nil {:state :new} pair)) :grassland)
-                 "No rule text if not provided")
+          "Rule should fire when state is correct")
-             (is (= (:rule (apply-rule nil {:state :new} pair)) "Test source")
+      (is (nil? (:rule (apply-rule nil {:state :new} afn)))
-                 "Rule text cached on cell if provided"))))
+          "No rule text if not provided")
+      (is (= (:rule (apply-rule nil {:state :new} pair)) "Test source")
+          "Rule text cached on cell if provided"))))
+
+(deftest transform-world-tests
+  (testing "Application of a single rule"
+    (let [afn (vary-meta
+               (eval
+                (fn [cell _world]
+                  (cond
+                    (= (:state cell) :new)
+                    (merge cell {:state :grassland}))))
+               merge {:rule-type :production})
+          world (make-world 3 3)
+          expected [[{:y 0, :state :grassland, :x 0, :generation 1} {:y 0, :state :grassland, :x 1, :generation 1} {:y 0, :state :grassland, :x 2, :generation 1}] 
+                    [{:y 1, :state :grassland, :x 0, :generation 1} {:y 1, :state :grassland, :x 1, :generation 1} {:y 1, :state :grassland, :x 2, :generation 1}]
+                    [{:y 2, :state :grassland, :x 0, :generation 1} {:y 2, :state :grassland, :x 1, :generation 1} {:y 2, :state :grassland, :x 2, :generation 1}]]
+          actual (transform-world world (list afn))]
+      (is (= actual expected)))))