From 2f2463da0e75077d55e06de6f91475de6ff02f29 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Wed, 3 Jun 2020 10:47:28 +0100 Subject: [PATCH] Sweep up of minor changes --- .gitignore | 10 + docs/uberdoc.html | 3997 +++++++++++++++++++++++++++++++ project.clj | 7 +- src/mw_engine/core.clj | 9 +- src/mw_engine/display.clj | 6 +- src/mw_engine/drainage.clj | 68 +- src/mw_engine/natural_rules.clj | 4 +- 7 files changed, 4092 insertions(+), 9 deletions(-) create mode 100644 .gitignore create mode 100644 docs/uberdoc.html diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..f553393 --- /dev/null +++ b/.gitignore @@ -0,0 +1,10 @@ + +target/ + +pom.xml + +.lein-repl-history + +.lein-failures + +eastwood.txt diff --git a/docs/uberdoc.html b/docs/uberdoc.html new file mode 100644 index 0000000..91fdaea --- /dev/null +++ b/docs/uberdoc.html @@ -0,0 +1,3997 @@ + +mw-engine -- Marginalia

mw-engine

0.1.6-SNAPSHOT


Cellular automaton world builder.

+

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
hiccup
1.0.5
net.mikera/imagez
0.3.1
fivetonine/collage
0.2.0



(this space intentionally left almost blank)

namespaces

 

mw-engine.core

toc

Functions to transform a world and run rules.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-engine.core
+  (:require [clojure.core.reducers :as r]
+            [mw-engine.world :as world]
+            [mw-engine.utils :refer [get-int-or-zero map-world]])
+  (:gen-class))

mw-engine: the state/transition engine of MicroWorld.

+ +

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.

+ +

Copyright (C) 2014 Simon Brooke

+ +

Every rule is a function of two arguments, a cell and a world. If the rule +fires, it returns a new cell, which should have the same values for :x and +:y as the old cell. Anything else can be modified.

+ +

While any function of two arguments can be used as a rule, a special high +level rule language is provided by the mw-parser package, which compiles +rules expressed in a subset of English rules into suitable functions.

+ +

A cell is a map containing at least values for the keys :x, :y, and :state; +a transformation should not alter the values of :x or :y, and should not +return a cell without a keyword as the value of :state. Anything else is +legal.

+ +

A world is a two dimensional matrix (sequence of sequences) of cells, such +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, +rules are applied in turn until one matches. Once one rule has matched no +further rules can be applied.

+

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 + an ifn, or a list (ifn source-text). This function deals with despatching + on those two possibilities. world is also passed in in order to be able + to access neighbours.

+
(defn apply-rule
+  ([world cell rule]
+   (cond
+     (ifn? rule) (apply-rule world cell rule nil)
+     (seq? rule) (let [[afn src] rule] (apply-rule world cell afn src))))
+  ([world cell rule source]
+    (let [result (apply rule (list cell world))]
+      (cond
+        (and result source) (merge result {:rule source})
+        true result))))

Derive a cell from this cell of this world by applying these rules.

+
(defn- apply-rules
+  [world cell rules]
+  (cond (empty? rules) cell
+    true (let [result (apply-rule world cell (first rules))]
+           (cond result result
+             true (apply-rules world cell (rest rules))))))

Derive a cell from this cell of this world by applying these rules. If an + exception is thrown, cache its message on the cell and set it's state to error

+
(defn- transform-cell
+  [world cell rules]
+  (try
+    (merge
+      (apply-rules world cell rules)
+      {:generation (+ (get-int-or-zero cell :generation) 1)})
+    (catch Exception e
+      (merge cell {:error
+                   (format "%s at generation %d when in state %s"
+                           (.getMessage e)
+                           (:generation cell)
+                           (:state cell))
+                   :stacktrace (map #(.toString %) (.getStackTrace e))
+                   :state :error}))))

Return a world derived from this world by applying these rules to each cell.

+
(defn transform-world
+  [world rules]
+  (map-world world transform-cell (list rules)))

Consider this single argument as a map of :world and :rules; apply the rules + to transform the world, and return a map of the new, transformed :world and + these :rules. As a side effect, print the world.

+
(defn- transform-world-state
+  [state]
+  (let [world (transform-world (:world state) (:rules state))]
+    ;;(world/print-world world)
+    {:world world :rules (:rules state)}))

Run this world with these rules for this number of generations.

+ +
    +
  • world a world as discussed above;
    • +
  • init-rules a sequence of rules as defined above, to be run once to initialise the world;
    • +
  • rules a sequence of rules as defined above, to be run iteratively for each generation;
    • +

  • generations an (integer) number of generations.

    + +

    Return the final generation of the world.

    • +
+
(defn run-world
+  [world init-rules rules generations]
+  (reduce (fn [world _iteration]
+            (transform-world world rules))
+        (transform-world world init-rules)
+        (range generations)))
 

mw-engine.display

toc

Simple functions to allow a world to be visualised.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-engine.display
+  (:require [hiccup.core :refer [html]]
+            mw-engine.utils
+            mw-engine.world))

