mw-engine0.1.2-SNAPSHOTCellular automaton world builder. -dependencies
| (this space intentionally left almost blank) | ||||||||||||
Functions to transform a world and run rules. - | |||||||||||||
| - | (ns mw-engine.core - (:use mw-engine.utils) - (:require [mw-engine.world :as world])) | ||||||||||||
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 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 Each time the world is transformed (see | |||||||||||||
Apply a single | (defn apply-rule
- ([world cell 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 | (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 | (defn- transform-cell
- [world cell rules]
- (try
- (merge
- (apply-rules world cell 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))
- :state :error})))) | ||||||||||||
Return a world derived from this | (defn transform-world - [world rules] - (map-world world transform-cell (list rules))) | ||||||||||||
Consider this single argument as a map of | (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. - -
| (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)))) | ||||||||||||
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 - [mikera.image.core :only [load-image filter-image get-pixels]] - [mikera.image.filters])) | ||||||||||||
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. - -
| (defn- abs - [n] - (cond (< n 0) (- 0 n) true n)) | ||||||||||||
Set the | (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 | (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. - -
| (defn tag-altitude
- ([world cell heightmap]
- (tag-altitude cell heightmap))
- ([cell heightmap]
- (merge cell
- {:altitude
- (+ (get-int cell :altitude)
- (- 256
- (abs
- (mod
- (.getRGB heightmap
- (get-int cell :x)
- (get-int cell :y)) 256))))}))) | ||||||||||||
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. - -
| (defn apply-heightmap - ([world imagepath] - (let [heightmap (filter-image (grayscale)(load-image imagepath))] - (map-world - (map-world world tag-altitude (list heightmap)) - tag-gradient))) - ([imagepath] - (let [heightmap (filter-image (grayscale)(load-image imagepath)) - world (make-world (.getWidth heightmap) (.getHeight heightmap))] - (map-world - (map-world world tag-altitude (list heightmap)) - tag-gradient)))) | ||||||||||||
manifest.clj: a mechanism - | (ns mw-engine.manifest) | ||||||||||||
| - | (def manifest {
- :build-signature {
- :build-signture-version "0.1.2-SNAPSHOT"
- :build-signature-user "unset"
- :build-signature-email "unset"
- :build-signature-timestamp "unset"
- ;; NOTE: it's important that the closing brace not be on the same
- ;; line as the build-signature fields, because of how the buildall
- ;; script constructs the build signature.
- }
- }) | ||||||||||||
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))) | ||||||||||||
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. - -
| (defn in-bounds - [world x y] - (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world))))) | ||||||||||||
Apply this | (defn map-world - ([world function] - (map-world world function nil)) - ([world function additional-args] - (apply vector ;; vectors are more efficient for scanning, which we do a lot. - (for [row world] - (apply vector - (map #(apply function (cons world (cons % additional-args))) - row)))))) | ||||||||||||
Return the cell a x, y in this world, if any. - -
| (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. - -
| (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
-
| (defn population - [cell species] - (get-int cell species)) | ||||||||||||
Get the neighbours to distance depth of the cell at 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] - "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. - -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. - - | (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 | (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 | (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)))) | ||||||||||||
| - | (ns mw-engine.version - (:gen-class)) | ||||||||||||
Get the implementation version from the package of this namespace, which must - be compiled into a class (see clojure.java.interop) - | (defn get-implementation-version - [namespace-class] - (.getImplementationVersion (.getPackage namespace-class))) | ||||||||||||
| - | (defn -main [] - (get-implementation-version (eval 'mw-engine.version))) | ||||||||||||
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 - -
| (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. - -
| (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. - -
| (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. - -
| (defn print-world - [world] - (println) - (dorun - (map - #(println - (format-world-row %)) - world)) - nil) | ||||||||||||