From 3e1e3052d13ac938a2978317e002f1d167310ff6 Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Wed, 26 Jul 2023 07:25:02 +0100
Subject: [PATCH] More on history; more error trapping on flows.

---
 src/cljc/mw_engine/core.clj  | 15 +++--------
 src/cljc/mw_engine/flow.clj  | 45 ++++++++++++++++++++++-----------
 src/cljc/mw_engine/utils.clj | 49 ++++++++++++++++++++++++++++++------
 test/mw_engine/core_test.clj | 13 +++++-----
 4 files changed, 81 insertions(+), 41 deletions(-)

diff --git a/src/cljc/mw_engine/core.clj b/src/cljc/mw_engine/core.clj
index 97f65cf..1471c94 100644
--- a/src/cljc/mw_engine/core.clj
+++ b/src/cljc/mw_engine/core.clj
@@ -23,7 +23,7 @@
       :author "Simon Brooke"}
  mw-engine.core
   (:require [mw-engine.flow :refer [flow-world]]
-            [mw-engine.utils :refer [get-int-or-zero map-world rule-type]]
+            [mw-engine.utils :refer [add-history-event get-int-or-zero map-world rule-type]]
             [taoensso.timbre :as l]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -66,17 +66,8 @@
                             e
                             (.getMessage e)
                             (-> rule meta :lisp)
-                            cell))))
-        rule-meta (meta rule)]
-    (when result
-      (merge result 
-             {:history (concat 
-                        (:history result) 
-                        (list {:rule (:source rule-meta) 
-                               :rule-type (:rule-type rule-meta)
-                               :generation (get-int-or-zero 
-                                            result 
-                                            :generation)}))}))))
+                            cell))))]
+    (add-history-event result rule)))
 
 (defn- apply-rules
   "Derive a cell from this `cell` of this `world` by applying these `rules`."
diff --git a/src/cljc/mw_engine/flow.clj b/src/cljc/mw_engine/flow.clj
index ef3e7af..e64a0d3 100644
--- a/src/cljc/mw_engine/flow.clj
+++ b/src/cljc/mw_engine/flow.clj
@@ -22,8 +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
-                                     rule-type]]
+  (:require [mw-engine.utils :refer [add-history-event get-cell get-num
+                                     in-bounds? map-world merge-cell rule-type]]
             [taoensso.timbre :refer [info warn]]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -101,8 +101,14 @@
           dest (get-cell world dx dy)
           p (:property flow)
           q (min (:quantity flow) (get-num source p))
-          s' (assoc source p (- (source p) q))
-          d' (assoc dest p (+ (get-num dest p) q))]
+          s' (add-history-event 
+              (assoc source p (- (source p) q)) 
+              (:rule flow) 
+              {:direction :sent :other {:x dx :y dy} :property p :quantity q})
+          d' (add-history-event
+              (assoc dest p (+ (get-num dest p) q))
+              (:rule flow)
+              {:direction :received :other {:x sx :y sy} :property p :quantity 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))
@@ -119,27 +125,36 @@
   [world flows]
   (reduce execute world (filter #(flow? % world) flows)))
 
+(defn- plan-cell-flows 
+  [world cell rules]
+  (map ;; across all the rules
+   (fn [rule] (let [r (try 
+                        (apply rule (list cell world))
+                           (catch Exception any
+                             (throw (ex-info "Planning of flows failed"
+                                             (merge (meta rule) {:cell cell})
+                                             any))))] 
+                (when r (map #(assoc % :rule rule) r))))
+   rules))
+
 (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))
+   those of these `rules` (which are expected to be pre-compiled) which are
+   flow rules. Return the list of plans, as flow objects."
+  [world 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)))))
+           (map-world
+            world
+            plan-cell-flows
+            (list (filter #(= :flow (rule-type %)) rules))))))
 
 (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))))
+  (execute-flows world (plan-flows world rules)))
 
 ;; building blocks for compiled flow rules
 