mw-engine: the state/transition engine of MicroWorld.

+ +

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.

+ +

Copyright (C) 2014 Simon Brooke

+
+
(defn format-css-class [state]
+  "Format this `state`, assumed to be a keyword indicating a state in the
+   world, into a CSS class"
+  (subs (str state) 1))

Render this state, assumed to be a keyword indicating a state in the + world, into a path which should recover the corresponding image file.

+
(defn format-image-path
+  [state]
+  (format "img/tiles/%s.png" (format-css-class state)))
+
(defn format-mouseover [cell]
+  (str cell))

Render this world cell as a Hiccup table cell.

+
(defn render-cell
+  [cell]
+  (let [state (:state cell)]
+    [:td {:class (format-css-class state) :title (format-mouseover cell)}
+     [:a {:href (format "inspect?x=%d&y=%d" (:x cell) (:y cell))}
+      [:img {:alt (:state cell) :width 32 :height 32 :src (format-image-path state)}]]]))

Render this world row as a Hiccup table row.

+
(defn render-world-row
+  [row]
+  (apply vector (cons :tr (map render-cell row))))

Render this world as a Hiccup table.

+
(defn render-world-table
+  [world]
+  (apply vector
+    (cons :table
+      (map render-world-row world))))
 

mw-engine.drainage

toc

Experimental, probably of no interest to anyone else; attempt to + compute drainage on a world, assumed to have altitudes already set + from a heightmap.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-engine.drainage
+  (:require [mw-engine.core :refer [run-world]]
+            [mw-engine.heightmap :as heightmap]
+            [mw-engine.utils :refer [get-int-or-zero get-least-cell get-neighbours
+                                     get-neighbours-with-property-value
+                                     map-world]]))

mw-engine: the state/transition engine of MicroWorld.

+ +

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.

+ +

Copyright (C) 2014 Simon Brooke

+
+
(def ^:dynamic *sealevel* 10)

forward declaration of flow, to allow for a wee bit of mutual recursion.

+
(declare flow)

Compute rainfall for a cell with this gradient west-east, given + remaining drops to distribute, and this overall map width.

+
(defn rainfall
+  [gradient remaining map-width]
+    (cond
+      ;; if there's no rain left in the cloud, it can't fall;
+      (zero? remaining)
+      0
+      (pos? gradient)
+      ;; rain, on prevailing westerly wind, falls preferentially on rising ground;
+      (int (rand gradient))
+      ;; rain falls randomly across the width of the map...
+      (zero? (int (rand map-width))) 1
+      :else
+      0))

Return a row like this row, across which rainfall has been distributed; + if rain-probability is specified, it is the probable rainfall on a cell + with no gradient.

+
(defn rain-row
+  ([row]
+   (rain-row row 1))
+  ([row rain-probability]
+   (rain-row row (count row) 0 (int (* (count row) rain-probability))))
+  ([row map-width previous-altitude drops-in-cloud]
+   (cond
+     (empty? row) nil
+     (pos? drops-in-cloud)
+     (let [cell (first row)
+           alt (or (:altitude cell) 0)
+           rising (- alt previous-altitude)
+           fall (rainfall rising drops-in-cloud map-width)]
+       (cons
+         (assoc cell :rainfall fall)
+         (rain-row (rest row) map-width alt (- drops-in-cloud fall))))
+     :else
+     (map
+       #(assoc % :rainfall 0)
+       row))))

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

+
(defn rain-world
+  [world]
+  (map
+    rain-row
+    world))

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

+
(defn flow-contributors
+  [cell world]
+  (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) >=))))

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

+
(defn is-hollow
+  [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 (get-int-or-zero cell :altitude)]
+    (= (count neighbours)
+       (count (get-neighbours-with-property-value
+                world (:x cell) (:y cell) 1 :altitude altitude >)))))

Raise the altitude of a copy of this cell of this world to the altitude + of the lowest of its neighbours.

+
(defn flood-hollow
+  ([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))))

Flood all local hollows in this world. At this stage only floods single + cell hollows.

+
(defn flood-hollows
+  [world]
+  (map-world world
+             #(if (is-hollow %1 %2) (flood-hollow %1 %2) %2)))
+
(def max-altitude 255)

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.

+
(defn flow-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)))})))

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.

