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.
This commit is contained in:
Simon Brooke 2015-04-18 19:21:04 +01:00
parent f9c437d8d3
commit f9591c4e8d
4 changed files with 49 additions and 10 deletions

View file

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

View file

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

View file

@ -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.

View file

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