mw-engine0.1.6-SNAPSHOTCellular automaton world builder. +dependencies
| (this space intentionally left almost blank) | |||||||||||||||||||||
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 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 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 | (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 (+ (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 | (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] + (reduce (fn [world _iteration] + (transform-world world rules)) + (transform-world world init-rules) + (range generations))) | |||||||||||||||||||||
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 | (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 | (defn render-world-row + [row] + (apply vector (cons :tr (map render-cell row)))) | |||||||||||||||||||||
Render this | (defn render-world-table + [world] + (apply vector + (cons :table + (map render-world-row world)))) | |||||||||||||||||||||
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 | (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 | (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 | (defn rain-world + [world] + (map + rain-row + world)) | |||||||||||||||||||||
Return a list of the cells in this | (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 | (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 | (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 | (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
+ | (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 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 | (defn flow-world + [world] + (map-world (rain-world world) flow)) | |||||||||||||||||||||
Return a sequence of cells starting with this | (defn explore-lake + [world cell]) | |||||||||||||||||||||
If this | (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))))) | |||||||||||||||||||||
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
| (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 | (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-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
| (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
| (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)))) | |||||||||||||||||||||
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))) | |||||||||||||||||||||
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. + +
| (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 | (defn get-int-or-zero + [map property] + (let [value (map property)] + (if (integer? value) value 0))) | |||||||||||||||||||||
Return a cell like this | (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. + +
| (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 | (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 | (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 | (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. + +
| (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)) | |||||||||||||||||||||
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. + + | (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. + +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))) | |||||||||||||||||||||
Return the cell from among these | (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 | (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)))) | |||||||||||||||||||||
Return a world like this | (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)) | |||||||||||||||||||||
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 + +
| (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 (inc index) width height)))) | |||||||||||||||||||||
Make the (remaining) rows in a world of this width and height, from this + index. + +
| (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. + +
| (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. + +
| (defn print-world + [world] + (println) + (dorun + (map + #(println + (format-world-row %)) + world)) + nil) | |||||||||||||||||||||