+ +

Flow comes from a higher cell to a lower only if the lower is the lowest neighbour of the higher.

+
(def flow
+  (memoize
+   (fn [cell world]
+     (cond
+      (not (nil? (:flow cell))) cell
+      (<= (or (:altitude cell) 0) *sealevel*) cell
+      true
+      (merge cell
+             {:flow (+ (:rainfall cell)
+                       (apply +
+                              (map (fn [neighbour] (:flow (flow neighbour world)))
+                                   (flow-contributors cell world))))})))))

Experimental non-recursive flow-world algorithm

+
(defn flow-world-nr
+  [world]
+  (run-world world nil (list flow-nr) max-altitude))

Return a world like this world, but with cells tagged with the amount of + water flowing through them.

+
(defn flow-world
+  [world]
+  (map-world (rain-world world) flow))

Return a sequence of cells starting with this cell in this world which + form a contiguous lake

+
(defn explore-lake
+  [world cell])

If this cell in this world is not part of a lake, return nil. If it is, + return a cell like this cell tagged as part of a lake.

+
(defn is-lake?
+  [world cell]
+  (if
+    ;; if it's already tagged as a lake, it's a lake
+    (:lake cell) cell
+    (let
+      [outflow (min (map :altitude (get-neighbours world cell)))]
+      (if-not
+        (> (:altitude cell) outflow)
+        (assoc cell :lake true)))))
+
(defn find-lakes
+  [world])
+
(defn run-drainage
+  [hmap]
+  "Create a world from the heightmap `hmap`, rain on it, and then compute river
+   flows."
+  (flow-world (rain-world (flood-hollows (heightmap/apply-heightmap hmap)))))
 

mw-engine.heightmap

toc

Functions to apply a heightmap to a world.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-engine.heightmap
+  (:import [java.awt.image BufferedImage])
+  (:require [fivetonine.collage.util :as collage :only [load-image]]
+            [mikera.image.core :as imagez :only [filter-image get-pixels]]
+            [mikera.image.filters :as filters]
+            [mw-engine.utils :refer [abs get-int get-neighbours map-world]]
+            [mw-engine.world :refer [make-world]]))

mw-engine: the state/transition engine of MicroWorld.

+ +

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.

+ +

Copyright (C) 2014 Simon Brooke

+ +

Heightmaps are considered only as greyscale images, so colour is redundent +(will be ignored). Darker shades are higher.

+

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.

+ +
    +
  • world not actually used, but present to enable this function to be + passed as an argument to mw-engine.utils/map-world, q.v.
    • +
  • cell a cell, as discussed in world.clj, q.v. Alternatively, a map;
    • +
  • property the property (normally a keyword) whose value will be set on the cell.
    • +
  • heightmap an (ideally) greyscale image, whose x and y dimensions should + exceed those of the world of which the cell forms part.
    • +
+
(defn tag-property
+  ([world cell property heightmap]
+    (tag-property cell property heightmap))
+  ([cell property heightmap]
+    (merge cell
+           {property
+            (+ (get-int cell property)
+               (- 256
+                  (abs
+                    (mod
+                      (.getRGB heightmap
+                        (get-int cell :x)
+                        (get-int cell :y)) 256))))})))

Set the gradient property of this cell of this world to the difference in + altitude between its highest and lowest neghbours.

+
(defn tag-gradient
+  [world cell]
+  (let [heights (remove nil? (map :altitude (get-neighbours world cell)))
+        highest (cond (empty? heights) 0 ;; shouldn't happen
+                  true (apply max heights))
+        lowest (cond (empty? heights) 0 ;; shouldn't
+                 true (apply min heights))
+        gradient (- highest lowest)]
+    (merge cell {:gradient gradient})))

Set the gradient property of each cell in this world to the difference in + altitude between its highest and lowest neghbours.

+
(defn tag-gradients
+  [world]
+  (map-world world tag-gradient))

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.

+ +
    +
  • world not actually used, but present to enable this function to be + passed as an argument to mw-engine.utils/map-world, q.v.;
    • +
  • cell a cell, as discussed in world.clj, q.v. Alternatively, a map;
    • +
  • heightmap an (ideally) greyscale image, whose x and y dimensions should + exceed those of the world of which the cell forms part.
    • +
+
(defn tag-altitude
+  ([world cell heightmap]
+    (tag-property cell :altitude heightmap))
+  ([cell heightmap]
+    (tag-property cell :altitude heightmap)))

Apply the image file loaded from this path to this world, and return a world whose + altitudes are modified (added to) by the altitudes in the heightmap. It is assumed that + the heightmap is at least as large in x and y dimensions as the world. Note that, in + addition to setting the :altitude of each cell, this function also sets the :gradient.

