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

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

Browse source 
Better error capturing!
This commit is contained in:
Simon Brooke 2023-07-18 22:15:19 +01:00
parent 866c00bea0
commit 68298cf9c1
6 changed files with 137 additions and 54 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

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

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

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

6
src/cljc/mw_engine/heightmap.clj
View file

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

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

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

18
src/cljc/mw_engine/world.clj
View file

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

57
test/mw_engine/core_test.clj
View file

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