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

Work on flows, close to complete but no cigar.

Browse source
This commit is contained in:
Simon Brooke 2023-07-09 22:27:20 +01:00
parent f4d4e9b694
commit 5ef93ef4df
5 changed files with 263 additions and 75 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -1,4 +1,4 @@
.calva/
target/
pom.xml

113
src/cljc/mw_engine/flow.clj Normal file
View file

@ -0,0 +1,113 @@
(ns mw-engine.flow
"Allow flows of values between cells in the world."
(:require [mw-engine.utils :refer [get-cell get-num merge-cell]]
[taoensso.timbre :refer [warn]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; mw-engine: the state/transition engine of MicroWorld.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License
;;;; as published by the Free Software Foundation; either version 2
;;;; of the License, or (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
;;;; USA.
;;;;
;;;; Copyright (C) 2014 Simon Brooke
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;; Functions to create and to print two dimensional cellular automata.
;;;; Nothing in this namespace should determine what states are possible within
;;;; the automaton, except for the initial state, :new.
;;;;
;;;; A cell is a map containing at least values for the keys :x, :y, and :state.
;;;;
;;;; A world is a two dimensional matrix (sequence of sequences) of cells, such
;;;; that every cell's :x and :y properties reflect its place in the matrix.
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; OK, the design here is: a flow object is a map with the following properties:
;; 1. :source, whose value is a location;
;; 2. :destination, whose value is a location;
;; 3. :property, whose value is a keyword;
;; 4. :quantity, whose value is a positive real number.
;;
;; A location object is a map with the following properties:
;; 1. :x, whose value is a natural number not greater than the extent of the world;
;; 2. :y, whose value is a natural number not greater than the extent of the world.
;;
;; to execute a flow is transfer the quantity specified of the property specified
;; from the cell at the source specified to the cell at the destination specified;
;; if the source doesn't have sufficient of the property, then all it has should
;; be transferred, but no more.
(defn coordinate?
"Return `true` if this object `o` is a valid coordinate with respect to
this `world`, else `false`. Assumes square worlds."
[o world]
(try
(and (or (zero? o) (pos-int? o))
(< o (count world)))
(catch Exception e
(warn (format "Not a valid coordinate: %s; %s" o (.getMessage e)))
false)))
(defn location?
"Return `true` if this object `o` is a location as defined above with respect to
this `world`, else `false`. Assumes square worlds."
[o world]
(try
(and (map? o)
(coordinate? (:x o) world)
(coordinate? (:y o) world))
(catch Exception e
(warn (format "Not a valid location: %s; %s" o (.getMessage e)))
false)))
(defn flow?
"Return `true` if this object `o` is a flow as defined above with respect to
this `world`, else `false`. Assumes square worlds."
[o world]
(try
(and (map? o)
(location? (:source o) world)
(location? (:destination o) world)
(keyword? (:property o))
(pos? (:quantity o)))
(catch Exception e
(warn (format "Not a valid flow: %s; %s" o (.getMessage e)))
false)))
(defn execute
"Return a world like this `world`, except with the quantity of the property
described in this `flow` object transferred from the source of that flow
to its destination."
[flow world]
(try
(let [source (get-cell world (-> flow :source :x) (-> flow :source :y))
dest (get-cell world (-> flow :destination :x) (-> flow :destination :y))
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))]
(merge-cell (merge-cell world s') d'))
(catch Exception e
(warn "Failed to execute flow %s: %s" flow (.getMessage e))
;; return the world unmodified.
world)))
(defn execute-flows
"Return a world like this `world`, but with each of these flows executed."
[flows world]
(reduce execute world (filter #(flow? % world) flows)))

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

@ -116,7 +116,6 @@
row)))
world))))
(defn get-cell
"Return the cell a x, y in this world, if any.
@ -127,9 +126,9 @@
(when (in-bounds? world x y)
(nth (nth world y) x)))
(defn get-int
"Get the value of a property expected to be an integer from a map; if not present (or not an integer) return 0.
"Get the value of a property expected to be an integer from a map; if not
present (or not an integer) return 0.
* `map` a map;
* `key` a symbol or keyword, presumed to be a key into the `map`."
@ -140,6 +139,18 @@
:else 0))
(throw (Exception. "No map passed?"))))
(defn get-num
"Get the value of a property expected to be a number from a map; if not
present (or not a number) return 0.
* `map` a map;
* `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?"))))
(defn population
"Return the population of this species in this cell. Currently a synonym for
@ -151,7 +162,6 @@
[cell species]
(get-int cell species))
(def memo-get-neighbours
"Memoised get neighbours is more efficient when running deeply recursive
algorithms on the same world. But it's less efficient when running the
@ -166,7 +176,6 @@
(range (- x depth) (+ x depth 1))
(range (- y depth) (+ y depth 1)))))))))
(defn get-neighbours
"Get the neighbours to distance depth of a cell in this world.
@ -200,7 +209,6 @@
([world cell]
(get-neighbours world cell 1)))
(defn get-neighbours-with-property-value
"Get the neighbours to distance depth of the cell at x, y in this world which
have this value for this property.
@ -249,18 +257,15 @@
(defn get-least-cell
"Return the cell from among these `cells` which has the lowest numeric value
for this `property`; if the property is absent or not a number, use this
`default`"
([cells property default]
(cond
(empty? cells) nil
:else (let [downstream (get-least-cell (rest cells) property default)]
(cond (<
(or (property (first cells)) default)
(or (property downstream) default)) (first cells)
:else downstream))))
([cells property]
(get-least-cell cells property (Integer/MAX_VALUE))))
for this `property`."
[cells property]
(first (sort-by property (filter #(number? (property %)) cells))))
(defn get-most-cell
"Return the cell from among these `cells` which has the highest numeric value
for this `property`."
[cells property]
(last (sort-by property cells)))
(defn- set-cell-property
@ -290,7 +295,6 @@
row)))
world))))
(defn merge-cell
"Return a world like this `world`, but merge the values from this `cell` with
those from the cell in the world with the same co-ordinates"

55
test/mw_engine/flow_test.clj Normal file
View file

@ -0,0 +1,55 @@
(ns mw-engine.flow-test
(:require [clojure.test :refer [deftest is testing]]
[mw-engine.flow :refer [coordinate? execute execute-flows flow?
location?]]
[mw-engine.utils :refer [get-cell merge-cell]]
[mw-engine.world :refer [make-world]]))
(deftest coordinate-tests
(testing "coordinates"
(let [world (make-world 3 3)]
(is (not (coordinate? -1 world)) "Not a coordinate: negative")
(is (not (coordinate? 4 world)) "Not a coordinate: out of bounds")
(is (not (coordinate? 3 world)) "Not a coordinate: boundary")
(is (not (coordinate? :three world)) "Not a coordinate: keyword")
(is (not (coordinate? 3.14 world)) "Not a coordinate: floating point")
(is (coordinate? 0 world) "should be a coordinate: zero")
(is (coordinate? 1 world) "should be a coordinate: middle"))))
(deftest location-tests
(testing "locations"
(let [world (make-world 3 3)
in1 {:x 0 :y 0}
in2 {:x 1 :y 2}
out1 {:p 0 :q 0}
out2 {:x -1 :y 2}]
(is (location? in1 world) "should be a location: top left")
(is (location? in2 world) "should be a location: middle bottom")
(is (not (location? out1 world)) "should not be a location: wrong keys")
(is (not (location? out2 world)) "should not be a location: negative coordinate"))))
(deftest flow-tests
(testing "flows"
(let [world (make-world 3 3)
world' (merge-cell world {:x 0, :y 0, :state :new :q 5.3})
valid {:source {:x 0 :y 0}
:destination {:x 1 :y 1}
:property :q
:quantity 2.4}]
(is (flow? valid world))
(let [transferred (execute valid world')
source-q (:q (get-cell transferred 0 0))
dest-q (:q (get-cell transferred 1 1))]
(is (= source-q 2.9))
(is (= dest-q 2.4)))
(let [valid2 {:source {:x 1 :y 1}
:destination {:x 0 :y 1}
:property :q
:quantity 1}
transferred (execute-flows (list valid valid2) world')
source-q (:q (get-cell transferred 0 0))
inter-q (:q (get-cell transferred 1 1))
dest-q (:q (get-cell transferred 0 1))]
(is (= source-q 2.9))
(is (= inter-q 1.4))
(is (= dest-q 1))))))

18
test/mw_engine/utils_test.clj
View file

@ -178,4 +178,20 @@
(is (:test (get-cell w3c 2 2))
"The cell with :test set is at 2, 2"))))
(deftest most-least-tests
(let [cells [{:x 0, :y 0, :state :new, :prop 0.4406204774301924}
{:x 1, :y 0, :state :new, :prop 0.26475629405490275}
{:x 2, :y 0, :state :new, :prop 0.34018209505715813}
{:x 0, :y 1, :state :new, :prop 0.35104719397171424}
{:x 1, :y 1, :state :new, :prop 0.6009298123397215} ;; <- max
{:x 2, :y 1, :state :new, :prop 0.5580383897506066}
{:x 0, :y 2, :state :new, :prop 0.1780241365266907} ;; <- min
{:x 1, :y 2, :state :new, :prop 0.3255028139128574}
{:x 2, :y 2, :state :new, :prop 0.3449965660347397}]]
(let [expected {:x 1, :y 1, :state :new, :prop 0.6009298123397215}
actual (get-most-cell cells :prop)]
(is (= actual expected) "get-most-cell failed")
)
(let [expected {:x 0, :y 2, :state :new, :prop 0.1780241365266907}
actual (get-least-cell cells :prop)]
(is (= actual expected) "get-least-cell failed"))))