+ +
    +
  • world a world, as defined in world.clj, q.v.; if world is not supplied, +a world the size of the heightmap will be created;
    • +
  • imagepath a file path or URL which indicates an (ideally greyscale) image file.
    • +
+
(defn apply-heightmap
+  ([world imagepath]
+    (let [heightmap (imagez/filter-image
+                      (filters/grayscale)
+                      (collage/load-image imagepath))]
+      (map-world
+        (map-world world tag-altitude (list heightmap))
+        tag-gradient)))
+   ([imagepath]
+    (let [heightmap (imagez/filter-image
+                      (filters/grayscale)
+                      (collage/load-image imagepath))
+          world (make-world (.getWidth heightmap) (.getHeight heightmap))]
+      (map-world
+        (map-world world tag-altitude (list heightmap))
+        tag-gradient))))

Generalised from apply-heightmap, set an arbitrary property on each cell + of this world from the values in this (ideally greyscale) heightmap.

+ +
    +
  • world a world, as defined in world.clj, q.v.;
    • +
  • imagepath a file path or URL which indicates an (ideally greyscale) image file;
    • +
  • property the property of each cell whose value should be added to from the + intensity of the corresponding cell of the image.
    • +
+
(defn apply-valuemap
+  [world imagepath property]
+    (let [heightmap (imagez/filter-image
+                      (filters/grayscale)
+                      (collage/load-image imagepath))]
+      (map-world world tag-property (list property heightmap))))
 

mw-engine.natural-rules

toc

A set of MicroWorld rules describing a simplified natural ecosystem.

+
(ns ^{:doc 
+       :author "Simon Brooke"}
+  mw-engine.natural-rules
+  (:require [mw-engine.utils :refer :all]
+        [mw-engine.world :refer :all]))

mw-engine: the state/transition engine of MicroWorld.

+ +

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.

+ +

Copyright (C) 2014 Simon Brooke

+ +

Since the completion of the rule language this is more or less obsolete - +there are still a few things that you can do with rules written in Clojure +that you can't do in the rule language, but not many and I doubt they're +important.

+

treeline at arbitrary altitude.

+
(def treeline 150)

waterline also at arbitrary altitude.

+
(def waterline 10)

and finally snowline is also arbitrary.

+
(def snowline 200)

Rare chance of lightning strikes

+
(def lightning-probability 500)

rules describing vegetation

