dependencies

org.clojure/clojure		1.11.1
org.clojure/clojurescript		1.11.60
org.clojure/math.combinatorics		0.2.0
org.clojure/tools.trace		0.7.11
org.clojure/tools.namespace		1.4.4
com.taoensso/timbre		6.2.1
fivetonine/collage		0.3.0
hiccup		1.0.5
net.mikera/imagez		0.12.0

(this space intentionally left almost blank)

namespaces

mw-engine.display
mw-engine.heightmap
mw-engine.natural-rules
mw-engine.utils
mw-engine.flow
mw-engine.core
mw-engine.world
mw-engine.drainage
mw-engine.core

mw-engine.display

toc

Simple functions to allow a world to be visualised.

(ns ^{:doc 
      :author "Simon Brooke"}
  mw-engine.display)

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.

Base url (i.e., url of directory) from which to load tile images.

(def ^:dynamic *image-base*
  "img/tiles")

Format this state, assumed to be a keyword indicating a state in the world, into a CSS class

(defn format-css-class
  [state]
  (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 "%s/%s.png" *image-base* (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.heightmap

toc

Functions to apply a heightmap to a world.

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

(ns ^{:doc 
      :author "Simon Brooke"}
  mw-engine.heightmap
  (:require [mikera.image.core :refer [load-image filter-image]]
            [mikera.image.filters :as filters]
            [mw-engine.utils :refer [get-int get-neighbours map-world]]
            [mw-engine.world :refer [make-world]]))

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

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
  ([_ 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
                  :else (apply max heights))
        lowest (cond (empty? heights) 0 ;; shouldn't
                 :else (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
  ([_ 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 (filter-image
                     (load-image imagepath)
                      (filters/grayscale))]
      (map-world
        (map-world world tag-altitude (list heightmap))
        tag-gradient)))
   ([imagepath]
    (let [heightmap (filter-image
                      (load-image imagepath)
                      (filters/grayscale))
          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 (filter-image
                      (load-image imagepath)
                      (filters/grayscale))]
      (map-world world tag-property (list property heightmap))))

mw-engine.natural-rules

toc

A set of MicroWorld rules describing a simplified natural ecosystem.

        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.

(ns ^{:doc 
       :author " Simon Brooke "}
  mw-engine.natural-rules
  (:require [mw-engine.utils :refer [get-int get-neighbours get-neighbours-with-state member?]]))

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

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 _] (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 _]
      (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 _] (cond (= (:state cell) :scrub) (merge cell {:state :forest})))
    ;; Forest on fertile land grows to climax
    (fn [cell _]
      (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 _] (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 _] (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 _]
      (cond (= (:state cell) :waste)
        (merge cell {:state :grassland})))
    ;; Forest increases soil fertility
    (fn [cell _]
      (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 _]
      (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 _]
      (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 _]
      (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 _]
       (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 _]
      (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 _]
       (cond (and (= (:state cell) :new) (< (get-int cell :altitude) waterline)) (merge cell {:state :water})))
     ;; above the snowline, we have snow.
     (fn [cell _]
       (cond (and (= (:state cell) :new) (> (get-int cell :altitude) snowline)) (merge cell {:state :snow})))
     ;; in between, we have a wasteland.
     (fn [cell _] (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.

Return 'true' if elt is a member of col, else 'false'.

(defn member?
  [elt col] (boolean ((set col) elt)))

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
  [_ 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. DEPRECATED: it's a predicate, prefer in-bounds?.

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
  {:deprecated "1.1.7"}
  [world x y]
  (and (>= x 0) (>= y 0) (< y (count world)) (< x (count (first world)))))

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?
  {:added "1.1.7"}
  [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]
  (when (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]
  (if (map? map)
    (let [v (map key)]
      (cond (and v (integer? v)) v
            :else 0))
    (throw (Exception. "No map passed?"))))

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

map a map;
key a symbol or keyword, presumed to be a key into the map.

(defn get-num
  [map key]
  (if (map? map)
    (let [v (map key)]
      (cond (and v (number? v)) v
            :else 0))
    (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]
   (memo-get-neighbours world x y depth))
  ([world cell depth]
   (memo-get-neighbours world (:x cell) (:y cell) depth))
  ([world cell]
   (memo-get-neighbours world (:x cell) (:y 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.

(defn get-least-cell
  [cells property]
  (first (sort-by property (filter #(number? (property %)) cells))))

Return the cell from among these cells which has the highest numeric value for this property.

(defn get-most-cell
  [cells property]
  (last (sort-by property (filter #(number? (property %)) cells))))

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"})
    :else 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.flow

toc

Allow flows of values between cells in the world.

The design here is: a flow object is a map with the following properties: 1. :source, whose value is a location; 2. :destination, whose value is a location; 3. :property, whose value is a keyword; 4. :quantity, whose value is a positive real number.

A location object is a map with the following properties: 1. :x, whose value is a natural number not greater than the extent of the world; 2. :y, whose value is a natural number not greater than the extent of the world.

To execute a flow is transfer the quantity specified of the property specified from the cell at the source specified to the cell at the destination specified; if the source doesn't have sufficient of the property, then all it has should be transferred, but no more: properties to be flowed cannot be pulled negative.

Flowing values through the world is consequently a two stage process: firstly there's a planning stage, in which all the flows to be executed are computed without changing the world, and then an execution stage, where they're all executed. This namespace deals with mainly with execution.

(ns mw-engine.flow
  (:require [mw-engine.utils :refer [get-cell get-num in-bounds? merge-cell]]
            [taoensso.timbre :refer [info warn]]))

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

Return true if this object o is a valid coordinate with respect to this world, else false. Assumes square worlds.

(defn coordinate?
  [o world]
  (try
    (and (or (zero? o) (pos-int? o))
         (< o (count world)))
    (catch Exception e
      (warn (format "Not a valid coordinate: %s; %s" o (.getMessage e)))
      false)))

Return true if this object o is a location as defined above with respect to this world, else false.

(defn location?
  [o world]
  (try
    (and (map? o)
         (integer? (:x o))
         (integer? (:y o))
         (in-bounds? world (:x o) (:y o)))
    (catch Exception e
      (warn (format "Not a valid location: %s; %s" o (.getMessage e)))
      false)))

Return true if this object o is a flow as defined above with respect to this world, else false. Assumes square worlds.

(defn flow?
  [o world]
  (try
    (and (map? o)
         (location? (:source o) world)
         (location? (:destination o) world)
         (keyword? (:property o))
         (pos? (:quantity o)))
    (catch Exception e
      (warn (format "Not a valid flow: %s; %s" o (.getMessage e)))
      false)))

Return a world like this world, except with the quantity of the property described in this flow object transferred from the source of that flow to its destination.

(defn execute
  [world flow]
  (try
    (let [sx (-> flow :source :x)
          sy (-> flow :source :y)
          source (get-cell world sx sy)
          dx (-> flow :destination :x)
          dy (-> flow :destination :y)
          dest (get-cell world dx dy)
          p (:property flow)
          q (min (:quantity flow) (get-num source p))
          s' (assoc source p (- (source p) q))
          d' (assoc dest p (+ (get-num dest p) q))]
      (info (format "Moving %f units of %s from %d,%d to %d,%d"
                    (float q) (name p) sx sy dx dy))
      (merge-cell (merge-cell world s') d'))
    (catch Exception e
      (warn (format "Failed to execute flow %s: %s" flow (.getMessage e)))
      ;; return the world unmodified.
      world)))

Return a world like this world, but with each of these flows executed.

(defn execute-flows
  [world flows]
  (reduce execute world (filter #(flow? % world) flows)))

mw-engine.core

toc

Functions to transform a world and run rules.

        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 to that cell.

(ns ^{:doc 
      :author "Simon Brooke"}
 mw-engine.core
  (:require [mw-engine.utils :refer [get-int-or-zero map-world]]
            [taoensso.timbre :as l]))

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

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})
       :else result))))

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

(defn- apply-rules
  [world cell rules]
  (cond (empty? rules) cell
        :else (let [result (apply-rule world cell (first rules))]
                (cond result result
                      :else (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))))

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]
            (l/info "Running iteration " iteration)
            (transform-world world rules))
          (transform-world world init-rules)
          (range generations)))

mw-engine.world

toc

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.

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

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

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.

(defmacro make-cell
  [x y]
  `{:x ~x :y ~y :state :new})

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
         (map (fn [h]
                (apply vector (map #(make-cell % h) (range width))))
              (range 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)
          :else 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)

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.

(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]
  (when (= (- 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
      :else
      (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 (apply min (map :altitude (get-neighbours world cell)))]
      (when-not
        (> (:altitude cell) outflow)
        (assoc cell :lake true)))))

(defn find-lakes
  [world])

Create a world from the heightmap hmap, rain on it, and then compute river flows.

(defn run-drainage
  [hmap]
  (flow-world (rain-world (flood-hollows (heightmap/apply-heightmap hmap)))))

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]
            [clojure.string :refer [join]]
            [mw-engine.world :as world]
            [mw-engine.utils :refer [get-int-or-zero map-world]]
            [taoensso.timbre :as l]))

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

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.

(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]
            (l/info "Running iteration " iteration)
            (transform-world world rules))
        (transform-world world init-rules)
        (range generations)))

mw-engine

0.2.0-SNAPSHOT

dependencies

namespaces

mw-engine.display

mw-engine.heightmap

mw-engine.natural-rules

mw-engine.utils

mw-engine.flow

mw-engine.core

mw-engine.world

mw-engine.drainage

mw-engine.core