1: Preparation for conversion to CLJC. Doesn't yet fully work but that seems
to be due to a breaking change in a library.
This commit is contained in:
parent
f1b35dc948
commit
6237eab0cd
13 changed files with 50 additions and 49 deletions
131
src/cljc/microworld/engine/core.cljc
Normal file
131
src/cljc/microworld/engine/core.cljc
Normal file
|
|
@ -0,0 +1,131 @@
|
|||
(ns ^{:doc "Functions to transform a world and run rules."
|
||||
:author "Simon Brooke"}
|
||||
microworld.engine.core
|
||||
(:require [clojure.core.reducers :as r]
|
||||
[microworld.engine.world :as world]
|
||||
[microworld.engine.utils :refer [get-int-or-zero map-world]])
|
||||
(:gen-class))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
;;;; microworld.engine: the state/transition engine of MicroWorld.
|
||||
;;;;
|
||||
;;;; This program is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU General Public License
|
||||
;;;; as published by the Free Software Foundation; either version 2
|
||||
;;;; of the License, or (at your option) any later version.
|
||||
;;;;
|
||||
;;;; This program is distributed in the hope that it will be useful,
|
||||
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;;; GNU General Public License for more details.
|
||||
;;;;
|
||||
;;;; You should have received a copy of the GNU General Public License
|
||||
;;;; along with this program; if not, write to the Free Software
|
||||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
|
||||
;;;; USA.
|
||||
;;;;
|
||||
;;;; Copyright (C) 2014 Simon Brooke
|
||||
;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
;;;; Every rule is a function of two arguments, a cell and a world. If the rule
|
||||
;;;; fires, it returns a new cell, which should have the same values for :x and
|
||||
;;;; :y as the old cell. Anything else can be modified.
|
||||
;;;;
|
||||
;;;; While any function of two arguments can be used as a rule, a special high
|
||||
;;;; level rule language is provided by the `mw-parser` package, which compiles
|
||||
;;;; rules expressed in a subset of English rules into suitable functions.
|
||||
;;;;
|
||||
;;;; A cell is a map containing at least values for the keys :x, :y, and :state;
|
||||
;;;; a transformation should not alter the values of :x or :y, and should not
|
||||
;;;; return a cell without a keyword as the value of :state. Anything else is
|
||||
;;;; legal.
|
||||
;;;;
|
||||
;;;; A world is a two dimensional matrix (sequence of sequences) of cells, such
|
||||
;;;; that every cell's :x and :y properties reflect its place in the matrix.
|
||||
;;;; See `world.clj`.
|
||||
;;;;
|
||||
;;;; Each time the world is transformed (see `transform-world`, for each cell,
|
||||
;;;; rules are applied in turn until one matches. Once one rule has matched no
|
||||
;;;; further rules can be applied.
|
||||
;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn apply-rule
|
||||
"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."
|
||||
([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))))
|
||||
|
||||
|
||||
(defn- apply-rules
|
||||
"Derive a cell from this `cell` of this `world` by applying these `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))))))
|
||||
|
||||
|
||||
(defn- transform-cell
|
||||
"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"
|
||||
[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}))))
|
||||
|
||||
|
||||
(defn transform-world
|
||||
"Return a world derived from this `world` by applying these `rules` to each cell."
|
||||
[world rules]
|
||||
(map-world world transform-cell (list rules)))
|
||||
|
||||
|
||||
(defn- transform-world-state
|
||||
"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."
|
||||
[state]
|
||||
(let [world (transform-world (:world state) (:rules state))]
|
||||
;;(world/print-world world)
|
||||
{:world world :rules (:rules state)}))
|
||||
|
||||
|
||||
(defn run-world
|
||||
"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."
|
||||
[world init-rules rules generations]
|
||||
(reduce (fn [world _iteration]
|
||||
(transform-world world rules))
|
||||
(transform-world world init-rules)
|
||||
(range generations)))
|
||||
|
||||
|
||||
151
src/cljc/microworld/engine/drainage.cljc
Normal file
151
src/cljc/microworld/engine/drainage.cljc
Normal file
|
|
@ -0,0 +1,151 @@
|
|||
(ns ^{:doc "Experimental, probably of no interest to anyone else; attempt to
|
||||
compute drainage on a world, assumed to have altitudes already set
|
||||
from a heightmap."
|
||||
:author "Simon Brooke"}
|
||||
microworld.engine.drainage
|
||||
(:require [microworld.engine.core :refer [run-world]]
|
||||
[microworld.engine.heightmap :as heightmap]
|
||||
[microworld.engine.utils :refer [get-int-or-zero get-least-cell get-neighbours
|
||||
get-neighbours-with-property-value
|
||||
map-world]]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
;;;; microworld.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)
|
||||
|
||||
(defn rain-world
|
||||
"Simulate rainfall on this `world`. TODO: Doesn't really work just now - should
|
||||
rain more on west-facing slopes, and less to the east of high ground"
|
||||
[world]
|
||||
(map-world world (fn [world cell] (merge cell {:rainfall 1}))))
|
||||
|
||||
|
||||
(defn flow-contributors
|
||||
"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"
|
||||
[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) >=))))
|
||||
|
||||
|
||||
(defn is-hollow
|
||||
"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`"
|
||||
[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 >)))))
|
||||
|
||||
|
||||
(defn flood-hollow
|
||||
"Raise the altitude of a copy of this `cell` of this `world` to the altitude
|
||||
of the lowest of its `neighbours`."
|
||||
([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))))
|
||||
|
||||
|
||||
(defn flood-hollows
|
||||
"Flood all local hollows in this `world`. At this stage only floods single
|
||||
cell hollows."
|
||||
[world]
|
||||
(map-world world
|
||||
#(if (is-hollow %1 %2) (flood-hollow %1 %2) %2)))
|
||||
|
||||
|
||||
(def max-altitude 255)
|
||||
|
||||
(defn flow-nr
|
||||
"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`."
|
||||
[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)))})))
|
||||
|
||||
|
||||
(def flow
|
||||
"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."
|
||||
(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))))})))))
|
||||
|
||||
|
||||
(defn flow-world-nr
|
||||
"Experimental non-recursive flow-world algorithm"
|
||||
[world]
|
||||
(run-world world nil (list flow-nr) max-altitude))
|
||||
|
||||
(defn flow-world
|
||||
"Return a world like this `world`, but with cells tagged with the amount of
|
||||
water flowing through them."
|
||||
[world]
|
||||
(map-world (rain-world world) flow))
|
||||
|
||||
|
||||
(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)))))
|
||||
137
src/cljc/microworld/engine/heightmap.cljc
Normal file
137
src/cljc/microworld/engine/heightmap.cljc
Normal file
|
|
@ -0,0 +1,137 @@
|
|||
(ns ^{:doc "Functions to apply a heightmap to a world."
|
||||
:author "Simon Brooke"}
|
||||
microworld.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]
|
||||
[microworld.engine.utils :refer [abs get-int get-neighbours map-world]]
|
||||
[microworld.engine.world :refer [make-world]]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
;;;; microworld.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.
|
||||
;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(defn tag-property
|
||||
"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 `microworld.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."
|
||||
([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))))})))
|
||||
|
||||
|
||||
(defn tag-gradient
|
||||
"Set the `gradient` property of this `cell` of this `world` to the difference in
|
||||
altitude between its highest and lowest neghbours."
|
||||
[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})))
|
||||
|
||||
|
||||
(defn tag-gradients
|
||||
"Set the `gradient` property of each cell in this `world` to the difference in
|
||||
altitude between its highest and lowest neghbours."
|
||||
[world]
|
||||
(map-world world tag-gradient))
|
||||
|
||||
|
||||
(defn tag-altitude
|
||||
"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 `microworld.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."
|
||||
([world cell heightmap]
|
||||
(tag-property cell :altitude heightmap))
|
||||
([cell heightmap]
|
||||
(tag-property cell :altitude heightmap)))
|
||||
|
||||
|
||||
(defn apply-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."
|
||||
([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))))
|
||||
|
||||
|
||||
(defn apply-valuemap
|
||||
"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."
|
||||
[world imagepath property]
|
||||
(let [heightmap (imagez/filter-image
|
||||
(filters/grayscale)
|
||||
(collage/load-image imagepath))]
|
||||
(map-world world tag-property (list property heightmap))))
|
||||
192
src/cljc/microworld/engine/natural_rules.cljc
Normal file
192
src/cljc/microworld/engine/natural_rules.cljc
Normal file
|
|
@ -0,0 +1,192 @@
|
|||
(ns ^{:doc "A set of MicroWorld rules describing a simplified natural ecosystem."
|
||||
:author "Simon Brooke"}
|
||||
microworld.engine.natural-rules
|
||||
(:require microworld.engine.utils
|
||||
microworld.engine.world))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
;;;; microworld.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)))
|
||||
309
src/cljc/microworld/engine/utils.cljc
Normal file
309
src/cljc/microworld/engine/utils.cljc
Normal file
|
|
@ -0,0 +1,309 @@
|
|||
(ns ^{:doc "Utility functions needed by MicroWorld and, specifically, in the
|
||||
interpretation of MicroWorld rule."
|
||||
:author "Simon Brooke"}
|
||||
microworld.engine.utils
|
||||
(:require
|
||||
[clojure.math.combinatorics :as combo]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
;;;; microworld.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 abs
|
||||
"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."
|
||||
[n]
|
||||
(if (neg? n) (- 0 n) n))
|
||||
|
||||
|
||||
(defn member?
|
||||
"True if elt is a member of col."
|
||||
[elt col] (some #(= elt %) col))
|
||||
|
||||
|
||||
(defn get-int-or-zero
|
||||
"Return the value of this `property` from this `map` if it is a integer;
|
||||
otherwise return zero."
|
||||
[map property]
|
||||
(let [value (map property)]
|
||||
(if (integer? value) value 0)))
|
||||
|
||||
|
||||
(defn init-generation
|
||||
"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."
|
||||
[world cell]
|
||||
(merge cell {:generation (get-int-or-zero cell :generation)}))
|
||||
|
||||
|
||||
(defn in-bounds
|
||||
"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."
|
||||
[world x y]
|
||||
(and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world)))))
|
||||
|
||||
|
||||
(defn map-world-n-n
|
||||
"Wholly non-parallel map world implementation; see documentation for `map-world`."
|
||||
([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))))
|
||||
|
||||
|
||||
(defn map-world-p-p
|
||||
"Wholly parallel map-world implementation; see documentation for `map-world`."
|
||||
([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))))
|
||||
|
||||
|
||||
(defn map-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."
|
||||
([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))))
|
||||
|
||||
|
||||
(defn get-cell
|
||||
"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."
|
||||
[world x y]
|
||||
(cond (in-bounds world x y)
|
||||
(nth (nth world y) x)))
|
||||
|
||||
|
||||
(defn get-int
|
||||
"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`."
|
||||
[map key]
|
||||
(cond (map? map)
|
||||
(let [v (map key)]
|
||||
(cond (and v (integer? v)) v
|
||||
true 0))
|
||||
true (throw (Exception. "No map passed?"))))
|
||||
|
||||
|
||||
(defn population
|
||||
"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."
|
||||
[cell species]
|
||||
(get-int cell species))
|
||||
|
||||
|
||||
(def memo-get-neighbours
|
||||
"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."
|
||||
(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)))))))))
|
||||
|
||||
|
||||
(defn get-neighbours
|
||||
"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."
|
||||
([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)))
|
||||
|
||||
|
||||
(defn get-neighbours-with-property-value
|
||||
"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."
|
||||
([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)))
|
||||
|
||||
(defn get-neighbours-with-state
|
||||
"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."
|
||||
([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)))
|
||||
|
||||
|
||||
(defn get-least-cell
|
||||
"Return the cell from among these `cells` which has the lowest numeric value
|
||||
for this `property`; if the property is absent or not a number, use this
|
||||
`default`"
|
||||
([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))))
|
||||
|
||||
|
||||
(defn- set-cell-property
|
||||
"If this `cell`s 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`."
|
||||
[cell x y property value]
|
||||
(cond
|
||||
(and (= x (:x cell)) (= y (:y cell)))
|
||||
(merge cell {property value :rule "Set by user"})
|
||||
true
|
||||
cell))
|
||||
|
||||
|
||||
(defn set-property
|
||||
"Return a world like this `world` but with the value of exactly one `property`
|
||||
of one `cell` changed to this `value`"
|
||||
([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))))
|
||||
|
||||
|
||||
(defn merge-cell
|
||||
"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"
|
||||
[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))
|
||||
119
src/cljc/microworld/engine/world.cljc
Normal file
119
src/cljc/microworld/engine/world.cljc
Normal file
|
|
@ -0,0 +1,119 @@
|
|||
(ns ^{:doc "Functions to create and to print two dimensional cellular automata."
|
||||
:author "Simon Brooke"}
|
||||
microworld.engine.world
|
||||
(:require [clojure.string :as string :only [join]]
|
||||
[microworld.engine.utils :refer [population]]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;
|
||||
;;;; microworld.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.
|
||||
;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(defn- make-cell
|
||||
"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."
|
||||
[x y]
|
||||
{:x x :y y :state :new})
|
||||
|
||||
|
||||
(defn- make-world-row
|
||||
"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."
|
||||
[index width height]
|
||||
(cond (= index width) nil
|
||||
true (cons (make-cell index height)
|
||||
(make-world-row (inc index) width height))))
|
||||
|
||||
|
||||
(defn- make-world-rows
|
||||
"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."
|
||||
[index width height]
|
||||
(cond (= index height) nil
|
||||
true (cons (apply vector (make-world-row 0 width index))
|
||||
(make-world-rows (inc index) width height))))
|
||||
|
||||
(defn make-world
|
||||
"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."
|
||||
[width height]
|
||||
(apply vector (make-world-rows 0 width height)))
|
||||
|
||||
|
||||
(defn truncate-state
|
||||
"Truncate the print name of the state of this cell to at most limit characters."
|
||||
[cell limit]
|
||||
(let [s (:state cell)]
|
||||
(cond (> (count (str s)) limit) (subs s 0 limit)
|
||||
true s)))
|
||||
|
||||
|
||||
(defn format-cell
|
||||
"Return a formatted string summarising the current state of this cell."
|
||||
[cell]
|
||||
(format "%10s(%2d/%2d)"
|
||||
(truncate-state cell 10)
|
||||
(population cell :deer)
|
||||
(population cell :wolves)))
|
||||
|
||||
|
||||
(defn- format-world-row
|
||||
"Format one row in the state of a world for printing."
|
||||
[row]
|
||||
(string/join (map format-cell row)))
|
||||
|
||||
|
||||
(defn print-world
|
||||
"Print the current state of this world, and return nil.
|
||||
|
||||
* `world` a world as defined above."
|
||||
[world]
|
||||
(println)
|
||||
(dorun
|
||||
(map
|
||||
#(println
|
||||
(format-world-row %))
|
||||
world))
|
||||
nil)
|
||||
Loading…
Add table
Add a link
Reference in a new issue