+
(def vegetation-rules
+  (list
+    ;; Randomly, birds plant tree seeds into grassland.
+    (fn [cell world] (cond (and (= (:state cell) :grassland)(< (rand 10) 1))(merge cell {:state :heath})))
+    ;; heath below the treeline grows gradually into forest, providing browsing pressure is not to high
+    (fn [cell world]
+      (cond (and
+              (= (:state cell) :heath)
+              ;; browsing limit really ought to vary with soil fertility, but...
+              (< (+ (get-int cell :deer)(get-int cell :sheep)) 6)
+              (< (get-int cell :altitude) treeline))
+        (merge cell {:state :scrub})))
+    (fn [cell world] (cond (= (:state cell) :scrub) (merge cell {:state :forest})))
+    ;; Forest on fertile land grows to climax
+    (fn [cell world]
+      (cond
+        (and
+          (= (:state cell) :forest)
+          (> (get-int cell :fertility) 10))
+        (merge cell {:state :climax})))
+    ;; Climax forest occasionally catches fire (e.g. lightning strikes)
+    (fn [cell world] (cond (and (= (:state cell) :climax)(< (rand lightning-probability) 1)) (merge cell {:state :fire})))
+    ;; Climax forest neighbouring fires is likely to catch fire
+    (fn [cell world]
+      (cond
+        (and (= (:state cell) :climax)
+             (< (rand 3) 1)
+             (not (empty? (get-neighbours-with-state world (:x cell) (:y cell) 1 :fire))))
+        (merge cell {:state :fire})))
+    ;; After fire we get waste
+    (fn [cell world] (cond (= (:state cell) :fire) (merge cell {:state :waste})))
+    ;; And after waste we get pioneer species; if there's a woodland seed
+    ;; source, it's going to be heath, otherwise grassland.
+    (fn [cell world]
+      (cond
+        (and (= (:state cell) :waste)
+             (not
+               (empty?
+                 (flatten
+                   (list
+                     (get-neighbours-with-state world (:x cell) (:y cell) 1 :scrub)
+                     (get-neighbours-with-state world (:x cell) (:y cell) 1 :forest)
+                     (get-neighbours-with-state world (:x cell) (:y cell) 1 :climax))))))
+        (merge cell {:state :heath})))
+    (fn [cell world]
+      (cond (= (:state cell) :waste)
+        (merge cell {:state :grassland})))
+    ;; Forest increases soil fertility
+    (fn [cell world]
+      (cond (member? (:state cell) '(:forest :climax))
+        (merge cell {:fertility (+ (get-int cell :fertility) 1)})))))

rules describing herbivore behaviour

+
(def herbivore-rules
+  (list
+    ;; if there are too many deer for the fertility of the area to sustain,
+    ;; some die or move on.
+    (fn [cell world]
+      (cond (> (get-int cell :deer) (get-int cell :fertility))
+        (merge cell {:deer (get-int cell :fertility)})))
+    ;; deer arrive occasionally at the edge of the map.
+    (fn [cell world]
+      (cond (and (< (count (get-neighbours world cell)) 8)
+                 (< (rand 50) 1)
+                 (> (get-int cell :fertility) 0)
+                 (= (get-int cell :deer) 0))
+        (merge cell {:deer 2})))
+    ;; deer gradually spread through the world by breeding or migrating.
+    (fn [cell world]
+      (let [n (apply + (map #(get-int % :deer) (get-neighbours world cell)))]
+        (cond (and
+                (> (get-int cell :fertility) 0)
+                (= (get-int cell :deer) 0)
+                (>= n 2))
+          (merge cell {:deer (int (/ n 2))}))))
+    ;; deer breed.
+    (fn [cell world]
+      (cond
+        (>= (get-int cell :deer) 2)
+        (merge cell {:deer (int (* (:deer cell) 2))})))))

rules describing predator behaviour

+
  (def predator-rules
+    (list
+     ;; wolves eat deer
+     (fn [cell world]
+      (cond
+       (>= (get-int cell :wolves) 1)
+       (merge cell {:deer (max 0 (- (get-int cell :deer) (get-int cell :wolves)))})))
+;;      ;; not more than eight wolves in a pack, for now (hack because wolves are not dying)
+;;      (fn [cell world]
+;;        (cond (> (get-int cell :wolves) 8) (merge cell {:wolves 8})))
+    ;; if there are not enough deer to sustain the get-int of wolves,
+    ;; some wolves die or move on. (doesn't seem to be working?)
+    (fn [cell world]
+       (cond (> (get-int cell :wolves) (get-int cell :deer))
+         (merge cell {:wolves 0})))
+    ;; wolves arrive occasionally at the edge of the map.
+    (fn [cell world]
+      (cond (and (< (count (get-neighbours world cell)) 8)
+                 (< (rand 50) 1)
+                 (not (= (:state cell) :water))
+                 (= (get-int cell :wolves) 0))
+        (merge cell {:wolves 2})))
+    ;; wolves gradually spread through the world by breeding or migrating.
+    (fn [cell world]
+      (let [n (apply + (map #(get-int % :wolves) (get-neighbours world cell)))]
+        (cond (and
+                (not (= (:state cell) :water))
+                (= (get-int cell :wolves) 0)
+                (>= n 2))
+          (merge cell {:wolves 2}))))
+    ;; wolves breed.
+    (fn [cell world]
+      (cond
+        (>= (get-int cell :wolves) 2)
+        (merge cell {:wolves (int (* (:wolves cell) 2))})))))

rules which initialise the world

+
  (def init-rules
+    (list
+     ;; below the waterline, we have water.
+     (fn [cell world]
+       (cond (and (= (:state cell) :new) (< (get-int cell :altitude) waterline)) (merge cell {:state :water})))
+     ;; above the snowline, we have snow.
+     (fn [cell world]
+       (cond (and (= (:state cell) :new) (> (get-int cell :altitude) snowline)) (merge cell {:state :snow})))
+     ;; in between, we have a wasteland.
+     (fn [cell world] (cond (= (:state cell) :new) (merge cell {:state :grassland})))))
+
(def natural-rules (flatten
+                    (list
+                     vegetation-rules
+                     herbivore-rules
+                     predator-rules)))
 

mw-engine.utils

toc

Utility functions needed by MicroWorld and, specifically, in the + interpretation of MicroWorld rule.

+
(ns ^{:doc 
+      :author "Simon Brooke"}
+  mw-engine.utils
+  (:require
+    [clojure.math.combinatorics :as combo]))

mw-engine: the state/transition engine of MicroWorld.

+ +

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.

+ +

Copyright (C) 2014 Simon Brooke

+

Surprisingly, Clojure doesn't seem to have an abs function, or else I've + missed it. So here's one of my own. Maps natural numbers onto themselves, + and negative integers onto natural numbers. Also maps negative real numbers + onto positive real numbers.

+ +
    +
  • n a number, on the set of real numbers.
    • +
+
(defn abs
+  [n]
+  (if (neg? n) (- 0 n) n))

True if elt is a member of col.

+
(defn member?
+  [elt col] (some #(= elt %) col))

Return the value of this property from this map if it is a integer; + otherwise return zero.

+
(defn get-int-or-zero
+  [map property]
+  (let [value (map property)]
+    (if (integer? value) value 0)))

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.

+
(defn init-generation
+  [world cell]
+  (merge cell {:generation (get-int-or-zero cell :generation)}))

True if x, y are in bounds for this world (i.e., there is a cell at x, y) + else false.

+ +
    +
  • world a world as defined above;
    • +
  • x a number which may or may not be a valid x coordinate within that world;
    • +
  • y a number which may or may not be a valid y coordinate within that world.
    • +
+
(defn in-bounds
+  [world x y]
+  (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world)))))

Wholly non-parallel map world implementation; see documentation for map-world.

+
(defn map-world-n-n
+  ([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))))

Wholly parallel map-world implementation; see documentation for map-world.

+
(defn map-world-p-p
+  ([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))))

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 + running rows in parallel.

+
(defn map-world
+  ([world function]
+    (map-world world function nil))
+  ([world function additional-args]
+    (into []
+           (pmap (fn [row]
+                    (into [] (map
+                             #(apply function
+                                     (cons world (cons % additional-args)))
+                             row)))
+                  world))))

Return the cell a x, y in this world, if any.

+ +
    +
  • world a world as defined above;
    • +
  • x a number which may or may not be a valid x coordinate within that world;
    • +
  • y a number which may or may not be a valid y coordinate within that world.
    • +
+
(defn get-cell
+  [world x y]
+  (cond (in-bounds world x y)
+    (nth (nth world y) x)))

Get the value of a property expected to be an integer from a map; if not present (or not an integer) return 0.

+ +
    +
  • map a map;
    • +
  • key a symbol or keyword, presumed to be a key into the map.
    • +
+
(defn get-int
+  [map key]
+  (cond (map? map)
+    (let [v (map key)]
+      (cond (and v (integer? v)) v
+            true 0))
+        true (throw (Exception. "No map passed?"))))

Return the population of this species in this cell. Currently a synonym for + get-int, but may not always be (depending whether species are later + implemented as actors)

+ +
    +
  • cell a map;
    • +
  • species a keyword representing a species which may populate that cell.
    • +
+
(defn population
+  [cell species]
+  (get-int cell species))

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.

+
(def memo-get-neighbours
+  (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)))))))))

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
+Gets the neighbours within the specified distance of the cell at
+coordinates [x,y] in this world.
+
+
(defn 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]
+      (memo-get-neighbours world (:x cell) (:y cell) depth))
+    ([world cell]
+      (get-neighbours world cell 1)))

