Rich Hickey Ants Simulator

ants.clj

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ant sim ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;   Copyright (c) Rich Hickey. All rights reserved.
;;
;;   The use and distribution terms for this software are covered by the
;;   Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
;;   which can be found in the file CPL.TXT at the root of this distribution.
;;   By using this software in any fashion, you are agreeing to be bound by
;;   the terms of this license.
;;
;;   You must not remove this notice, or any other, from this software.
(ns ants
  (:import
   (java.awt Color Graphics Dimension)
   (java.awt.image BufferedImage)
   (javax.swing JPanel JFrame)))

;; Set dimensions of the world, as a square 2-D board:
(def dim 200)
;; Number of ants = nants-sqrt^2
(def nants-sqrt 7)
;; Number of places with food:
(def food-places 50)
;; Range of amount of food at a place:
(def food-range 100)
;; Scale factor for pheromone drawing:
(def pher-scale 20.0)
;; Scale factor for food drawing:
(def food-scale 30.0)
;; Evaporation rate:
(def evap-rate 0.99)

;; Sleep ms for UI update
(def animation-sleep-ms 100)
(def ant-sleep-ms 40)
(def evap-sleep-ms 1000)

;; Home config
(def home-offset (/ dim 2))
(def home-range  (range home-offset (+ nants-sqrt home-offset)))

;; A cell of the world is a sqare matrix of pixels;
;; with an odd number of pixels we can have a central position
(def scale 5)

;; App is running
(def running true)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  The board: ready to mutate via transactions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defstruct cell :food :pher)  ; May also have :ant and :home values

;; World is a 2d vector of refs to cells
(def world
  (apply vector
         (map (fn [_]
                (apply vector
                       (map (fn [_]
                              ;; Initialize cell with food and pher to 0
                              ;; Using ref for safe reference a mutable
                              ;; collection. Changes to a cell will be atomic,
                              ;; consisted and isolated.
                              ;; You don't need to manually manage concurrency
                              (ref (struct cell 0 0)))
                            (range dim))))
              (range dim))))


