More on history; more error trapping on flows.

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))))
+                            cell))))]
-        rule-meta (meta rule)]
+    (add-history-event result 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)}))}))))
 
 (defn- apply-rules
   "Derive a cell from this `cell` of this `world` by applying these `rules`."

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
+  (:require [mw-engine.utils :refer [add-history-event get-cell get-num
-                                     rule-type]]
+                                     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))
+          s' (add-history-event 
-          d' (assoc dest p (+ (get-num dest p) q))]
+              (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
+   those of these `rules` (which are expected to be pre-compiled) which are
-   plans, as flow objects."
+   flow rules. Return the list of plans, as flow objects."
-  [world flow-rules]
+  [world rules]
-  (assert (every? #(= :flow (rule-type %)) flow-rules))
   (remove nil?
           (flatten
-           (map ;; across all the cells
+           (map-world
-            (fn [cell]
+            world
-              (map ;; across all the rules
+            plan-cell-flows
-               (fn [rule] (apply rule (list cell world)))
+            (list (filter #(= :flow (rule-type %)) rules))))))
-               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))))
+  (execute-flows world (plan-flows world rules)))
 
 ;; building blocks for compiled flow rules
 

src/cljc/mw_engine/utils.clj

@@ -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"

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")
+      (is (seq? (:history (apply-rule nil {:state :new} afn)))
-          "Rule text cached on cell if provided"))))
+          "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}] 
+          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, :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 1, :state :grassland, :x 0} {:y 1, :state :grassland, :x 1} {:y 1, :state :grassland, :x 2}] 
-                     [{: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}]]]
+                     [{:y 2, :state :grassland, :x 0} {:y 2, :state :grassland, :x 1} {:y 2, :state :grassland, :x 2}]]
-          actual (transform-world world (list afn))]
+          actual (map-world (transform-world world (list afn)) (fn [_ c] (select-keys c [:x :y :state])))]
       (is (= actual expected)))))