Work on flows, close to complete but no cigar.

.gitignore

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

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

src/cljc/mw_engine/utils.clj

@@ -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
+  for this `property`."
-  `default`"
+  [cells property]
-  ([cells property default]
+  (first (sort-by property (filter #(number? (property %)) cells))))
-  (cond
+
-   (empty? cells) nil
+(defn get-most-cell
-   :else (let [downstream (get-least-cell (rest cells) property default)]
+  "Return the cell from among these `cells` which has the highest numeric value
-          (cond (<
+  for this `property`."
-                 (or (property (first cells)) default)
+  [cells property]
-                 (or (property downstream) default)) (first cells)
+  (last (sort-by property cells)))
-                :else downstream))))
-  ([cells property]
-   (get-least-cell cells property (Integer/MAX_VALUE))))
 
 
 (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"

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

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