diff --git a/src/cljc/mw_engine/utils.clj b/src/cljc/mw_engine/utils.clj
index 7a06e6f..ff2b066 100644
--- a/src/cljc/mw_engine/utils.clj
+++ b/src/cljc/mw_engine/utils.clj
@@ -30,7 +30,7 @@
 
 (defn member?
   "Return 'true' if elt is a member of col, else 'false'."
-  [elt col] 
+  [elt col]
   (contains? (set col) elt))
 
 (defn get-int-or-zero
@@ -146,10 +146,10 @@
   * `key` a symbol or keyword, presumed to be a key into the `map`."
   [map key]
   `(if (map? ~map)
-    (let [~'v (~map ~key)]
-      (cond (and ~'v (number? ~'v)) ~'v
-            :else 0))
-    (throw (Exception. "No map passed?"))))
+     (let [~'v (~map ~key)]
+       (cond (and ~'v (number? ~'v)) ~'v
+             :else 0))
+     (throw (Exception. "No map passed?"))))
 
 (defn population
   "Return the population of this species in this cell. Currently a synonym for
@@ -305,11 +305,44 @@
   [rule]
   (:rule-type (meta rule)))
 
+(defn add-history-event
+  "If `cell` is non-nil, expect it to be a map representing a cell; add
+   to its history an an event recording the firing of this rule. If
+   `detail` is passed, treat it as a map of additional data to be
+   added to the event."
+  ([cell rule]
+   (when cell (add-history-event cell rule {})))
+  ([result rule detail]
+   (when result
+     (let [rule-meta (meta rule)
+           event {:rule (:source rule-meta)
+                  :rule-type (:rule-type rule-meta)
+                  :generation (get-int-or-zero
+                               result
+                               :generation)}
+           event' (if detail (merge event detail) event)]
+       (merge result
+              {:history (concat
+                         (:history result)
+                         (list event'))})))))
+
+(defn- event-narrative [event]
+  (case (:rule-type event)
+    :production (:rule event)
+    :flow (format "%s %f units of %s %s %d,%d:\n    %s"
+                  (name (:direction event))
+                  (:quantity event)
+                  (:property event)
+                  (if (= :sent (:direction event)) "to" "from")
+                  (:x (:other event))
+                  (:y (:other event))
+                  (:rule event))))
+
 (defn history-string
   "Return the history of this `cell` as a string for presentation to the user."
   [cell]
   (join "\n"
-        (map #(format "%6d: %s" (:generation %) (:rule %))
+        (map #(format "%6d: %s" (:generation %) (event-narrative %))
              (:history cell))))
 
 (defn- extend-summary [summary rs rl event]
@@ -317,9 +350,9 @@
        (if rs (format "%d-%d (%d occurances): %s\n" rs
                       (:generation event)
                       rl
-                      (:rule event))
+                      (event-narrative event))
            (format "%d: %s\n" (:generation event)
-                   (:rule event)))))
+                   (event-narrative event)))))
 
 (defn summarise-history
   "Return, as a string, a shorter summary of the history of this cell"
diff --git a/test/mw_engine/core_test.clj b/test/mw_engine/core_test.clj
index f6c056d..ae0742a 100644
--- a/test/mw_engine/core_test.clj
+++ b/test/mw_engine/core_test.clj
@@ -1,6 +1,7 @@
 (ns mw-engine.core-test
   (:require [clojure.test :refer [deftest is testing]]
             [mw-engine.core :refer [apply-rule transform-world]]
+            [mw-engine.utils :refer [map-world]]
             [mw-engine.world :refer [make-world]]))
 
 (deftest apply-rule-test
@@ -17,8 +18,8 @@
           "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 (= (:rule (apply-rule nil {:state :new} afn)) "Test source")
-          "Rule text cached on cell if provided"))))
+      (is (seq? (:history (apply-rule nil {:state :new} afn)))
+          "Event cached on history of cell"))))
 
 (deftest transform-world-tests
   (testing "Application of a single rule"
@@ -31,8 +32,8 @@
                merge {:rule-type :production
                       :rule "Test source"})
           world (make-world 3 3)
-          expected [[[{:y 0, :state :grassland, :x 0, :rule-type :production, :rule "Test source", :generation 1} {:y 0, :state :grassland, :x 1, :rule-type :production, :rule "Test source", :generation 1} {:y 0, :state :grassland, :x 2, :rule-type :production, :rule "Test source", :generation 1}] 
-                     [{:y 1, :state :grassland, :x 0, :rule-type :production, :rule "Test source", :generation 1} {:y 1, :state :grassland, :x 1, :rule-type :production, :rule "Test source", :generation 1} {:y 1, :state :grassland, :x 2, :rule-type :production, :rule "Test source", :generation 1}] 
-                     [{:y 2, :state :grassland, :x 0, :rule-type :production, :rule "Test source", :generation 1} {:y 2, :state :grassland, :x 1, :rule-type :production, :rule "Test source", :generation 1} {:y 2, :state :grassland, :x 2, :rule-type :production, :rule "Test source", :generation 1}]]]
-          actual (transform-world world (list afn))]
+          expected [[{:y 0, :state :grassland, :x 0} {:y 0, :state :grassland, :x 1} {:y 0, :state :grassland, :x 2}] 
+                     [{:y 1, :state :grassland, :x 0} {:y 1, :state :grassland, :x 1} {:y 1, :state :grassland, :x 2}] 
+                     [{:y 2, :state :grassland, :x 0} {:y 2, :state :grassland, :x 1} {:y 2, :state :grassland, :x 2}]]
+          actual (map-world (transform-world world (list afn)) (fn [_ c] (select-keys c [:x :y :state])))]
       (is (= actual expected)))))
\ No newline at end of file