From 977947d4b0aff9d36dfe3a28d9553ec82f7444aa Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Mon, 30 Jun 2014 12:14:58 +0100 Subject: [PATCH] Now runs rather nicely, although output could be tidied up a bit! --- src/mw_engine/core.clj | 102 ++++++++++++++++++++++++++++++++++++++-- src/mw_engine/utils.clj | 5 ++ src/mw_engine/world.clj | 22 +++++++-- 3 files changed, 119 insertions(+), 10 deletions(-) create mode 100644 src/mw_engine/utils.clj diff --git a/src/mw_engine/core.clj b/src/mw_engine/core.clj index 0d7c45a..d5eec14 100644 --- a/src/mw_engine/core.clj +++ b/src/mw_engine/core.clj @@ -1,6 +1,98 @@ -(ns mw-engine.core) +(ns mw-engine.core + (:use mw-engine.world + mw-engine.utils)) -(defn foo - "I don't do a whole lot." - [x] - (println x "Hello, 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. +;; +;; Rules are applied in turn until one matches. + + +(def treeline 10) + +(def natural-rules + (list + ;; Randomly, birds plant tree seeds into pasture. + (fn [cell world] (cond (and (= (:state cell) :pasture)(< (rand 10) 1))(merge cell {:state :scrub}))) + ;; Scrub below the treeline grows gradually into forest + (fn [cell world] + (cond (and + (= (:state cell) :scrub) + (< (:altitude cell) treeline)) + (merge cell {:state :scrub2}))) + (fn [cell world] (cond (= (:state cell) :scrub2) (merge cell {:state :forest}))) + ;; Forest on fertile land at low altitude grows to climax + (fn [cell world] + (cond + (and + (= (:state cell) :forest) + (> (:fertility cell) 10)) + (merge cell {:state :climax}))) + ;; Climax forest occasionally catches fire (e.g. lightning strikes) + (fn [cell world] (cond (and (= (:state cell) :climax)(< (rand 10) 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 scrub, otherwise grassland. + (fn [cell world] + (cond + (and (= (:state cell) :waste) + (not + (empty? + (flatten + (list + (get-neighbours-with-state world (:x cell) (:y cell) 1 :scrub2) + (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 :scrub}))) + (fn [cell world] + (cond (= (:state cell) :waste) + (merge cell {:state :pasture}))) + ;; Forest increases soil fertility + (fn [cell world] + (cond (member? (:state cell) '(:forest :climax)) + (merge cell {:fertility (+ (:fertility cell) 1)}))) + )) + +(defn transform-cell + "Derive a cell from this cell of this world by applying these rules." + [cell world rules] + (cond (empty? rules) cell + true (let [r (apply (eval (first rules)) (list cell world))] + (cond r r + true (transform-cell cell world (rest rules)))))) + +(defn transform-world-row + "Return a row derived from this row of this world by applying these rules to each cell." + [row world rules] + (map #(transform-cell % world rules) row)) + +(defn transform-world + "Return a world derived from this world by applying these rules to each cell." + [world rules] + (map + #(transform-world-row % world rules) + world)) + +(defn transform-world-state + "Consider this single argument as a list of world and rules; apply the rules + to transform the world, and return a list of the new, transformed world and + these rules. As a side effect, print the world." + [state] + (list + (print-world (transform-world (first state) (first (rest state)))) + (first (rest state)))) + +(defn run-world + "Run this world with these rules for this number of generations." + [world rules generations] + (let [state (list world rules)] + (take generations (iterate transform-world-state state)))) diff --git a/src/mw_engine/utils.clj b/src/mw_engine/utils.clj new file mode 100644 index 0000000..056330f --- /dev/null +++ b/src/mw_engine/utils.clj @@ -0,0 +1,5 @@ +(ns mw-engine.utils) + +(defn member? + "True if elt is a member of col." + [elt col] (some #(= elt %) col)) \ No newline at end of file diff --git a/src/mw_engine/world.clj b/src/mw_engine/world.clj index 173037c..16c1916 100644 --- a/src/mw_engine/world.clj +++ b/src/mw_engine/world.clj @@ -4,7 +4,7 @@ (defn make-cell "Create a default cell at x, y" [x y] - {:x x :y y :altitude 1 :state :pasture}) + {:x x :y y :altitude 1 :state :waste :fertility 1}) (defn make-world-row "Make the (remaining) cells in a row at this height in a world of this width." @@ -17,14 +17,14 @@ "Make the (remaining) rows in a world of this width and height, from this index." (cond (= index height) nil - true (cons (apply vector (make-world-row 0 width index)) + true (cons (make-world-row 0 width index) (make-world-rows (+ index 1) width height)))) (defn make-world "Make a world width cells from east to west, and height cells from north to south." [width height] - (apply vector (make-world-rows 0 width height))) + (make-world-rows 0 width height)) (defn in-bounds "True if x, y are in bounds for this world (i.e., there is a cell at x, y) @@ -46,6 +46,12 @@ (range (- x depth) (+ x depth)) (range (- y depth) (+ y depth))))) +(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 x y depth state] + (filter #(= (:state %) state) (get-neighbours world x y depth))) + (defn truncate-state "Truncate the print name of the state of this cell to at most limit characters." [cell limit] @@ -60,6 +66,12 @@ (map #(format "%10s" (truncate-state % 10)) row))) (defn print-world - "Print the current state of this world." + "Print the current state of this world, and return nil" [world] - (dorun (map #(println (format-world-row %)) world)) nil) + (println) + (dorun + (map + #(println + (format-world-row %)) + world)) + world)