dependencies

org.clojure/clojure		1.5.1
org.clojure/math.combinatorics		0.0.7
org.clojure/tools.trace		0.7.8
net.mikera/imagez		0.3.1
fivetonine/collage		0.2.1

(this space intentionally left almost blank)

namespaces

mw-engine.core
mw-engine.heightmap
mw-engine.natural-rules
mw-engine.utils
mw-engine.world

mw-engine.core

toc

Functions to transform a world and run rules.

(ns mw-engine.core
  (:require [mw-engine.world :as world]
            mw-engine.utils))

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.

(defn apply-rule 
  ([cell world rule]
   (cond
     (ifn? rule) (apply-rule cell world rule nil)
     (seq? rule) (let [[afn src] rule] (apply-rule cell world afn src))))
  ([cell world 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
  [cell world rules]
  (cond (empty? rules) cell
    true (let [result (apply-rule cell world (first rules))]
           (cond result result
             true (apply-rules cell world (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 state to error

(defn- transform-cell
  [cell world rules]
  (try
    (merge 
      (apply-rules cell world rules) 
      {:generation (+ (or (:generation cell) 0) 1)})
    (catch Exception e 
      (merge cell {:error 
                   (format "%s at generation %d when in state %s"
                           (.getMessage e)
                           (:generation cell)
                           (:state cell))}))))

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

(defn- transform-world-row
  [row world rules]
  (apply vector (map #(transform-cell % world rules) row)))

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

(defn transform-world
  [world rules]
  (apply vector 
          (map
            #(transform-world-row % world rules)
            world)))

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 definied above, to be run iteratively for each generation;
generations an (integer) number of generations.

(defn run-world
  [world init-rules rules generations]
  (let [state {:world (transform-world world init-rules) :rules rules}]
    (take generations (iterate transform-world-state state))))

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 mw-engine.heightmap
  (:import [java.awt.image BufferedImage])
  (:use mw-engine.utils
        mw-engine.world
        ;; interestingly the imagez load-image is failing for me, while the
        ;; collage version is problem free.
        [mikera.image.core :only [filter-image get-pixels]]
        [mikera.image.filters]
        [fivetonine.collage.util]))

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]
  (cond (< n 0) (- 0 n) true n))

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.

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 transform-altitude
  [cell heightmap]
  (merge cell
         {:altitude
          (+ (get-int cell :altitude)
           (- 256
              (abs
               (mod
                (.getRGB heightmap
                         (get-int cell :x)
                         (get-int cell :y)) 256))))}))

Set the altitude of each cell in this sequence from the corresponding pixel of this heightmap. If the heightmap you supply is smaller than the world, this will break.

row a row in a world, as discussed in world.clj, q.v. Alternatively, a sequence of maps;
heightmap an (ideally) greyscale image, whose x and y dimensions should exceed those of the world of which the cell forms part.

(defn- apply-heightmap-row
  [row heightmap]
  (apply vector (map #(transform-altitude % heightmap) row)))

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.

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 image file.

(defn apply-heightmap
  ([world imagepath]
  ;; bizarrely, the collage load-util is working for me, but the imagez version isn't.
    (let [heightmap (filter-image (grayscale)(load-image imagepath))]
      (apply vector (map #(apply-heightmap-row % heightmap) world))))
  ([imagepath]
    (let [heightmap (filter-image (grayscale)(load-image imagepath))
          world (make-world (.getWidth heightmap) (.getHeight heightmap))]
      (apply vector (map #(apply-heightmap-row % heightmap) world)))))

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 mw-engine.natural-rules
  (:use mw-engine.utils
        mw-engine.world))

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 mw-engine.utils
  (:require [clojure.math.combinatorics :as combo]))

True if elt is a member of col.

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

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)))))

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))

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

* `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.

(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] 
      "Get the neighbours to distance depth of this cell in this world.
      * `world` a world, as described in world.clj;
      * `cell` a cell within that world;
      * `depth` an integer representing the distance from [x,y] that
        should be searched."
      (get-neighbours world (:x cell) (:y cell) depth))
    ([world cell]
      "Get the immediate neighbours of this cell in this world
      * `world` a world, as described in world.clj;
      * `cell` a cell within that world."
      (get-neighbours world cell 1)))

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;
* `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 `=`.

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)))

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})
    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))))

mw-engine.world

toc

Functions to create and to print two dimensional cellular automata. Nothing in this file 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 mw-engine.world
  (:use mw-engine.utils))

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 (+ index 1) width height))))

(defn- make-world-rows [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."
  (cond (= index height) nil
    true (cons (apply vector (make-world-row 0 width index))
               (make-world-rows (+ index 1) 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 (.toString s)) 10) (subs s 0 10)
      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]
  (apply str
         (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

0.1.1-SNAPSHOT