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

@@ -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
+                          #(apply function
-                                   (cons world (cons % additional-args)))
+                                  (cons world (cons % additional-args)))
-                           row)))
+                          row)))
               world))))
 
 
@@ -92,9 +92,9 @@
    (into []
          (pmap (fn [row]
                  (into [] (pmap
-                            #(apply function
+                           #(apply function
-                                    (cons world (cons % additional-args)))
+                                   (cons world (cons % additional-args)))
-                            row)))
+                           row)))
                world))))
 
 
@@ -111,12 +111,11 @@
    (into []
          (pmap (fn [row]
                  (into [] (map
-                            #(apply function
+                           #(apply function
-                                    (cons world (cons % additional-args)))
+                                   (cons world (cons % additional-args)))
-                            row)))
+                           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 (- x depth) (+ x depth 1))
-                            (range (- y depth) (+ y 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]
+  ([world x y depth]
-      (remove nil?
+   (remove nil?
-             (map #(get-cell world (first %) (first (rest %)))
+           (map #(get-cell world (first %) (first (rest %)))
-                  (remove #(= % (list x y))
+                (remove #(= % (list x y))
-                          (combo/cartesian-product
+                        (combo/cartesian-product
-                            (range (- x depth) (+ x depth 1))
+                         (range (- x depth) (+ x depth 1))
-                            (range (- y depth) (+ y depth 1)))))))
+                         (range (- y depth) (+ y depth 1)))))))
-    ([world cell depth]
+  ([world cell depth]
-      (memo-get-neighbours world (:x cell) (:y cell) depth))
+   (memo-get-neighbours world (:x cell) (:y cell) depth))
-    ([world cell]
+  ([world cell]
-      (get-neighbours world cell 1)))
+   (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
+   (filter
-      #(eval
+    #(eval
-         (list op
+      (list op
-               (or (get % property) (get-int % property))
+            (or (get % property) (get-int % property))
-               value))
+            value))
-      (get-neighbours world x y depth)))
+    (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
+   (get-neighbours-with-property-value world (:x cell) (:y cell) depth
-                                        property value))
+                                       property value))
   ([world cell property value]
-    (get-neighbours-with-property-value world cell 1
+   (get-neighbours-with-property-value world cell 1
-                                        property value)))
+                                       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
+  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
@@ -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
+   (apply
-      vector ;; we want a vector of vectors, not a list of lists, for efficiency
+    vector ;; we want a vector of vectors, not a list of lists, for efficiency
-      (map
+    (map
-        (fn [row]
+     (fn [row]
-          (apply
+       (apply
-            vector
+        vector
-            (map #(set-cell-property % x y property value)
+        (map #(set-cell-property % x y property value)
-                 row)))
+             row)))
-        world))))
+     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
+                 (and
-                    (= (:x cell)(:x %2))
+                  (= (:x cell) (:x %2))
-                    (= (:y cell)(:y %2)))
+                  (= (:y cell) (:y %2)))
                   (merge %2 cell)
                   %2))
     world))

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