From 68298cf9c1507a4f5775d53c2de8d27ddfb1948a Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Tue, 18 Jul 2023 22:15:19 +0100
Subject: [PATCH] More work on flow rules. All rules must now have metadata

Better error capturing!
---
 src/cljc/mw_engine/core.clj      | 78 ++++++++++++++++++--------------
 src/cljc/mw_engine/flow.clj      | 27 ++++++++++-
 src/cljc/mw_engine/heightmap.clj |  6 +++
 src/cljc/mw_engine/utils.clj     |  5 ++
 src/cljc/mw_engine/world.clj     | 18 ++++++++
 test/mw_engine/core_test.clj     | 57 +++++++++++++++--------
 6 files changed, 137 insertions(+), 54 deletions(-)

diff --git a/src/cljc/mw_engine/core.clj b/src/cljc/mw_engine/core.clj
index 49fbf70..c35bdc1 100644
--- a/src/cljc/mw_engine/core.clj
+++ b/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]
-   (cond
-     (ifn? rule) (apply-rule world cell rule nil)
-     (seq? rule) (let [[afn src] rule] (apply-rule world cell afn src))))
-  ([world cell rule source]
-   (let [result (apply rule (list cell world))]
-     (cond
-       (and result source) (merge result {:rule source})
-       :else result))))
+  [world cell rule]
+  (cond
+    (ifn? rule) (apply rule (list cell world))
+    (seq? rule) (let [[afn src lisp] rule
+                      result (apply-rule world cell afn)]
+                  (when result
+                    (merge result {:rule src
+                                   :lisp lisp})))))
 
 (defn- apply-rules
   "Derive a cell from this `cell` of this `world` by applying these `rules`."
   [world cell rules]
-  (cond (empty? rules) cell
-        :else (let [result (apply-rule world cell (first rules))]
-                (cond result result
-                      :else (apply-rules world cell (rest rules))))))
+  (or
+   (first (remove nil? (map #(apply-rule world cell %) rules)))
+   cell))
 
 (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."
-  ([world rules]
-   (map-world world transform-cell (list rules))))
+  "Return a world derived from this `world` by applying the production rules 
+  found among these `rules` to each cell."
+  [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;
-  * `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;
-  * `generations` an (integer) number of generations.
-
-  Return the final generation of the world."
-  [world init-rules rules generations]
-  (reduce (fn [world iteration]
-            (l/info "Running iteration " iteration)
-            (transform-world world rules))
-          (transform-world world init-rules)
-          (range generations)))
-
-
+   * `world` a world as discussed above;
+   * `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;
+   * `generations` an (integer) number of generations.
+   
+   **NOTE THAT** all rules **must** be tagged with `rule-type` metadata, or thet **will not**
+   be executed.
 
+   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))))
diff --git a/src/cljc/mw_engine/flow.clj b/src/cljc/mw_engine/flow.clj
index 6324bc2..ef3e7af 100644
--- a/src/cljc/mw_engine/flow.clj
+++ b/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
diff --git a/src/cljc/mw_engine/heightmap.clj b/src/cljc/mw_engine/heightmap.clj
index 24c250d..ea87d31 100644
--- a/src/cljc/mw_engine/heightmap.clj
+++ b/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.
diff --git a/src/cljc/mw_engine/utils.clj b/src/cljc/mw_engine/utils.clj
index 523fddf..c7e070b 100644
--- a/src/cljc/mw_engine/utils.clj
+++ b/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)))
diff --git a/src/cljc/mw_engine/world.clj b/src/cljc/mw_engine/world.clj
index b5fcd17..ed769a0 100644
--- a/src/cljc/mw_engine/world.clj
+++ b/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
 
diff --git a/test/mw_engine/core_test.clj b/test/mw_engine/core_test.clj
index f144f4d..57a3d65 100644
--- a/test/mw_engine/core_test.clj
+++ b/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 
-                       (fn [cell _world]
-                         (cond 
-                           (= (:state cell) :new) 
-                           (merge cell {:state :grassland}))))
-                 pair (list afn "Test source")]
-             (is (nil? (apply-rule nil {:state :water} afn))
-                 "Rule shouldn't fire when state is wrong")
-             (is (nil? (apply-rule nil {:state :water} pair))
-                 "Rule shouldn't fire when state is wrong")
-             (is (= (:state (apply-rule nil {:state :new} afn)) :grassland)
-                 "Rule should fire when state is correct")
-             (is (= (:state (apply-rule nil {:state :new} pair)) :grassland)
-                 "Rule should fire when state is correct")
-             (is (nil? (:rule (apply-rule nil {:state :new} afn)))
-                 "No rule text if not provided")
-             (is (= (:rule (apply-rule nil {:state :new} pair)) "Test source")
-                 "Rule text cached on cell if provided"))))
\ No newline at end of file
+    (let [afn (vary-meta
+               (eval
+               (fn [cell _world]
+                 (cond
+                   (= (:state cell) :new)
+                   (merge cell {:state :grassland}))))
+               merge {:rule-type :production})
+          pair (list afn "Test source")]
+      (is (nil? (apply-rule nil {:state :water} afn))
+          "Rule shouldn't fire when state is wrong")
+      (is (nil? (apply-rule nil {:state :water} pair))
+          "Rule shouldn't fire when state is wrong")
+      (is (= (:state (apply-rule nil {:state :new} afn)) :grassland)
+          "Rule should fire when state is correct")
+      (is (= (:state (apply-rule nil {:state :new} pair)) :grassland)
+          "Rule should fire when state is correct")
+      (is (nil? (:rule (apply-rule nil {:state :new} afn)))
+          "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)))))
\ No newline at end of file