simon/mw-engine
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

More on history; more error trapping on flows.

Browse source
This commit is contained in:
Simon Brooke 2023-07-26 07:25:02 +01:00
parent 4b1472d311
commit 3e1e3052d1
4 changed files with 81 additions and 41 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
src/cljc/mw_engine/core.clj
View file

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

45
src/cljc/mw_engine/flow.clj
View file

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

49
src/cljc/mw_engine/utils.clj
View file

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

13
test/mw_engine/core_test.clj
View file

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