Working on getting drainage to actually work - which, inter alia, means

further work on efficiency.
This commit is contained in:
simon 2014-08-30 21:58:48 +01:00
parent dffa617a38
commit 42e6cfac05
3 changed files with 28 additions and 38 deletions

View file

@ -23,12 +23,12 @@
;; that every cell's :x and :y properties reflect its place in the matrix.
;; See `world.clj`.
;;
;; Each time the world is transformed (see `transform-world`, for each cell,
;; Each time the world is transformed (see `transform-world`, for each cell,
;; rules are applied in turn until one matches. Once one rule has matched no
;; further rules can be applied.
(defn apply-rule
(defn apply-rule
"Apply a single `rule` to a `cell`. What this is about is that I want to be able,
for debugging purposes, to tag a cell with the rule text of the rule which
fired (and especially so when an exception is thrown. So a rule may be either
@ -41,7 +41,7 @@
(seq? rule) (let [[afn src] rule] (apply-rule cell world afn src))))
([cell world rule source]
(let [result (apply rule (list cell world))]
(cond
(cond
(and result source) (merge result {:rule source})
true result))))
@ -58,11 +58,11 @@
exception is thrown, cache its message on the cell and set it's state to error"
[world cell rules]
(try
(merge
(apply-rules world cell rules)
(merge
(apply-rules world cell rules)
{:generation (+ (or (:generation cell) 0) 1)})
(catch Exception e
(merge cell {:error
(catch Exception e
(merge cell {:error
(format "%s at generation %d when in state %s"
(.getMessage e)
(:generation cell)
@ -93,28 +93,10 @@
* `generations` an (integer) number of generations.
Return the final generation of the world."
[world init-rules rules generations]
(let [state {:world (transform-world world init-rules) :rules rules}]
(:world
(last
(doall
(take generations
(iterate transform-world-state state)))))))
(defn run-world2
"Doesn't work yet"
[world init-rules rules generations]
(with-local-vars [r (ref (transform-world world init-rules))]
(dotimes [g generations]
(dosync
(ref-set r (transform-world (deref r) rules))))
(deref r)))
(defn run-world3
[world init-rules rules generations]
(reduce (fn [world _iteration]
(reduce (fn [world _iteration]
(transform-world world rules))
(transform-world world init-rules)
(range generations)))

View file

@ -2,9 +2,13 @@
;; assumed to have altitudes already set from a heighmap.
(ns mw-engine.drainage
(:require
[clojure.core.reducers :as r])
(:use mw-engine.utils
mw-engine.world))
(def ^:dynamic *sealevel* 10)
(defn rain-world
"Simulate rainfall on this `world`. TODO: Doesn't really work just now - should
rain more on west-facing slopes, and less to the east of high ground"
@ -16,12 +20,13 @@
`cell` and for which this cell is the lowest neighbour"
[world cell]
(remove nil?
(map
(fn [n]
(cond (= cell (get-least-cell (get-neighbours world n) :altitude)) n))
(get-neighbours-with-property-value world (:x cell) (:y cell) 1
(into []
(r/map
(fn [n]
(cond (= cell (get-least-cell (get-neighbours world n) :altitude)) n))
(get-neighbours-with-property-value world (:x cell) (:y cell) 1
:altitude
(or (:altitude cell) 0) >))))
(or (:altitude cell) 0) >)))))
(defn flow
"Compute the total flow upstream of this `cell` in this `world`, and return a cell identical
@ -29,11 +34,14 @@
Flow comes from a higher cell to a lower only if the lower is the lowest neighbour of the higher."
[world cell]
(cond
(> (or (:altitude cell) 0) *sealevel*)
(merge cell
{:flow (+ (:rainfall cell)
(apply +
(map (fn [neighbour] (:flow (flow world neighbour)))
(flow-contributors world cell))))}))
(flow-contributors world cell))))})
true cell))
(defn flow-world
"Return a world like this `world`, but with cells tagged with the amount of

View file

@ -1,7 +1,7 @@
;; Utility functions needed by MicroWorld and, specifically, in the interpretation of MicroWorld rule.
(ns mw-engine.utils
(:require
(:require
[clojure.core.reducers :as r]
[clojure.math.combinatorics :as combo]))
@ -36,10 +36,10 @@
([world function]
(map-world world function nil))
([world function additional-args]
(into [] ;; vectors are more efficient for scanning, which we do a lot.
(into []
(r/map (fn [row]
(into [] (r/map
#(apply function
(into [] (r/map
#(apply function
(cons world (cons % additional-args)))
row)))
world))))