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:
parent
f9c437d8d3
commit
f9591c4e8d
|
@ -60,7 +60,7 @@
|
||||||
(try
|
(try
|
||||||
(merge
|
(merge
|
||||||
(apply-rules world cell rules)
|
(apply-rules world cell rules)
|
||||||
{:generation (+ (or (:generation cell) 0) 1)})
|
{:generation (+ (get-int-or-zero cell :generation) 1)})
|
||||||
(catch Exception e
|
(catch Exception e
|
||||||
(merge cell {:error
|
(merge cell {:error
|
||||||
(format "%s at generation %d when in state %s"
|
(format "%s at generation %d when in state %s"
|
||||||
|
|
|
@ -3,7 +3,8 @@
|
||||||
|
|
||||||
(ns mw-engine.drainage
|
(ns mw-engine.drainage
|
||||||
(:use mw-engine.utils
|
(:use mw-engine.utils
|
||||||
mw-engine.world)
|
mw-engine.world
|
||||||
|
mw-engine.core)
|
||||||
(:require [mw-engine.heightmap :as heightmap]))
|
(:require [mw-engine.heightmap :as heightmap]))
|
||||||
|
|
||||||
(def ^:dynamic *sealevel* 10)
|
(def ^:dynamic *sealevel* 10)
|
||||||
|
@ -21,7 +22,7 @@
|
||||||
"Return a list of the cells in this `world` which are higher than this
|
"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
|
`cell` and for which this cell is the lowest neighbour, or which are at the
|
||||||
same altitude and have greater flow"
|
same altitude and have greater flow"
|
||||||
[world cell]
|
[cell world]
|
||||||
(filter #(map? %)
|
(filter #(map? %)
|
||||||
(map
|
(map
|
||||||
(fn [n]
|
(fn [n]
|
||||||
|
@ -41,10 +42,10 @@
|
||||||
;; quicker to count the elements of the list and compare equality of numbers
|
;; quicker to count the elements of the list and compare equality of numbers
|
||||||
;; than recursive equality check on members, I think. But worth benchmarking.
|
;; than recursive equality check on members, I think. But worth benchmarking.
|
||||||
(let [neighbours (get-neighbours world cell)
|
(let [neighbours (get-neighbours world cell)
|
||||||
altitude (or (:altitude cell) 0)]
|
altitude (get-int-or-zero cell :altitude)]
|
||||||
(= (count neighbours)
|
(= (count neighbours)
|
||||||
(count (get-neighbours-with-property-value
|
(count (get-neighbours-with-property-value
|
||||||
world (:x cell) (:y cell) 1 :altitude >)))))
|
world (:x cell) (:y cell) 1 :altitude altitude >)))))
|
||||||
|
|
||||||
(defn flood-hollow
|
(defn flood-hollow
|
||||||
"Raise the altitude of a copy of this `cell` of this `world` to the altitude
|
"Raise the altitude of a copy of this `cell` of this `world` to the altitude
|
||||||
|
@ -62,6 +63,23 @@
|
||||||
(map-world world
|
(map-world world
|
||||||
#(if (is-hollow %1 %2) (flood-hollow %1 %2) %2)))
|
#(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
|
(def flow
|
||||||
"Compute the total flow upstream of this `cell` in this `world`, and return a cell identical
|
"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
|
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."
|
Flow comes from a higher cell to a lower only if the lower is the lowest neighbour of the higher."
|
||||||
(memoize
|
(memoize
|
||||||
(fn [world cell]
|
(fn [cell world]
|
||||||
(cond
|
(cond
|
||||||
(not (nil? (:flow cell))) cell
|
(not (nil? (:flow cell))) cell
|
||||||
(<= (or (:altitude cell) 0) *sealevel*) cell
|
(<= (or (:altitude cell) 0) *sealevel*) cell
|
||||||
|
@ -78,8 +96,13 @@
|
||||||
(merge cell
|
(merge cell
|
||||||
{:flow (+ (:rainfall cell)
|
{:flow (+ (:rainfall cell)
|
||||||
(apply +
|
(apply +
|
||||||
(map (fn [neighbour] (:flow (flow world neighbour)))
|
(map (fn [neighbour] (:flow (flow neighbour world)))
|
||||||
(flow-contributors world cell))))})))))
|
(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
|
(defn flow-world
|
||||||
"Return a world like this `world`, but with cells tagged with the amount of
|
"Return a world like this `world`, but with cells tagged with the amount of
|
||||||
|
@ -91,4 +114,4 @@
|
||||||
[hmap]
|
[hmap]
|
||||||
"Create a world from the heightmap `hmap`, rain on it, and then compute river
|
"Create a world from the heightmap `hmap`, rain on it, and then compute river
|
||||||
flows."
|
flows."
|
||||||
(flow-world (rain-world (heightmap/apply-heightmap hmap))))
|
(flow-world (rain-world (flood-hollows (heightmap/apply-heightmap hmap)))))
|
||||||
|
|
|
@ -19,6 +19,22 @@
|
||||||
"True if elt is a member of col."
|
"True if elt is a member of col."
|
||||||
[elt col] (some #(= elt %) 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
|
(defn in-bounds
|
||||||
"True if x, y are in bounds for this world (i.e., there is a cell at x, y)
|
"True if x, y are in bounds for this world (i.e., there is a cell at x, y)
|
||||||
else false.
|
else false.
|
||||||
|
|
|
@ -11,7 +11,7 @@
|
||||||
(world/make-world 3 3)
|
(world/make-world 3 3)
|
||||||
#(merge %2 {:altitude 100}))
|
#(merge %2 {:altitude 100}))
|
||||||
1 1 :altitude 90)]
|
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"))))
|
"Cell at 1, 1 should be a hollow"))))
|
||||||
|
|
||||||
(deftest flood-hollow-test
|
(deftest flood-hollow-test
|
||||||
|
|
Loading…
Reference in a new issue