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
|
||||
(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"
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue