From 7943765686022e681344c7c8b87c49e9ecad1e28 Mon Sep 17 00:00:00 2001 From: simon Date: Sat, 30 Aug 2014 14:51:55 +0100 Subject: [PATCH 01/23] Upversioned from 0.1.3 to 0.1.3-SNAPSHOT --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index 99018b6..038a3da 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-engine "0.1.3" +(defproject mw-engine "0.1.3-SNAPSHOT" :description "Cellular automaton world builder." :url "http://www.journeyman.cc/microworld/" :manifest { From cd5fc76a550d0e0698e30bd8c531debff6cc282c Mon Sep 17 00:00:00 2001 From: simon Date: Sat, 30 Aug 2014 14:58:13 +0100 Subject: [PATCH 02/23] Upversioned from 0.1.3-SNAPSHOT to 0.1.3 for release --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index 038a3da..99018b6 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-engine "0.1.3-SNAPSHOT" +(defproject mw-engine "0.1.3" :description "Cellular automaton world builder." :url "http://www.journeyman.cc/microworld/" :manifest { From dffa617a386f89620bbe3d4ff9d43bc470913839 Mon Sep 17 00:00:00 2001 From: simon Date: Sat, 30 Aug 2014 14:58:41 +0100 Subject: [PATCH 03/23] Upversioned from 0.1.3 to 0.1.4-SNAPSHOT --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index 99018b6..6625856 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-engine "0.1.3" +(defproject mw-engine "0.1.4-SNAPSHOT" :description "Cellular automaton world builder." :url "http://www.journeyman.cc/microworld/" :manifest { From 42e6cfac0583e51c42f534448bab9c111f2027ae Mon Sep 17 00:00:00 2001 From: simon Date: Sat, 30 Aug 2014 21:58:48 +0100 Subject: [PATCH 04/23] Working on getting drainage to actually work - which, inter alia, means further work on efficiency. --- src/mw_engine/core.clj | 38 ++++++++++---------------------------- src/mw_engine/drainage.clj | 20 ++++++++++++++------ src/mw_engine/utils.clj | 8 ++++---- 3 files changed, 28 insertions(+), 38 deletions(-) diff --git a/src/mw_engine/core.clj b/src/mw_engine/core.clj index 8a0ca95..4d946a6 100644 --- a/src/mw_engine/core.clj +++ b/src/mw_engine/core.clj @@ -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))) - - + + diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index c9d5874..e50f6ad 100644 --- a/src/mw_engine/drainage.clj +++ b/src/mw_engine/drainage.clj @@ -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 diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index 8c6fee5..3cdf94b 100644 --- a/src/mw_engine/utils.clj +++ b/src/mw_engine/utils.clj @@ -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)))) From 9912f264faa84c393abb3ee2beff814cb1609859 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 6 Sep 2014 11:41:09 +0100 Subject: [PATCH 05/23] Some tentative attempts at optimisation. This, actually, makes no difference in itself - because the world is immutable, this change won't work without a different mechanism for generating the world itself. --- src/mw_engine/drainage.clj | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index e50f6ad..e8d5919 100644 --- a/src/mw_engine/drainage.clj +++ b/src/mw_engine/drainage.clj @@ -35,13 +35,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*) + (not (nil? (:flow cell))) cell + (<= (or (:altitude cell) 0) *sealevel*) cell + true (merge cell {:flow (+ (:rainfall cell) (apply + (map (fn [neighbour] (:flow (flow world neighbour))) - (flow-contributors world cell))))}) - true cell)) + (flow-contributors world cell))))}))) (defn flow-world "Return a world like this `world`, but with cells tagged with the amount of From 8cbdd9d1a730d124cc80087fd75af7f1f3c0debf Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 15 Oct 2014 22:08:12 +0100 Subject: [PATCH 06/23] Upversioned from 0.1.4-SNAPSHOT to 0.1.4 for release --- project.clj | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/project.clj b/project.clj index 6625856..557287f 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-engine "0.1.4-SNAPSHOT" +(defproject mw-engine "0.1.4" :description "Cellular automaton world builder." :url "http://www.journeyman.cc/microworld/" :manifest { @@ -16,5 +16,6 @@ :dependencies [[org.clojure/clojure "1.5.1"] [org.clojure/math.combinatorics "0.0.7"] [org.clojure/tools.trace "0.7.8"] + [org.clojure/tools.namespace "0.2.4"] [net.mikera/imagez "0.3.1"] [fivetonine/collage "0.2.0"]]) From 8dd4d11dc66475cf444c4aaefcd5d63331a99fe9 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 15 Oct 2014 22:10:41 +0100 Subject: [PATCH 07/23] Upversioned from 0.1.4 to 0.1.4-SNAPSHOT --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index 557287f..fc1fcf5 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-engine "0.1.4" +(defproject mw-engine "0.1.4-SNAPSHOT" :description "Cellular automaton world builder." :url "http://www.journeyman.cc/microworld/" :manifest { From 901541b499e126e81fcc2b6932396f6f79ac273a Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 15 Oct 2014 22:17:29 +0100 Subject: [PATCH 08/23] Upversioned from 0.1.4-SNAPSHOT to 0.1.4 for release --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index fc1fcf5..557287f 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-engine "0.1.4-SNAPSHOT" +(defproject mw-engine "0.1.4" :description "Cellular automaton world builder." :url "http://www.journeyman.cc/microworld/" :manifest { From cd6b4ae10c8c5544f70d7d4c1f856cae7792306f Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 15 Oct 2014 22:17:53 +0100 Subject: [PATCH 09/23] Upversioned from 0.1.4 to 0.1.5-SNAPSHOT --- project.clj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/project.clj b/project.clj index 557287f..97804ef 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject mw-engine "0.1.4" +(defproject mw-engine "0.1.5-SNAPSHOT" :description "Cellular automaton world builder." :url "http://www.journeyman.cc/microworld/" :manifest { From f06febd7c66e9754bbe73603edd9aa8dd08fa967 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 18 Oct 2014 15:50:31 +0100 Subject: [PATCH 10/23] Work on improving efficiency of mapping over arrays. --- project.clj | 3 +-- src/mw_engine/drainage.clj | 23 ++++++++++++----------- src/mw_engine/utils.clj | 11 +++++++---- 3 files changed, 20 insertions(+), 17 deletions(-) diff --git a/project.clj b/project.clj index 97804ef..64282fc 100644 --- a/project.clj +++ b/project.clj @@ -11,8 +11,7 @@ :jvm-opts ["-Xmx4g"] :license {:name "GNU General Public License v2" :url "http://www.gnu.org/licenses/gpl-2.0.html"} - :plugins [[lein-marginalia "0.7.1"] - [lein-gorilla "0.3.2"]] + :plugins [[lein-marginalia "0.7.1"]] :dependencies [[org.clojure/clojure "1.5.1"] [org.clojure/math.combinatorics "0.0.7"] [org.clojure/tools.trace "0.7.8"] diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index e8d5919..be777c0 100644 --- a/src/mw_engine/drainage.clj +++ b/src/mw_engine/drainage.clj @@ -28,21 +28,22 @@ :altitude (or (:altitude cell) 0) >))))) -(defn flow +(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. Flow comes from a higher cell to a lower only if the lower is the lowest neighbour of the higher." - [world cell] - (cond - (not (nil? (:flow cell))) cell - (<= (or (:altitude cell) 0) *sealevel*) cell - true - (merge cell - {:flow (+ (:rainfall cell) - (apply + - (map (fn [neighbour] (:flow (flow world neighbour))) - (flow-contributors world cell))))}))) + (memoize + (fn [world cell] + (cond + (not (nil? (:flow cell))) cell + (<= (or (:altitude cell) 0) *sealevel*) cell + true + (merge cell + {:flow (+ (:rainfall cell) + (apply + + (map (fn [neighbour] (:flow (flow world neighbour))) + (flow-contributors world cell))))}))))) (defn flow-world "Return a world like this `world`, but with cells tagged with the amount of diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index 3cdf94b..f1d308d 100644 --- a/src/mw_engine/utils.clj +++ b/src/mw_engine/utils.clj @@ -2,7 +2,7 @@ (ns mw-engine.utils (:require - [clojure.core.reducers :as r] +;; [clojure.core.reducers :as r] [clojure.math.combinatorics :as combo])) (defn abs @@ -32,13 +32,16 @@ (defn map-world "Apply this `function` to each cell in this `world` to produce a new world. the arguments to the function will be the world, the cell, and any - `additional-args` supplied" + `additional-args` supplied. Note that we parallel map over rows but + just map over cells within a row. That's because it isn't worth starting + a new thread for each cell, but there may be efficiency gains in + running rows in parallel." ([world function] (map-world world function nil)) ([world function additional-args] (into [] - (r/map (fn [row] - (into [] (r/map + (pmap (fn [row] + (into [] (map #(apply function (cons world (cons % additional-args))) row))) From fd817f25823857ba88188798969105c24ba8c37f Mon Sep 17 00:00:00 2001 From: simon Date: Mon, 20 Oct 2014 17:01:40 +0100 Subject: [PATCH 11/23] Minor optimisation --- project.clj | 2 +- src/mw_engine/drainage.clj | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/project.clj b/project.clj index 64282fc..f43e2d3 100644 --- a/project.clj +++ b/project.clj @@ -12,7 +12,7 @@ :license {:name "GNU General Public License v2" :url "http://www.gnu.org/licenses/gpl-2.0.html"} :plugins [[lein-marginalia "0.7.1"]] - :dependencies [[org.clojure/clojure "1.5.1"] + :dependencies [[org.clojure/clojure "1.6.0"] [org.clojure/math.combinatorics "0.0.7"] [org.clojure/tools.trace "0.7.8"] [org.clojure/tools.namespace "0.2.4"] diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index be777c0..1d04a7a 100644 --- a/src/mw_engine/drainage.clj +++ b/src/mw_engine/drainage.clj @@ -2,8 +2,6 @@ ;; 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)) @@ -21,7 +19,7 @@ [world cell] (remove nil? (into [] - (r/map + (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 @@ -30,10 +28,12 @@ (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. + to this one but having a value of its flow property set from that computation. The function is + memoised because the consequence of mapping a recursive function across an array is that many + cells will be revisited - potentially many times. 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] (cond (not (nil? (:flow cell))) cell From 5c6fbb5b083cb839c3af0d388cadc453fd944ae9 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 28 Mar 2015 16:24:24 +0000 Subject: [PATCH 12/23] Initial commit --- LICENSE | 340 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 340 insertions(+) create mode 100644 LICENSE diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..d6a9326 --- /dev/null +++ b/LICENSE @@ -0,0 +1,340 @@ +GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + {description} + Copyright (C) {year} {fullname} + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + {signature of Ty Coon}, 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. + From ce6212a9658b947d6e820c65e8bb56d947b19104 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 28 Mar 2015 16:43:11 +0000 Subject: [PATCH 13/23] Modifications to README.md and buildall.sh to make this easier for other people to build. --- README.md | 8 ++++++++ buildall.sh | 15 ++++++++------- 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index 8611367..5ae9840 100644 --- a/README.md +++ b/README.md @@ -2,6 +2,11 @@ Core cellular automaton engine for MicroWorld. +## Part of the overall Microworld system + +While this code works and is interesting on its own, you also need at least +*mw-parser* and *mw-ui*. There will be other modules in due course. + ## Usage Primary entry points are make-world and run-world, both in mw-engine.core. See @@ -10,6 +15,9 @@ using lein marg +To build the whole system, place all MicroWorld projects in a common directory, +and from that directory run *buildall.sh*. + ## License Copyright © 2014 Simon Brooke diff --git a/buildall.sh b/buildall.sh index 488fea0..e731cc3 100755 --- a/buildall.sh +++ b/buildall.sh @@ -6,7 +6,7 @@ # WARNING: The regexps in this are fair awfy bruckle. Edit with care. -# Simon Broooke +# Simon Broooke # Variable and glag initialisation archive=FALSE @@ -72,10 +72,11 @@ if [ $# -lt 1 ] then cat <<-EOF 1>&2 Usage: - -archive Create a tar archive of the current state of the source. + -archive Create a tar archive of the current state of the source. -build Build all components and commit to master. -email [ADDRESS] Your email address, to be recorded in the build signature. -fullname [NAME] Your full name, to be recorded in the build signature. + -pull Pull from remote git repository -release [LABEL] Build all components, branch for release on old label, then upversion to new LABEL and commit to master. -trial Trial build only, do not commit. @@ -86,8 +87,8 @@ fi while (( "$#" )) do case $1 in - -a|-archive) - archive="TRUE";; + -a|-archive) + archive="TRUE";; -b|-build) # 'build' is the expected normal case. trial="FALSE"; @@ -108,9 +109,9 @@ do echo "Release flagged, but no release tag supplied" 1>&2; exit 1; fi;; - -p|-pull) - # pull from remote Git origin - git pull origin master;; + -p|-pull) + # pull from remote Git origin + git pull origin master;; -t|-trial) trial="TRUE";; -w|-webapps) From b007807b2923b73e94bdd4ce350679e7f780db43 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 28 Mar 2015 16:54:50 +0000 Subject: [PATCH 14/23] Added more to README to make it easier for other people to build this. --- README.md | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 5ae9840..6e2983b 100644 --- a/README.md +++ b/README.md @@ -16,7 +16,17 @@ using lein marg To build the whole system, place all MicroWorld projects in a common directory, -and from that directory run *buildall.sh*. +and from that directory run *buildall.sh*. Alternatively, in each MicroWorld +project directory, run + + lein clean + lein compile + lein marg + lein install + +and then from the mw-ui directory, run + + lein ring server ## License From dce1b603a354239abaae4bea230ae70fbc2c1479 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 28 Mar 2015 17:27:47 +0000 Subject: [PATCH 15/23] D'oh! Messed up the formatting of markdown links. --- README.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 6e2983b..45821b9 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,9 @@ Core cellular automaton engine for MicroWorld. ## Part of the overall Microworld system While this code works and is interesting on its own, you also need at least -*mw-parser* and *mw-ui*. There will be other modules in due course. +[mw-parser](https://github.com/simon-brooke/mw-parser) and +[mw-ui](https://github.com/simon-brooke/mw-ui). There will be other +modules in due course. ## Usage From d52b563f92b3cd4eec92fee0de14cb868c37465d Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 28 Mar 2015 19:31:28 +0000 Subject: [PATCH 16/23] Added link to Goldsmith in README. --- README.md | 6 +++++- buildall.sh | 6 +++--- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index 45821b9..01786d2 100644 --- a/README.md +++ b/README.md @@ -2,13 +2,17 @@ Core cellular automaton engine for MicroWorld. -## Part of the overall Microworld system +## Part of the overall MicroWorld system While this code works and is interesting on its own, you also need at least [mw-parser](https://github.com/simon-brooke/mw-parser) and [mw-ui](https://github.com/simon-brooke/mw-ui). There will be other modules in due course. +You can see MicroWorld in action [here](http://www.journeyman.cc/microworld/) - +but please don't be mean to my poor little server. If you want to run big maps +or complex rule-sets, please run it on your own machines. + ## Usage Primary entry points are make-world and run-world, both in mw-engine.core. See diff --git a/buildall.sh b/buildall.sh index e731cc3..0eabd8e 100755 --- a/buildall.sh +++ b/buildall.sh @@ -99,6 +99,9 @@ do -f|-fullname) shift; fullname=$1;; + -p|-pull) + # pull from remote Git origin + git pull origin master;; -r|-release) # release is branch a release and upversion to new label shift; @@ -109,9 +112,6 @@ do echo "Release flagged, but no release tag supplied" 1>&2; exit 1; fi;; - -p|-pull) - # pull from remote Git origin - git pull origin master;; -t|-trial) trial="TRUE";; -w|-webapps) From 2dbc1cecc5cc17b658d75d4e9f5937c8d0aa9b32 Mon Sep 17 00:00:00 2001 From: simon Date: Fri, 10 Apr 2015 19:55:09 +0100 Subject: [PATCH 17/23] A possible - untested - solution to the local hollow problem. --- src/mw_engine/drainage.clj | 45 ++++++++++++++++++++++++------------- src/mw_engine/heightmap.clj | 6 ++--- src/mw_engine/utils.clj | 29 +++++++++++++++++++++++- 3 files changed, 61 insertions(+), 19 deletions(-) diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index 1d04a7a..d7eaa7a 100644 --- a/src/mw_engine/drainage.clj +++ b/src/mw_engine/drainage.clj @@ -7,6 +7,9 @@ (def ^:dynamic *sealevel* 10) +;; forward declaration of flow, to allow for a wee bit of mutual recursion. +(declare flow) + (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" @@ -26,24 +29,36 @@ :altitude (or (:altitude cell) 0) >))))) +(defn flood-hollow + "Raise the altitude of a copy of this `cell` of this `world` to one unit above the lowest of these `neighbours`, and reflow." + [cell world neighbours] + (let [lowest (get-least-cell neighbours :altitude)] + (flow (merge cell {:altitude (+ (:altitude lowest) 1)})))) + (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 - memoised because the consequence of mapping a recursive function across an array is that many - cells will be revisited - potentially many times. + to this one but having a value of its flow property set from that computation. The function is + memoised because the consequence of mapping a recursive function across an array is that many + cells will be revisited - potentially many times. - Flow comes from a higher cell to a lower only if the lower is the lowest neighbour of the higher." - (memoize - (fn [world cell] - (cond - (not (nil? (:flow cell))) cell - (<= (or (:altitude cell) 0) *sealevel*) cell - true - (merge cell - {:flow (+ (:rainfall cell) - (apply + - (map (fn [neighbour] (:flow (flow world neighbour))) - (flow-contributors world cell))))}))))) + Flow comes from a higher cell to a lower only if the lower is the lowest neighbour of the higher." + (memoize + (fn [world cell] + (cond + (not (nil? (:flow cell))) cell + (<= (or (:altitude cell) 0) *sealevel*) cell + true + (let [contributors (flow-contributors world cell)] + (if + (= (count contributors) 8) + ;; local lowspot - lake bottom + (flood-hollow cell world contributors) + ;; otherwise... + (merge cell + {:flow (+ (:rainfall cell) + (apply + + (map (fn [neighbour] (:flow (flow world neighbour))) + (flow-contributors world cell))))}))))))) (defn flow-world "Return a world like this `world`, but with cells tagged with the amount of diff --git a/src/mw_engine/heightmap.clj b/src/mw_engine/heightmap.clj index bfcf6af..a6d1f7d 100644 --- a/src/mw_engine/heightmap.clj +++ b/src/mw_engine/heightmap.clj @@ -13,7 +13,7 @@ [mikera.image.filters :as filters])) -(defn- tag-property +(defn tag-property "Set the value of this `property` of this cell from the corresponding pixel of this `heightmap`. If the heightmap you supply is smaller than the world, this will break. @@ -36,7 +36,7 @@ (get-int cell :x) (get-int cell :y)) 256))))}))) -(defn- tag-gradient +(defn tag-gradient "Set the `gradient` property of this `cell` of this `world` to the difference in altitude between its highest and lowest neghbours." [world cell] @@ -54,7 +54,7 @@ [world] (map-world world tag-gradient)) -(defn- tag-altitude +(defn tag-altitude "Set the altitude of this cell from the corresponding pixel of this heightmap. If the heightmap you supply is smaller than the world, this will break. diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index f1d308d..eb53da9 100644 --- a/src/mw_engine/utils.clj +++ b/src/mw_engine/utils.clj @@ -29,12 +29,39 @@ [world x y] (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world))))) +(defn map-world-n-n + "Wholly non-parallel map world implementation" + ([world function] + (map-world-n-n world function nil)) + ([world function additional-args] + (into [] + (map (fn [row] + (into [] (map + #(apply function + (cons world (cons % additional-args))) + row))) + world)))) + +(defn map-world-p-p + "Wholly parallel map world implementation" + ([world function] + (map-world-p-p world function nil)) + ([world function additional-args] + (into [] + (pmap (fn [row] + (into [] (pmap + #(apply function + (cons world (cons % additional-args))) + row))) + world)))) + + (defn map-world "Apply this `function` to each cell in this `world` to produce a new world. the arguments to the function will be the world, the cell, and any `additional-args` supplied. Note that we parallel map over rows but just map over cells within a row. That's because it isn't worth starting - a new thread for each cell, but there may be efficiency gains in + a new thread for each cell, but there may be efficiency gains in running rows in parallel." ([world function] (map-world world function nil)) From 1c8d8c421944bf1b2d1d06d1eb5bc887e05c2417 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 12 Apr 2015 19:34:19 +0100 Subject: [PATCH 18/23] Added merge-cell, and tests for it. Still trying to solve the Falls of Clyde problem --- project.clj | 1 + src/mw_engine/drainage.clj | 28 +++++++++++++++++++--------- src/mw_engine/heightmap.clj | 3 +-- src/mw_engine/utils.clj | 16 ++++++++++++++-- test/mw_engine/utils_test.clj | 18 +++++++++++++++--- 5 files changed, 50 insertions(+), 16 deletions(-) diff --git a/project.clj b/project.clj index f43e2d3..a2739ff 100644 --- a/project.clj +++ b/project.clj @@ -16,5 +16,6 @@ [org.clojure/math.combinatorics "0.0.7"] [org.clojure/tools.trace "0.7.8"] [org.clojure/tools.namespace "0.2.4"] + [hiccup "1.0.5"] [net.mikera/imagez "0.3.1"] [fivetonine/collage "0.2.0"]]) diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index d7eaa7a..8b46248 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) + (:require [mw-engine.heightmap :as heightmap])) (def ^:dynamic *sealevel* 10) @@ -18,22 +19,25 @@ (defn flow-contributors "Return a list of the cells in this `world` which are higher than this - `cell` and for which this cell is the lowest neighbour" + `cell` and for which this cell is the lowest neighbour, or which are at the + same altitude and have greater flow" [world cell] (remove nil? (into [] (map (fn [n] - (cond (= cell (get-least-cell (get-neighbours world n) :altitude)) n)) + (cond (= cell (get-least-cell (get-neighbours world n) :altitude)) n + (and (= (:altitude cell) (:altitude n))(> (or (:flow n) 0) (or (:flow cell) 0))) n)) (get-neighbours-with-property-value world (:x cell) (:y cell) 1 :altitude - (or (:altitude cell) 0) >))))) + (or (:altitude cell) 0) >=))))) (defn flood-hollow "Raise the altitude of a copy of this `cell` of this `world` to one unit above the lowest of these `neighbours`, and reflow." [cell world neighbours] (let [lowest (get-least-cell neighbours :altitude)] - (flow (merge cell {:altitude (+ (:altitude lowest) 1)})))) + (flow world (merge cell {:altitude (+ (:altitude lowest) 1)})))) +;; cell) (def flow "Compute the total flow upstream of this `cell` in this `world`, and return a cell identical @@ -49,19 +53,25 @@ (<= (or (:altitude cell) 0) *sealevel*) cell true (let [contributors (flow-contributors world cell)] - (if - (= (count contributors) 8) +;; (if +;; (= (count contributors) 8) ;; local lowspot - lake bottom - (flood-hollow cell world contributors) +;; (flood-hollow cell world contributors) ;; otherwise... (merge cell {:flow (+ (:rainfall cell) (apply + (map (fn [neighbour] (:flow (flow world neighbour))) - (flow-contributors world cell))))}))))))) + (flow-contributors world cell))))})))))) (defn flow-world "Return a world like this `world`, but with cells tagged with the amount of water flowing through them." [world] (map-world (rain-world world) flow)) + +(defn run-drainage + [hmap] + "Create a world from the heightmap `hmap`, rain on it, and then compute river + flows." + (flow-world (rain-world (heightmap/apply-heightmap hmap)))) diff --git a/src/mw_engine/heightmap.clj b/src/mw_engine/heightmap.clj index a6d1f7d..403cad0 100644 --- a/src/mw_engine/heightmap.clj +++ b/src/mw_engine/heightmap.clj @@ -6,8 +6,7 @@ (ns mw-engine.heightmap (:import [java.awt.image BufferedImage]) (:use mw-engine.utils - mw-engine.world - mw-engine.drainage) + mw-engine.world) (:require [fivetonine.collage.util :as collage :only [load-image]] [mikera.image.core :as imagez :only [filter-image get-pixels]] [mikera.image.filters :as filters])) diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index eb53da9..6abc166 100644 --- a/src/mw_engine/utils.clj +++ b/src/mw_engine/utils.clj @@ -13,7 +13,7 @@ * `n` a number, on the set of real numbers." [n] - (cond (neg? n) (- 0 n) true n)) + (if (neg? n) (- 0 n) n)) (defn member? "True if elt is a member of col." @@ -225,4 +225,16 @@ row))) world)))) - +(defn merge-cell + "Return a world like this `world`, but merge the values from this `cell` with + those from the cell in the world with the same co-ordinates" + [world cell] + (if (in-bounds world (:x cell) (:y cell)) + (map-world world + #(if + (and + (= (:x cell)(:x %2)) + (= (:y cell)(:y %2))) + (merge %2 cell) + %2)) + world)) diff --git a/test/mw_engine/utils_test.clj b/test/mw_engine/utils_test.clj index 977abbb..0077ceb 100644 --- a/test/mw_engine/utils_test.clj +++ b/test/mw_engine/utils_test.clj @@ -164,6 +164,18 @@ "All cells should have property 'test' set to true") (is (empty? (remove #(= % 8) (map #(:number %) (flatten w3c)))) "All cells should have property 'number' set to 8")))) - - - \ No newline at end of file + +(deftest merge-cell-test + (testing "merge-cell utility function" + (let [w1a (make-world 3 3) + w2b (merge-cell w1a {:x 5 :y 5 :out-of-bounds true}) + w3c (merge-cell w1a {:x 2 :y 2 :test true})] + (is (= w1a w2b) "Out of bound cell makes no difference") + (is (empty? (filter #(:out-of-bounds %) (flatten w2b))) + "No cell has :out-of-bounds set") + (is (= 1 (count (filter #(:test %) (flatten w3c)))) + "Exactly one cell has :test set") + (is (:test (get-cell w3c 2 2)) + "The cell with :test set is at 2, 2")))) + + \ No newline at end of file From 337d1ae07eaa6af99bd6e9cff2bc4cf4c786575f Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 13 Apr 2015 20:36:24 +0100 Subject: [PATCH 19/23] Further work on the Falls of Clyde problem, and on optimisation. --- src/mw_engine/drainage.clj | 67 ++++++++++++++++++++++++-------------- src/mw_engine/utils.clj | 19 +++++++---- 2 files changed, 54 insertions(+), 32 deletions(-) diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index 8b46248..f0eef60 100644 --- a/src/mw_engine/drainage.clj +++ b/src/mw_engine/drainage.clj @@ -22,22 +22,45 @@ `cell` and for which this cell is the lowest neighbour, or which are at the same altitude and have greater flow" [world cell] - (remove nil? - (into [] - (map - (fn [n] - (cond (= cell (get-least-cell (get-neighbours world n) :altitude)) n - (and (= (:altitude cell) (:altitude n))(> (or (:flow n) 0) (or (:flow cell) 0))) n)) - (get-neighbours-with-property-value world (:x cell) (:y cell) 1 - :altitude - (or (:altitude cell) 0) >=))))) + (filter #(map? %) + (map + (fn [n] + (cond + (= cell (get-least-cell (get-neighbours world n) :altitude)) n + (and (= (:altitude cell) (:altitude n)) + (> (or (:flow n) 0) (or (:flow cell) 0))) n)) + (get-neighbours-with-property-value + world (:x cell) (:y cell) 1 :altitude + (or (:altitude cell) 0) >=)))) + +(defn is-hollow + "Detects point hollows - that is, individual cells all of whose neighbours + are higher. Return true if this `cell` has an altitude lower than any of + its neighbours in this `world`" + [world cell] + ;; 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)] + (= (count neighbours) + (count (get-neighbours-with-property-value + world (:x cell) (:y cell) 1 :altitude >))))) (defn flood-hollow - "Raise the altitude of a copy of this `cell` of this `world` to one unit above the lowest of these `neighbours`, and reflow." - [cell world neighbours] - (let [lowest (get-least-cell neighbours :altitude)] - (flow world (merge cell {:altitude (+ (:altitude lowest) 1)})))) -;; cell) + "Raise the altitude of a copy of this `cell` of this `world` to the altitude + of the lowest of its `neighbours`." + ([world cell neighbours] + (let [lowest (get-least-cell neighbours :altitude)] + (merge cell {:state :water :altitude (:altitude lowest)}))) + ([world cell] + (flood-hollow world cell (get-neighbours world cell)))) + +(defn flood-hollows + "Flood all local hollows in this `world`. At this stage only floods single + cell hollows." + [world] + (map-world world + #(if (is-hollow %1 %2) (flood-hollow %1 %2) %2))) (def flow "Compute the total flow upstream of this `cell` in this `world`, and return a cell identical @@ -52,17 +75,11 @@ (not (nil? (:flow cell))) cell (<= (or (:altitude cell) 0) *sealevel*) cell true - (let [contributors (flow-contributors world cell)] -;; (if -;; (= (count contributors) 8) - ;; local lowspot - lake bottom -;; (flood-hollow cell world contributors) - ;; otherwise... - (merge cell - {:flow (+ (:rainfall cell) - (apply + - (map (fn [neighbour] (:flow (flow world neighbour))) - (flow-contributors world cell))))})))))) + (merge cell + {:flow (+ (:rainfall cell) + (apply + + (map (fn [neighbour] (:flow (flow world neighbour))) + (flow-contributors world cell))))}))))) (defn flow-world "Return a world like this `world`, but with cells tagged with the amount of diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index 6abc166..0873759 100644 --- a/src/mw_engine/utils.clj +++ b/src/mw_engine/utils.clj @@ -106,6 +106,16 @@ [cell species] (get-int cell species)) +(def memo-get-neighbours + "Memoised core primitive for `get-neighbours` for efficiency." + (memoize + (fn [world x y depth] + (remove nil? + (map #(get-cell world (first %) (first (rest %))) + (remove #(= % (list x y)) + (combo/cartesian-product + (range (- x depth) (+ x depth 1)) + (range (- y depth) (+ y depth 1))))))))) (defn get-neighbours "Get the neighbours to distance depth of the cell at x, y in this world. @@ -116,12 +126,7 @@ * `depth` an integer representing the distance from [x,y] that should be searched." ([world x y depth] - (remove nil? - (map #(get-cell world (first %) (first (rest %))) - (remove #(= % (list x y)) - (combo/cartesian-product - (range (- x depth) (+ x depth 1)) - (range (- y depth) (+ y depth 1))))))) + (memo-get-neighbours world x y depth)) ([world cell depth] "Get the neighbours to distance depth of this cell in this world. @@ -129,7 +134,7 @@ * `cell` a cell within that world; * `depth` an integer representing the distance from [x,y] that should be searched." - (get-neighbours world (:x cell) (:y cell) depth)) + (memo-get-neighbours world (:x cell) (:y cell) depth)) ([world cell] "Get the immediate neighbours of this cell in this world From f9c437d8d3d1d1d285775e850fa09a6d9624b5d1 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 13 Apr 2015 20:54:41 +0100 Subject: [PATCH 20/23] Unit tests for drainage functions. --- test/mw_engine/drainage_test.clj | 48 ++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) create mode 100644 test/mw_engine/drainage_test.clj diff --git a/test/mw_engine/drainage_test.clj b/test/mw_engine/drainage_test.clj new file mode 100644 index 0000000..ba2c95a --- /dev/null +++ b/test/mw_engine/drainage_test.clj @@ -0,0 +1,48 @@ +(ns mw-engine.drainage-test + (:require [clojure.test :refer :all] + [mw-engine.world :as world] + [mw-engine.utils :as utils] + [mw-engine.drainage :refer :all])) + +(deftest is-hollow-test + (testing "detection of hollows" + (let [world (utils/set-property + (utils/map-world + (world/make-world 3 3) + #(merge %2 {:altitude 100})) + 1 1 :altitude 90)] + (is (is-hollow world (utils/get-cell world 1 1)) + "Cell at 1, 1 should be a hollow")))) + +(deftest flood-hollow-test + (testing "Flooding of a single specified cell" + (let [world (utils/set-property + (utils/map-world + (world/make-world 3 3) + #(merge %2 {:altitude 100})) + 1 1 :altitude 90) + cell (flood-hollow world (utils/get-cell world 1 1))] + (is (= (:state cell) :water) + "State should be water") + (is (= (:altitude cell) 100) + "Altitude should be 100")))) + +(deftest flood-hollows-test + (testing "Flooding of hollows" + (let [world (utils/set-property + (utils/map-world + (world/make-world 3 3) + #(merge %2 {:altitude 100})) + 1 1 :altitude 90) + w2 (flood-hollows world)] + (is (= (:state (utils/get-cell world 1 1)) :new) + "State of cell in original world should still be :new") + (is (= (:state (utils/get-cell w2 1 1)) :water) + "State of cell in processed world should still be :water") + (is (= (:altitude (utils/get-cell w2 1 1)) 100) + "Altitude of cell in processed world should still be 100")))) + + + + + \ No newline at end of file From f9591c4e8db03ee17bf1bb62e69b007705d1f3cb Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 18 Apr 2015 19:21:04 +0100 Subject: [PATCH 21/23] 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 From 5f73b18d12780ea7ade998d5ef9ba57274dfece7 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sat, 18 Apr 2015 21:53:09 +0100 Subject: [PATCH 22/23] Tests now pass again. Oooops. --- src/mw_engine/utils.clj | 3 ++- test/mw_engine/drainage_test.clj | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index c8ced6a..3ad2b1f 100644 --- a/src/mw_engine/utils.clj +++ b/src/mw_engine/utils.clj @@ -1,4 +1,5 @@ -;; Utility functions needed by MicroWorld and, specifically, in the interpretation of MicroWorld rule. +;; Utility functions needed by MicroWorld and, specifically, in the +;; interpretation of MicroWorld rule. (ns mw-engine.utils (:require diff --git a/test/mw_engine/drainage_test.clj b/test/mw_engine/drainage_test.clj index 574e7bf..ba2c95a 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 (utils/get-cell world 1 1) world) + (is (is-hollow world (utils/get-cell world 1 1)) "Cell at 1, 1 should be a hollow")))) (deftest flood-hollow-test From 3c26408a9f1a7af2af8d5364104b285798be8d3f Mon Sep 17 00:00:00 2001 From: simon Date: Tue, 21 Apr 2015 07:56:22 +0100 Subject: [PATCH 23/23] Dememoised get-neighbours, as the optimisation only works in deep recursion which I'm no longer doing. --- src/mw_engine/utils.clj | 55 ++++++++++++++++++++++++----------------- 1 file changed, 33 insertions(+), 22 deletions(-) diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj index 3ad2b1f..279ec18 100644 --- a/src/mw_engine/utils.clj +++ b/src/mw_engine/utils.clj @@ -1,4 +1,4 @@ -;; Utility functions needed by MicroWorld and, specifically, in the +;; Utility functions needed by MicroWorld and, specifically, in the ;; interpretation of MicroWorld rule. (ns mw-engine.utils @@ -21,17 +21,17 @@ [elt col] (some #(= elt %) col)) (defn get-int-or-zero - "Return the value of this `property` from this `map` if it is a integer; + "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 +(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." + 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)})) @@ -124,7 +124,10 @@ (get-int cell species)) (def memo-get-neighbours - "Memoised core primitive for `get-neighbours` for efficiency." + "Memoised get neighbours is more efficient when running deeply recursive + algorithms on the same world. But it's less efficient when running the + engine in its normal iterative style, because then we will rarely call + get naighbours on the same cell of the same world twice." (memoize (fn [world x y depth] (remove nil? @@ -135,28 +138,36 @@ (range (- y depth) (+ y depth 1))))))))) (defn get-neighbours - "Get the neighbours to distance depth of the cell at x, y in this world. + "Get the neighbours to distance depth of a cell in this world. + + Several overloads: + * `world` a world, as described in world.clj; + * `cell` a cell within that world + Gets immediate neighbours of the specified cell. + + * `world` a world, as described in world.clj; + * `cell` a cell within that world + * `depth` an integer representing the depth to search from the + `cell` + Gets neighbours within the specified distance of the cell. * `world` a world, as described in world.clj; * `x` an integer representing an x coordinate in that world; * `y` an integer representing an y coordinate in that world; * `depth` an integer representing the distance from [x,y] that - should be searched." + should be searched + Gets the neighbours within the specified distance of the cell at + coordinates [x,y] in this world." ([world x y depth] - (memo-get-neighbours world x y depth)) + (remove nil? + (map #(get-cell world (first %) (first (rest %))) + (remove #(= % (list x y)) + (combo/cartesian-product + (range (- x depth) (+ x depth 1)) + (range (- y depth) (+ y depth 1))))))) ([world cell depth] - "Get the neighbours to distance depth of this cell in this world. - - * `world` a world, as described in world.clj; - * `cell` a cell within that world; - * `depth` an integer representing the distance from [x,y] that - should be searched." (memo-get-neighbours world (:x cell) (:y cell) depth)) ([world cell] - "Get the immediate neighbours of this cell in this world - - * `world` a world, as described in world.clj; - * `cell` a cell within that world." (get-neighbours world cell 1))) (defn get-neighbours-with-property-value @@ -166,10 +177,10 @@ * `world` a world, as described in `world.clj`; * `cell` a cell within that world; * `depth` an integer representing the distance from [x,y] that - should be searched; + should be searched (optional); * `property` a keyword representing a property of the neighbours; * `value` a value of that property (or, possibly, the name of another); - * `op` a comparator function to use in place of `=`. + * `op` a comparator function to use in place of `=` (optional). It gets messy." ([world x y depth property value op] @@ -253,7 +264,7 @@ [world cell] (if (in-bounds world (:x cell) (:y cell)) (map-world world - #(if + #(if (and (= (:x cell)(:x %2)) (= (:y cell)(:y %2)))