diff --git a/.gitignore b/.gitignore index 2cf4294..ea35471 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,4 @@ - +.calva/ target/ pom.xml diff --git a/src/cljc/mw_engine/flow.clj b/src/cljc/mw_engine/flow.clj new file mode 100644 index 0000000..2047802 --- /dev/null +++ b/src/cljc/mw_engine/flow.clj @@ -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))) \ No newline at end of file diff --git a/src/cljc/mw_engine/utils.clj b/src/cljc/mw_engine/utils.clj index f84abe4..338dc95 100644 --- a/src/cljc/mw_engine/utils.clj +++ b/src/cljc/mw_engine/utils.clj @@ -1,9 +1,9 @@ (ns ^{:doc " Utility functions needed by MicroWorld and, specifically, in the interpretation of MicroWorld rule." :author "Simon Brooke"} - mw-engine.utils + mw-engine.utils (:require - [clojure.math.combinatorics :as combo])) + [clojure.math.combinatorics :as combo])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; @@ -57,7 +57,7 @@ * `y` a number which may or may not be a valid y coordinate within that world." {:deprecated "1.1.7"} [world x y] - (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world))))) + (and (>= x 0) (>= y 0) (< y (count world)) (< x (count (first world))))) (defn in-bounds? "True if x, y are in bounds for this world (i.e., there is a cell at x, y) @@ -68,7 +68,7 @@ * `y` a number which may or may not be a valid y coordinate within that world." {:added "1.1.7"} [world x y] - (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world))))) + (and (>= x 0) (>= y 0) (< y (count world)) (< x (count (first world))))) (defn map-world-n-n "Wholly non-parallel map world implementation; see documentation for `map-world`." @@ -78,9 +78,9 @@ (into [] (map (fn [row] (into [] (map - #(apply function - (cons world (cons % additional-args))) - row))) + #(apply function + (cons world (cons % additional-args))) + row))) world)))) @@ -92,9 +92,9 @@ (into [] (pmap (fn [row] (into [] (pmap - #(apply function - (cons world (cons % additional-args))) - row))) + #(apply function + (cons world (cons % additional-args))) + row))) world)))) @@ -111,12 +111,11 @@ (into [] (pmap (fn [row] (into [] (map - #(apply function - (cons world (cons % additional-args))) - row))) + #(apply function + (cons world (cons % additional-args))) + 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 @@ -163,12 +173,11 @@ (map #(get-cell world (first %) (first (rest %))) (remove #(= % (list x y)) (combo/cartesian-product - (range (- x depth) (+ x depth 1)) - (range (- y depth) (+ y depth 1))))))))) - + (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. + "Get the neighbours to distance depth of a cell in this world. Several overloads: * `world` a world, as described in world.clj; @@ -188,18 +197,17 @@ should be searched Gets the neighbours within the specified distance of the cell at coordinates [x,y] in this world." - ([world x y depth] - (remove nil? - (map #(get-cell world (first %) (first (rest %))) - (remove #(= % (list x y)) - (combo/cartesian-product - (range (- x depth) (+ x depth 1)) - (range (- y depth) (+ y depth 1))))))) - ([world cell depth] - (memo-get-neighbours world (:x cell) (:y cell) depth)) - ([world cell] - (get-neighbours world cell 1))) - + ([world x y depth] + (remove nil? + (map #(get-cell world (first %) (first (rest %))) + (remove #(= % (list x y)) + (combo/cartesian-product + (range (- x depth) (+ x depth 1)) + (range (- y depth) (+ y depth 1))))))) + ([world cell depth] + (memo-get-neighbours world (:x cell) (:y cell) depth)) + ([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 @@ -215,20 +223,20 @@ It gets messy." ([world x y depth property value op] - (filter - #(eval - (list op - (or (get % property) (get-int % property)) - value)) - (get-neighbours world x y depth))) + (filter + #(eval + (list op + (or (get % property) (get-int % property)) + value)) + (get-neighbours world x y depth))) ([world x y depth property value] - (get-neighbours-with-property-value world x y depth property value =)) + (get-neighbours-with-property-value world x y depth property value =)) ([world cell depth property value] - (get-neighbours-with-property-value world (:x cell) (:y cell) depth - property value)) + (get-neighbours-with-property-value world (:x cell) (:y cell) depth + property value)) ([world cell property value] - (get-neighbours-with-property-value world cell 1 - property value))) + (get-neighbours-with-property-value world cell 1 + property value))) (defn get-neighbours-with-state "Get the neighbours to distance depth of the cell at x, y in this world which @@ -240,27 +248,24 @@ should be searched; * `state` a keyword representing a state in the world." ([world x y depth state] - (filter #(= (:state %) state) (get-neighbours world x y depth))) + (filter #(= (:state %) state) (get-neighbours world x y depth))) ([world cell depth state] - (get-neighbours-with-state world (:x cell) (:y cell) depth state)) + (get-neighbours-with-state world (:x cell) (:y cell) depth state)) ([world cell state] - (get-neighbours-with-state world cell 1 state))) + (get-neighbours-with-state world cell 1 state))) (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 @@ -278,18 +283,17 @@ "Return a world like this `world` but with the value of exactly one `property` of one `cell` changed to this `value`" ([world cell property value] - (set-property world (:x cell) (:y cell) property value)) + (set-property world (:x cell) (:y cell) property value)) ([world x y property value] - (apply - vector ;; we want a vector of vectors, not a list of lists, for efficiency - (map - (fn [row] - (apply - vector - (map #(set-cell-property % x y property value) - row))) - world)))) - + (apply + vector ;; we want a vector of vectors, not a list of lists, for efficiency + (map + (fn [row] + (apply + vector + (map #(set-cell-property % x y property value) + row))) + world)))) (defn merge-cell "Return a world like this `world`, but merge the values from this `cell` with @@ -298,9 +302,9 @@ (if (in-bounds? world (:x cell) (:y cell)) (map-world world #(if - (and - (= (:x cell)(:x %2)) - (= (:y cell)(:y %2))) + (and + (= (:x cell) (:x %2)) + (= (:y cell) (:y %2))) (merge %2 cell) %2)) world)) diff --git a/test/mw_engine/flow_test.clj b/test/mw_engine/flow_test.clj new file mode 100644 index 0000000..60ebcea --- /dev/null +++ b/test/mw_engine/flow_test.clj @@ -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)))))) \ No newline at end of file diff --git a/test/mw_engine/utils_test.clj b/test/mw_engine/utils_test.clj index 0077ceb..91dacbd 100644 --- a/test/mw_engine/utils_test.clj +++ b/test/mw_engine/utils_test.clj @@ -178,4 +178,20 @@ (is (:test (get-cell w3c 2 2)) "The cell with :test set is at 2, 2")))) - \ No newline at end of file +(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")))) \ No newline at end of file