(defn place [[x y]]
  (-> world (nth x) (nth y)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Ants as agents - doing asynchronous uncoordinated changes
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defstruct ant :dir)  ; Always has dir heading; may also have :food

(defn create-ant
  "Create an ant at given location, returning an ant agent on the location."
  [loc dir]
  ;; Sync ensure that mutations of refs will be atomic.
  (sync nil
        (let [p (place loc)
              a (struct ant dir)]
          ;; Add ant to the single place struct
          (alter p assoc :ant a)
          ;; Agents provide shared access to mutable state. They allow
          ;; non-blocking (asynchronous as opposed to synchronous atoms) and
          ;; independent change of individual locations (unlike coordinated
          ;; change of multiple locations through refs).
          (agent loc))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Setting up the home, and ants
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn setup-world
  "Places initial food and ants, returns seq of ant agents."
  []
  ;; Atomically execute actions; all or nothing
  (sync nil
        ;; Place all the food in random places
        (dotimes [i food-places]
          (let [p (place [(rand-int dim) (rand-int dim)])]
            (alter p assoc :food (rand-int food-range))))
        ;; Set home and ant for every single place
        (doall
         (for [x home-range y home-range]
           (do
             (alter (place [x y]) assoc :home true)
             ;; Create ant with a random direction
             (create-ant [x y] (rand-int 8)))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Orientation and moving around the world
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defn bound
  "Return given n, wrapped into range o-b."
  [b n]
  (let [n (rem n b)]
    (if (neg? n)
      (+ n b)
      n)))

;; Directions are 0-7, starting at north and going clockwise. These are
;; the 2-D deltas in order to move one step in a given direction.
(def direction-delta {0 [0 -1]
                      1 [1 -1]
                      2 [1 0]
                      3 [1 1]
                      4 [0 1]
                      5 [-1 1]
                      6 [-1 0]
                      7 [-1 -1]})

(defn delta-location
  "Returns the location one step in the given direction. Note the world is a
  torus."
  [[x y] direction]
  (let [[dx dy] (direction-delta (bound 8 direction))]
    [(bound dim (+ x dx)) (bound dim (+ y dy))]))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Ant-agent behavior functions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;
;; Ants movements
;;
(defn turn
  "Turns the ant at the location by the given amount."
  [loc amt]
  (dosync
   (let [p   (place loc)
         ant (:ant @p)]
     (->> (:dir ant)
          (+ amt)
          (bound 8)
          (assoc ant :dir)
          (alter p assoc :ant))))
  loc)

(defn move
  "Moves the ant in the direction it is heading. Must be called in a transation
  that has verified the way is clear."
  [loc]
  (let [oldp   (place loc)
        ant    (:ant @oldp)
        newloc (delta-location loc (:dir ant))
        p      (place newloc)]
    ;; move the ant from oldp to newp
    (alter p assoc :ant ant)
    (alter oldp dissoc :ant)
    ;; leave pheromone trail if not inside the home
    (when-not (:home @oldp)
      (alter oldp assoc :pher (inc (:pher @oldp))))
    newloc))


;;
;; Ants and food
;;
(defn take-food
  "Takes one food from current location. Must be called in a transation that has
  verified there is food available."
  [loc]
  (let [p   (place loc)
        ant (:ant @p)]
    ;; take food from the location and give it to the ant
    (alter p assoc
           :food (dec (:food @p))
           :ant  (assoc ant :food true))
    loc))

(defn drop-food
  "Drops food at the current locatio. Must be called in a transaction that has
  verified the ant has food."
  [loc]
  (let [p   (place loc)
        ant (:ant @p)]
    ;; drop food in the location and remove it from the ant
    (alter p assoc
           :food (inc (:food @p))
           :ant  (dissoc ant :food))
    loc))


;;
;; Ant judgment
;;
(defn rank-by
  "Returns a map of xs to their 1-based rank when sorted by keyfn."
  ;; keyfn checks for the presence of :food, :pher, or :home in the three
  ;; cells (board locations) of the xs vector of [ahead ahead-left ahead-right]
  [keyfn xs]
  ;; sort-by returns a sorted sequence items based on how valuable a cell is to
  ;; an ant, depending on whether it's looking for food or going home.
  (let [sorted (sort-by (comp float keyfn) xs)]
    ;; reduce return a map of the rank and the integer value
    ;; {0.2 1, 0.7 2, 1.0 3}
    (reduce (fn [ret i]
              (assoc ret (nth sorted i) (inc i)))
            {}
            (range (count sorted)))))

(defn wrand
  "Given a vector of slice sizes, returns the index of a slice given a random spin
  of a roulette wheel with compartments proportional to slices."
  ;; slices represent the desirability of the 3 cells ahead of the ant
  [slices]
  ;; total is the sum of the slices
  (let [total (reduce + slices)
        r     (rand total)]
    (loop [i 0 sum 0]
      ;; if the random number is inside the rank of the current slice, return
      ;; the index
      (if (< r (+ (slices i) sum))
        i
        (recur (inc i) (+ (slices i) sum))))))


;;
;;  Tying it all together: the behave function for ants
;;
(defn behave
  "The main function for the ant agent."
  [loc]
  (let [p           (place loc)
        ant         (:ant @p)
        ahead       (place (delta-location loc (:dir ant)))
        ahead-left  (place (delta-location loc (dec (:dir ant))))
        ahead-right (place (delta-location loc (inc (:dir ant))))
        places      [ahead ahead-left ahead-right]]
    ;; help slow down ants in the UI display
    (Thread/sleep ant-sleep-ms)
    ;; ensure ants behavior is transactional, all-or-nothing
    (dosync
     (when running
       (send-off *agent* #'behave))
     (if (:food ant)
       ;; then take food :home
       (cond
         ;; if at home drop food and go back
         (:home @p)
         (-> loc drop-food (turn 4))

         ;; if :home is ahead and no ant is there, move
         (and (:home @ahead) (not (:ant @ahead)))
         (move loc)

         ;; move in direction to :home
         :else
         (let [ranks (merge-with +
                                 (rank-by (comp #(if (:home %) 1 0) deref) places)
                                 (rank-by (comp :pher deref) places))]
           (([move #(turn % -1) #(turn % 1)]
             (wrand [(if (:ant @ahead) 0 (ranks ahead))
                     (ranks ahead-left) (ranks ahead-right)]))
            loc)))
       ;; if ant doesn't have :food, go foraging
       (cond
         ;; if :food in the current position and not at home, take food and turn back
         (and (pos? (:food @p)) (not (:home @p)))
         (-> loc take-food (turn 4))

         ;; if :food ahead but not :home or :ant in it, move
         (and (pos? (:food @ahead)) (not (:home @ahead)) (not (:ant @ahead)))
         (move loc)

         ;; move in a ranom direction
         :else
         (let [ranks (merge-with +
                                 (rank-by (comp :food deref) places)
                                 (rank-by (comp :pher deref) places))]
           (([move #(turn % -1) #(turn % 1)]
             (wrand [(if (:ant @ahead) 0 (ranks ahead))
                     (ranks ahead-left) (ranks ahead-right)]))
            loc)))))))


;;
;; World behavior: pheromone evaporation
;;
(defn evaporate
  "Causes all the pheromones to evaporate a bit."
  []
  (dorun
   (for [x (range dim) y (range dim)]
     (dosync
      (let [p (place [x y])]
        ;; Diminish pheromone amount for every place using evap-rate
        (alter p assoc :pher (* evap-rate (:pher @p))))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  The UI
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def bg-color       (new Color 10   10  10))
(def ant-color      (new Color 255 255 255))
(def home-color     (. Color blue))
(def ant+food-color (new Color 255 255   0))


(defn fill-cell
  "Fill the cell with symbolic colors."
  [#^Graphics g x y c]
  (doto g
    (.setColor c)
    (.fillRect (* x scale) (* y scale) scale scale)))

(defn render-ant
  "An ant is rendered as a line 5 pixel long pointing in 8 cardinal directions."
  [ant #^Graphics g x y]
  (let [[hx hy tx ty] ({0 [2 0 2 4] ; Up/North pointin
                        1 [4 0 0 4]
                        2 [4 2 0 2]
                        3 [4 4 0 0]
                        4 [2 4 2 0] ; Down/South
                        5 [0 4 4 0]
                        6 [0 2 4 2]
                        7 [0 0 4 4]}
                       (:dir ant))]
    (doto g
      (.setColor (if (:food ant)
                   ant+food-color
                   ant-color))
      (.drawLine (+ hx (* x scale)) (+ hy (* y scale))
                 (+ tx (* x scale)) (+ ty (* y scale))))))


(defn render-place
  [g p x y]
  (when (pos? (:pher p))
    (fill-cell g x y (new Color 0 255 0
                          (int (min 255 (* 255 (/ (:pher p) pher-scale)))))))
  (when (pos? (:food p))
    (fill-cell g x y (new Color 255 0 0
                          (int (min 255 (* 255 (/ (:food p) food-scale)))))))
  (when (:ant p)
    (render-ant (:ant p) g x y)))


(defn render-home
  "Render home at the center of the window."
  [grph]
  (let [pos  (* scale home-offset)
        size (* scale nants-sqrt)]
    (doto grph
      (.setColor home-color)
      (.drawRect pos pos size size))))


(defn render-bg
  "Paint the window white."
  [grph img]
  (doto grph
    (.setColor bg-color)
    (.fillRect 0 0 (. img (getWidth)) (. img (getHeight)))))


(defn render
  [g]
  (let [v    (dosync (apply vector (for [x (range dim) y (range dim)]
                                     @(place [x y]))))
        img  (new BufferedImage (* scale dim) (* scale dim)
                  (. BufferedImage TYPE_INT_ARGB))
        grph (. img (getGraphics))]
    (render-bg grph img)
    (dorun
     (for [x (range dim) y (range dim)]
       (render-place grph (v (+ (* x dim) y)) x y)))
    (render-home grph)
    (. g (drawImage img 0 0 nil))
    (. grph (dispose))))

(def panel (doto (proxy [JPanel] [] (paint [g] (render g)))
             (.setPreferredSize (new Dimension
                                     (* scale dim)
                                     (* scale dim)))))

(def frame (doto (new JFrame) (.add panel) .pack .show))

(def animator (agent nil))

(defn animation [x]
  (when running
    (send-off *agent* #'animation))
  (. panel (repaint))
  (Thread/sleep animation-sleep-ms)
  nil)

(def evaporator (agent nil))

(defn evaporation [x]
  (when running
    (send-off *agent* #'evaporation))
  (evaporate)
  (Thread/sleep evap-sleep-ms)
  nil)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Run
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn run []
  (let [ants (setup-world)]
    (send-off animator animation)
    (dorun (map #(send-off % behave) ants))
    (send-off evaporator evaporation)))