3
\$\begingroup\$

enter image description here

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!))))
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.