Ytdyklly

I stumbled on the idea of a Forest Fire simulating cellular automata, and decided to try making a version using a full Seesaw UI (a Clojure wrapper over Java's Swing). A short sample of it running is above.

It ended up being fairly straightforward; although I've written a fair number of CA's before, so this was more just applying a specific rule-set, and designing a quick UI.

It can be used in the console too using format-world. T's are trees, and #s are fire squares:

(let [r (g/new-rand-gen 99)

      w (new-empty-world [10 10] (new-chance-settings 0.3 0.1))



      worlds (->> w

                  (iterate #(advance % r))

                  (take 5))]



  (doseq [world worlds]

    (println (format-world world) "n")))



















          T        

    T         T    

            T T T  

T                  

                T  

            T T T  

  T                

T     T   T        

  T                

        T         T 



T   T     T   T    

T T T   T     #    

      T     T T T  

T   T              

  T T     T     T T

            T T T  

  T T T            

T T   T   T     T  

  T T T     T   T  

T T   T T   T     # 



T   T   T T   #    

# T T   T T T     T

      T     # # #  

#   T     T   T T  

  T T     T     T T

T     T     T T T T

  T T T       T    

T T T T T T     T  

T T T T T   T T # T

T T T T T T T       



#   T T T T        

  # T   T # #     #

    T T           T

    T     #   # #  

  # T T T T   T T T

T   T T T   T T T T

T T # T   T   #    

T # T T T T     #  

T T # T T T T #   #

# T T T T T T 

I'd like any general suggestions. I'm not very organized, so my UI tends to become a mess. Any suggestions for improvements there especially would be appreciated.

Helper functions for dealing with 2D vectors

(ns forest-fire.grid

  (:require [clojure.string :as s]))



(defn new-grid [dimensions initial-cell]

  (let [[w h] dimensions]

    (vec (repeat h

                 (vec (repeat w initial-cell))))))



(defn set-cell [grid position new-cell]

  (let [[x y] position]

    (assoc-in grid [y x] new-cell)))



(defn get-cell [grid position]

  (let [[x y] position]

    (get-in grid [y x])))



(defn dimensions-of [grid]

  [(count (first grid))

   (count grid)])



(defn positions-of

  "Returns a lazy list of every integer coordinate in the grid."

  [grid]

  (let [[w h] (dimensions-of grid)]

    (for [y (range h)

          x (range w)]

      [x y])))



(defn format-grid

  "Gives each cell to str-map to decide what str is used in formating.

  Uses " " if str-map returns nil"

  [grid str-map]

  (->> grid

       (map (fn [row] (map #(or (str-map %) " ") row)))

       (map #(s/join " " %))

       (s/join "n")))

An abridged part of my personal library used in the project

(ns helpers.general-helpers)



(defn new-rand-gen

  ([seed] (Random. seed))

  ( (Random.)))



(defn random-perc

  "Returns true perc-chance percent of the time."

  [^double perc-chance, ^Random rand-gen]

  (<= (.nextDouble rand-gen)

      perc-chance))



(defn map-range

  "Maps a value from the range [start1 stop1] to a value in the range [start2 stop2]."

  [value start1 stop1 start2 stop2]

  (+ start2

     (* (- stop2 start2)

        (/ (- value start1)

           (- stop1 start1)))))



(defn parse-double

  "Returns nil on bad input."

  [str-n]

  (try

    (Double/parseDouble str-n)



    (catch NumberFormatException _

      nil)))

The main state of the simulation

(ns forest-fire.world

  (:require [forest-fire.grid :as gr]

            [helpers.general-helpers :as g]))



(def cell-types #{::empty, ::tree, ::burning})



(defn new-chance-settings [grow-chance burn-chance]

  {:grow-chance grow-chance, :burn-chance burn-chance})



(defn new-empty-world [dimensions settings]

  {:grid (gr/new-grid dimensions ::empty)

   :settings settings})



(defn dimensions-of [world]

  (-> world :grid (gr/dimensions-of)))



(defn- positions-around

  "Returns the coordinates around a cell representing the Moore neighborhood of the cell (when (= depth 1))."

  ([position dimensions depth]

   (let [[cx cy] position

         [w h] dimensions]



     (for [y (range (max 0 (- cy depth)) (min h (+ cy depth 1)))

           x (range (max 0 (- cx depth)) (min w (+ cx depth 1)))

           :let [neigh-pos [x y]]

           :when (not= neigh-pos position)]



       neigh-pos)))



  ([position dimensions]

   (positions-around position dimensions 1)))



(defn- neighbors-of

  "Returns the cells in the Moore neighborhood of a cell."

  [grid position]

  (let [dims (gr/dimensions-of grid)]

    (->> (positions-around position dims)

         (map #(gr/get-cell grid %)))))



(defn- has-burning-neighbor? [grid position]

  (->> (neighbors-of grid position)

       (some #(= % ::burning))))



(defn- advance-cell [new-grid old-grid position chance-settings rand-gen]

  (let [contents (gr/get-cell old-grid position)

        {:keys [grow-chance burn-chance]} chance-settings]



    (case contents

      ::burning (gr/set-cell new-grid position ::empty)



      ::empty (if (g/random-perc grow-chance rand-gen)

                (gr/set-cell new-grid position ::tree)

                new-grid)



      ::tree (cond

               ; Doing this check first since it'll be much cheaper

               (g/random-perc burn-chance rand-gen)

               (gr/set-cell new-grid position ::burning)



               (has-burning-neighbor? old-grid position)

               (gr/set-cell new-grid position ::burning)



               :else

               new-grid))))



(defn- advance-grid [grid chance-settings rand-gen]

  (reduce (fn [acc-grid pos]

            (advance-cell acc-grid grid pos chance-settings rand-gen))

          grid

          (gr/positions-of grid)))



(defn advance

  "Advances the forest fire world by 1 "tick""

  [world rand-gen]

  (let [{:keys [settings]} world]

    (update world :grid advance-grid settings rand-gen)))





(defn format-world

  "Formats the world into a String to be printed."

  [world]

  (let [format-f {::empty " ", ::burning "#", ::tree "T"}]

    (gr/format-grid (:grid world) format-f)))

The main UI

(ns forest-fire.seesaw-ui

  (:require [seesaw.core :as sc]

            [seesaw.graphics :as sg]



            [forest-fire.world :as fw]

            [forest-fire.grid :as gr]



            [helpers.general-helpers :as g])



  (:import [java.awt Component]

           [javax.swing Timer]))



(def settings-font {:name "Arial", :size 40})



(def global-rand-gen (g/new-rand-gen 99))



(def default-advance-delay 100)



(defn component-dimensions [^Component c]

  [(.getWidth c), (.getHeight c)])



(defn world->canvas-position [world-position world-dimensions canvas-dimensions]

  (let [[x y] world-position

        [ww wh] world-dimensions

        min-canvas-dim (apply min canvas-dimensions)]

    [(g/map-range x, 0 ww, 0 min-canvas-dim)

     (g/map-range y, 0 wh, 0 min-canvas-dim)]))



(defn square-size [world-dimensions canvas-dimensions]

  (double (/ (apply min canvas-dimensions)

             (apply min world-dimensions))))



(defn paint [world-atom canvas g]

  (let [{:keys [grid] :as world} @world-atom



        world-dims (fw/dimensions-of world)

        canvas-dims (component-dimensions canvas)

        sq-width (square-size world-dims canvas-dims)



        w->c #(world->canvas-position % world-dims canvas-dims)]



    (doseq [world-pos (gr/positions-of grid)]

      (let [cell (gr/get-cell grid world-pos)]

        (when-not (= cell ::fw/empty)

          (let [[cx cy] (w->c world-pos)

                col (case cell

                      ::fw/tree :green

                      ::fw/burning :red)]

            (sg/draw g

               (sg/rect cx cy sq-width sq-width)

               (sg/style :background col, :foreground :black))))))))



(defn new-canvas [state-atom]

  (let [canvas (sc/canvas :paint (partial paint state-atom),

                          :id :canvas)]

    canvas))



(defn new-input-pair [label-text settings-key state-atom]

  (let [current-world @state-atom

        initial-value (get-in current-world [:settings settings-key])



        label (sc/label :text (str label-text),

                        :font settings-font)



        input (sc/text :text (str initial-value),

                       :font settings-font)]



    (sc/listen input

       :key-released

       (fn [_]

         (when-let [parsed (g/parse-double (sc/text input))]

           (swap! state-atom

                  assoc-in [:settings settings-key] parsed))))



    (sc/horizontal-panel :items [label input])))



(defn new-main-panel [state-atom]

  (let [canvas (new-canvas state-atom)

        settings-bar (sc/horizontal-panel

                       :items [(new-input-pair "Burn Chance" :burn-chance state-atom)

                               (new-input-pair "Grow Chance" :grow-chance state-atom)])]



    (sc/border-panel :center canvas,

                     :south settings-bar)))



(defn world-advancer

  "Advances the world and repaints the canvas every advance-delay ms.

  Returns a 0-arity function that stops the timer when called."

  [state-atom canvas advance-delay]

  (let [t (sc/timer

            (fn [_]

              (swap! state-atom fw/advance global-rand-gen)

              (sc/repaint! canvas))

            :delay advance-delay)]



    (fn  (.stop ^Timer t))))



(defn new-frame [starting-world]

  (let [state-atom (atom starting-world)



        main-panel (new-main-panel state-atom)

        canvas (sc/select main-panel [:#canvas])

        frame (sc/frame :content main-panel, :size [1000 :by 1000])



        stop-advancer (world-advancer state-atom canvas default-advance-delay)]



    (sc/listen frame

       :window-closing (fn [_]

                         (stop-advancer)))



    frame))



(defn -main 

  (let [w (-> (fw/new-empty-world [100 100] (fw/new-chance-settings 0.9 0.0001))

              (fw/advance global-rand-gen)

              (fw/advance global-rand-gen))]



    (-> (new-frame w)

        (sc/show!))))