Get the neighbours to distance depth of the cell at x, y in this world which + have this value for this property.

+ +
* `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 (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 `=` (optional).
+
+ +

It gets messy.

+
(defn get-neighbours-with-property-value
+  ([world x y depth property value op]
+    (filter
+      #(eval
+         (list op
+               (or (get % property) (get-int % property))
+               value))
+      (get-neighbours world x y depth)))
+  ([world x y depth property value]
+    (get-neighbours-with-property-value world x y depth property value =))
+  ([world cell depth property value]
+    (get-neighbours-with-property-value world (:x cell) (:y cell) depth
+                                        property value))
+  ([world cell property value]
+    (get-neighbours-with-property-value world cell 1
+                                        property value)))

Get the neighbours to distance depth of the cell at x, y in this world which + have this state.

+ +
* `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;
+* `state` a keyword representing a state in the world.
+
+
(defn get-neighbours-with-state
+  ([world x y depth state]
+    (filter #(= (:state %) state) (get-neighbours world x y depth)))
+  ([world cell depth state]
+    (get-neighbours-with-state world (:x cell) (:y cell) depth state))
+  ([world cell state]
+    (get-neighbours-with-state world cell 1 state)))

Return the cell from among these cells which has the lowest numeric value + for this property; if the property is absent or not a number, use this + default

+
(defn get-least-cell
+  ([cells property default]
+  (cond
+   (empty? cells) nil
+   true (let [downstream (get-least-cell (rest cells) property default)]
+          (cond (<
+                 (or (property (first cells)) default)
+                 (or (property downstream) default)) (first cells)
+                true downstream))))
+  ([cells property]
+   (get-least-cell cells property (Integer/MAX_VALUE))))

If this cells x and y properties are equal to these x and y values, + return a cell like this cell but with the value of this property set to + this value. Otherwise, just return this cell.

+
(defn- set-cell-property
+  [cell x y property value]
+  (cond
+    (and (= x (:x cell)) (= y (:y cell)))
+    (merge cell {property value :rule "Set by user"})
+    true
+    cell))

Return a world like this world but with the value of exactly one property + of one cell changed to this value

+
(defn set-property
+  ([world cell property value]
+    (set-property world (:x cell) (:y cell) property value))
+  ([world x y property value]
+    (apply
+      vector ;; we want a vector of vectors, not a list of lists, for efficiency
+      (map
+        (fn [row]
+          (apply
+            vector
+            (map #(set-cell-property % x y property value)
+                 row)))
+        world))))

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

+
(defn merge-cell
+  [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))
 

mw-engine.world

toc

Functions to create and to print two dimensional cellular automata.

+
(ns ^{:doc 
+       :author "Simon Brooke"}
+  mw-engine.world
+	(:require [clojure.string :as string :only [join]]
+            [mw-engine.utils :refer [population]]))

mw-engine: the state/transition engine of MicroWorld.

+ +

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.

+ +

Copyright (C) 2014 Simon Brooke

+ +

Functions to create and to print two dimensional cellular automata. +Nothing in this namespace should determine what states are possible within +the automaton, except for the initial state, :new.

+ +

A cell is a map containing at least values for the keys :x, :y, and :state.

+ +

A world is a two dimensional matrix (sequence of sequences) of cells, such +that every cell's :x and :y properties reflect its place in the matrix.

+

Create a minimal default cell at x, y

+ +
    +
  • x the x coordinate at which this cell is created;
    • +
  • y the y coordinate at which this cell is created.
    • +
+
(defn- make-cell
+  [x y]
+  {:x x :y y :state :new})

Make the (remaining) cells in a row at this height in a world of this width.

+ +
    +
  • index x coordinate of the next cell to be created;
    • +
  • width total width of the matrix, in cells;
    • +
  • height y coordinate of the next cell to be created.
    • +
+
(defn- make-world-row
+  [index width height]
+  (cond (= index width) nil
+    true (cons (make-cell index height)
+               (make-world-row (inc index) width height))))

Make the (remaining) rows in a world of this width and height, from this + index.

+ +
    +
  • index y coordinate of the next row to be created;
    • +
  • width total width of the matrix, in cells;
    • +
  • height total height of the matrix, in cells.
    • +
+
(defn- make-world-rows
+  [index width height]
+  (cond (= index height) nil
+    true (cons (apply vector (make-world-row 0 width index))
+               (make-world-rows (inc index) width height))))

Make a world width cells from east to west, and height cells from north to + south.

+ +
    +
  • width a natural number representing the width of the matrix to be created;
    • +
  • height a natural number representing the height of the matrix to be created.
    • +
+
(defn make-world
+  [width height]
+  (apply vector (make-world-rows 0 width height)))

Truncate the print name of the state of this cell to at most limit characters.

+
(defn truncate-state
+  [cell limit]
+  (let [s (:state cell)]
+    (cond (> (count (str s)) limit) (subs s 0 limit)
+      true s)))

Return a formatted string summarising the current state of this cell.

+
(defn format-cell
+  [cell]
+  (format "%10s(%2d/%2d)"
+          (truncate-state cell 10)
+          (population cell :deer)
+          (population cell :wolves)))

Format one row in the state of a world for printing.

+
(defn- format-world-row
+  [row]
+  (string/join (map format-cell row)))

Print the current state of this world, and return nil.

+ +
    +
  • world a world as defined above.
    • +
+
(defn print-world
+  [world]
+  (println)
+  (dorun
+    (map
+      #(println
+         (format-world-row %))
+      world))
+  nil)
 
Generated by Marginalia.  Syntax highlighting provided by Alex Gorbatchev's SyntaxHighlighter
\ No newline at end of file diff --git a/project.clj b/project.clj index 70cfad8..383341f 100644 --- a/project.clj +++ b/project.clj @@ -12,10 +12,11 @@ :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.6.0"] + :dependencies [[org.clojure/clojure "1.8.0"] [org.clojure/math.combinatorics "0.0.7"] [org.clojure/tools.trace "0.7.8"] [org.clojure/tools.namespace "0.2.4"] + [com.taoensso/timbre "4.10.0"] + [fivetonine/collage "0.2.0"] [hiccup "1.0.5"] - [net.mikera/imagez "0.3.1"] - [fivetonine/collage "0.2.0"]]) + [net.mikera/imagez "0.3.1"]]) diff --git a/src/mw_engine/core.clj b/src/mw_engine/core.clj index 83c1a2e..8b5062e 100644 --- a/src/mw_engine/core.clj +++ b/src/mw_engine/core.clj @@ -2,8 +2,11 @@ :author "Simon Brooke"} mw-engine.core (:require [clojure.core.reducers :as r] + [clojure.string :refer [join]] + [clojure.tools.cli :refer [parse-opts]] [mw-engine.world :as world] - [mw-engine.utils :refer [get-int-or-zero map-world]]) + [mw-engine.utils :refer [get-int-or-zero map-world]] + [taoensso.timbre :as l]) (:gen-class)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -123,9 +126,11 @@ Return the final generation of the world." [world init-rules rules generations] - (reduce (fn [world _iteration] + (reduce (fn [world iteration] + (l/info "Running iteration " iteration) (transform-world world rules)) (transform-world world init-rules) (range generations))) + diff --git a/src/mw_engine/display.clj b/src/mw_engine/display.clj index 7dca8ff..8cddd11 100644 --- a/src/mw_engine/display.clj +++ b/src/mw_engine/display.clj @@ -28,6 +28,10 @@ ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def ^:dynamic *image-base* + "Base url (i.e., url of directory) from which to load tile images." + "img/tiles") + (defn format-css-class [state] "Format this `state`, assumed to be a keyword indicating a state in the world, into a CSS class" @@ -38,7 +42,7 @@ "Render this `state`, assumed to be a keyword indicating a state in the world, into a path which should recover the corresponding image file." [state] - (format "img/tiles/%s.png" (format-css-class state))) + (format "%s/%s.png" *image-base* (format-css-class state))) (defn format-mouseover [cell] diff --git a/src/mw_engine/drainage.clj b/src/mw_engine/drainage.clj index 87a7207..603bf89 100644 --- a/src/mw_engine/drainage.clj +++ b/src/mw_engine/drainage.clj @@ -38,11 +38,54 @@ ;; forward declaration of flow, to allow for a wee bit of mutual recursion. (declare flow) +(defn rainfall + "Compute rainfall for a cell with this `gradient` west-east, given + `remaining` drops to distribute, and this overall map width." + [gradient remaining map-width] + (cond + ;; if there's no rain left in the cloud, it can't fall; + (zero? remaining) + 0 + (pos? gradient) + ;; rain, on prevailing westerly wind, falls preferentially on rising ground; + (int (rand gradient)) + ;; rain falls randomly across the width of the map... + (zero? (int (rand map-width))) 1 + :else + 0)) + +(defn rain-row + "Return a row like this `row`, across which rainfall has been distributed; + if `rain-probability` is specified, it is the probable rainfall on a cell + with no gradient." + ([row] + (rain-row row 1)) + ([row rain-probability] + (rain-row row (count row) 0 (int (* (count row) rain-probability)))) + ([row map-width previous-altitude drops-in-cloud] + (cond + (empty? row) nil + (pos? drops-in-cloud) + (let [cell (first row) + alt (or (:altitude cell) 0) + rising (- alt previous-altitude) + fall (rainfall rising drops-in-cloud map-width)] + (cons + (assoc cell :rainfall fall) + (rain-row (rest row) map-width alt (- drops-in-cloud fall)))) + :else + (map + #(assoc % :rainfall 0) + row)))) + + (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" [world] - (map-world world (fn [world cell] (merge cell {:rainfall 1})))) + (map + rain-row + world)) (defn flow-contributors @@ -143,6 +186,29 @@ [world] (map-world (rain-world world) flow)) +(defn explore-lake + "Return a sequence of cells starting with this `cell` in this `world` which + form a contiguous lake" + [world cell] + ) + +(defn is-lake? + "If this `cell` in this `world` is not part of a lake, return nil. If it is, + return a cell like this `cell` tagged as part of a lake." + [world cell] + (if + ;; if it's already tagged as a lake, it's a lake + (:lake cell) cell + (let + [outflow (min (map :altitude (get-neighbours world cell)))] + (if-not + (> (:altitude cell) outflow) + (assoc cell :lake true))))) + + +(defn find-lakes + [world] + ) (defn run-drainage [hmap] diff --git a/src/mw_engine/natural_rules.clj b/src/mw_engine/natural_rules.clj index af4a124..86de92b 100644 --- a/src/mw_engine/natural_rules.clj +++ b/src/mw_engine/natural_rules.clj @@ -1,8 +1,8 @@ (ns ^{:doc "A set of MicroWorld rules describing a simplified natural ecosystem." :author "Simon Brooke"} mw-engine.natural-rules - (:require mw-engine.utils - mw-engine.world)) + (:require [mw-engine.utils :refer :all] + [mw-engine.world :refer :all])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;