From f9591c4e8db03ee17bf1bb62e69b007705d1f3cb Mon Sep 17 00:00:00 2001
From: Simon Brooke <simon@journeyman.cc>
Date: Sat, 18 Apr 2015 19:21:04 +0100
Subject: [PATCH] Added new non-recursive river drainage algorithm. Sadly, it's
 slower - twice as slow - but should get around the JVM stack problem. Still
 haven't solved laking.

---
 src/mw_engine/core.clj           |  2 +-
 src/mw_engine/drainage.clj       | 39 +++++++++++++++++++++++++-------
 src/mw_engine/utils.clj          | 16 +++++++++++++
 test/mw_engine/drainage_test.clj |  2 +-
 4 files changed, 49 insertions(+), 10 deletions(-)

diff --git a/src/mw_engine/core.clj b/src/mw_engine/core.clj
index 4d946a6..9b95b55 100644
--- a/src/mw_engine/core.clj
+++ b/src/mw_engine/core.clj
@@ -60,7 +60,7 @@
   (try
     (merge
       (apply-rules world cell rules)
-      {:generation (+ (or (:generation cell) 0) 1)})
+      {:generation (+ (get-int-or-zero cell :generation) 1)})
     (catch Exception e
       (merge cell {:error
                    (format "%s at generation %d when in state %s"
diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj
index f0eef60..925b1a0 100644
--- a/src/mw_engine/drainage.clj
+++ b/src/mw_engine/drainage.clj
@@ -3,7 +3,8 @@
 
 (ns mw-engine.drainage
   (:use mw-engine.utils
-        mw-engine.world)
+        mw-engine.world
+        mw-engine.core)
   (:require [mw-engine.heightmap :as heightmap]))
 
 (def ^:dynamic *sealevel* 10)
@@ -21,7 +22,7 @@
   "Return a list of the cells in this `world` which are higher than this
   `cell` and for which this cell is the lowest neighbour, or which are at the 
    same altitude and have greater flow"
-  [world cell]
+  [cell world]
   (filter #(map? %)
           (map
             (fn [n]
@@ -41,10 +42,10 @@
   ;; quicker to count the elements of the list and compare equality of numbers
   ;; than recursive equality check on members, I think. But worth benchmarking.
   (let [neighbours (get-neighbours world cell)
-        altitude (or (:altitude cell) 0)]
+        altitude (get-int-or-zero cell :altitude)]
     (= (count neighbours)
        (count (get-neighbours-with-property-value 
-                world (:x cell) (:y cell) 1 :altitude >)))))
+                world (:x cell) (:y cell) 1 :altitude altitude >)))))
 
 (defn flood-hollow
   "Raise the altitude of a copy of this `cell` of this `world` to the altitude  
@@ -62,6 +63,23 @@
   (map-world world 
              #(if (is-hollow %1 %2) (flood-hollow %1 %2) %2)))
 
+(def max-altitude 255)
+
+(defn flow-nr
+  "Experimental non recursive flow algorithm, needs to be run on a world as 
+   many times as there are distinct altitude values. This algorithm works only
+   if applied sequentially from the highest altitude to the lowest, see
+   `flow-world-nr`."
+  [cell world]
+  (if (= (- max-altitude (get-int-or-zero cell :generation))
+         (get-int-or-zero cell :altitude))
+    (merge cell 
+           {:flow (reduce + 
+                          (map 
+                            #(+ (get-int-or-zero % :rainfall)
+                                (get-int-or-zero % :flow))
+                            (flow-contributors cell world)))})))
+
 (def flow
   "Compute the total flow upstream of this `cell` in this `world`, and return a cell identical
   to this one but having a value of its flow property set from that computation. The function is
@@ -70,7 +88,7 @@
 
   Flow comes from a higher cell to a lower only if the lower is the lowest neighbour of the higher."
   (memoize
-   (fn [world cell]
+   (fn [cell world]
      (cond
       (not (nil? (:flow cell))) cell
       (<= (or (:altitude cell) 0) *sealevel*) cell
@@ -78,8 +96,13 @@
       (merge cell
              {:flow (+ (:rainfall cell)
                        (apply +
-                              (map (fn [neighbour] (:flow (flow world neighbour)))
-                                   (flow-contributors world cell))))})))))
+                              (map (fn [neighbour] (:flow (flow neighbour world)))
+                                   (flow-contributors cell world))))})))))
+
+(defn flow-world-nr
+  "Experimental non-recursive flow-world algorithm"
+  [world]
+  (run-world world nil (list flow-nr) max-altitude))
 
 (defn flow-world
   "Return a world like this `world`, but with cells tagged with the amount of
@@ -91,4 +114,4 @@
   [hmap]
   "Create a world from the heightmap `hmap`, rain on it, and then compute river 
    flows."
-  (flow-world (rain-world (heightmap/apply-heightmap hmap))))
+  (flow-world (rain-world (flood-hollows (heightmap/apply-heightmap hmap)))))
diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj
index 0873759..c8ced6a 100644
--- a/src/mw_engine/utils.clj
+++ b/src/mw_engine/utils.clj
@@ -19,6 +19,22 @@
   "True if elt is a member of col."
   [elt col] (some #(= elt %) col))
 
+(defn get-int-or-zero
+  "Return the value of this `property` from this `map` if it is a integer; 
+   otherwise return zero."
+  [map property]
+  (let [value (map property)]
+    (if (integer? value) value 0)))
+
+(defn init-generation 
+  "Return a cell like this `cell`, but having a value for :generation, zero if
+   the cell passed had no integer value for generation, otherwise the value
+   taken from the cell passed. The `world` argument is present only for 
+   consistency with the rule engine and is ignored." 
+  [world cell]
+  (merge cell {:generation (get-int-or-zero cell :generation)}))
+
+
 (defn in-bounds
   "True if x, y are in bounds for this world (i.e., there is a cell at x, y)
    else false.
diff --git a/test/mw_engine/drainage_test.clj b/test/mw_engine/drainage_test.clj
index ba2c95a..574e7bf 100644
--- a/test/mw_engine/drainage_test.clj
+++ b/test/mw_engine/drainage_test.clj
@@ -11,7 +11,7 @@
                      (world/make-world 3 3)
                      #(merge %2 {:altitude 100}))
                    1 1 :altitude 90)]
-             (is (is-hollow world (utils/get-cell world 1 1))
+             (is (is-hollow (utils/get-cell world 1 1) world)
                  "Cell at 1, 1 should be a hollow"))))
 
 (deftest flood-hollow-test