ants.clj revision f2c2e34eec8ec66a7f830c31be39e568a6ecf686
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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.
; Ant Simulator
(ns opengrok-test)
;dimensions of square world
(def dim 80)
;number of ants = nants-sqrt^2
(def nants-sqrt 7)
;number of places with food
(def food-places 35)
;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)
(def animation-sleep-ms 100)
(def ant-sleep-ms 40)
(def evap-sleep-ms 1000)
(def running true)
(defstruct cell :food :pher) ;may also have :ant and :home
;world is a 2d vector of refs to cells
(def world
(apply vector
(map (fn [_]
(apply vector (map (fn [_] (ref (struct cell 0 0)))
(range dim))))
(range dim))))
(defn place [[x y]]
(-> world (nth x) (nth y)))
(defstruct ant :dir) ;may also have :food
(defn create-ant
"create an ant at the location, returning an ant agent on the location"
[loc dir]
(sync nil
(let [p (place loc)
a (struct ant dir)]
(alter p assoc :ant a)
(agent loc))))
(def home-off (/ dim 4))
(def home-range (range home-off (+ nants-sqrt home-off)))
(defn setup
"places initial food and ants, returns seq of ant agents"
[]
(sync nil
(dotimes [i food-places]
(let [p (place [(rand-int dim) (rand-int dim)])]
(alter p assoc :food (rand-int food-range))))
(doall
(for [x home-range y home-range]
(do
(alter (place [x y])
assoc :home true)
(create-ant [x y] (rand-int 8)))))))
(defn bound
"returns n wrapped into range 0-b"
[b n]
(let [n (rem n b)]
(if (neg? n)
(+ n b)
n)))
(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]
(let [total (reduce + slices)
r (rand total)]
(loop [i 0 sum 0]
(if (< r (+ (slices i) sum))
i
(recur (inc i) (+ (slices i) sum))))))
;dirs are 0-7, starting at north and going clockwise
;these are the deltas in order to move one step in given dir
(def dir-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-loc
"returns the location one step in the given dir. Note the world is a torus"
[[x y] dir]
(let [[dx dy] (dir-delta (bound 8 dir))]
[(bound dim (+ x dx)) (bound dim (+ y dy))]))
;(defmacro dosync [& body]
; `(sync nil ~@body))
;ant agent functions
;an ant agent tracks the location of an ant, and controls the behavior of
;the ant at that location
(defn turn
"turns the ant at the location by the given amount"
[loc amt]
(dosync
(let [p (place loc)
ant (:ant @p)]
(alter p assoc :ant (assoc ant :dir (bound 8 (+ (:dir ant) amt))))))
loc)
(defn move
"moves the ant in the direction it is heading. Must be called in a
transaction that has verified the way is clear"
[loc]
(let [oldp (place loc)
ant (:ant @oldp)
newloc (delta-loc loc (:dir ant))
p (place newloc)]
;move the ant
(alter p assoc :ant ant)
(alter oldp dissoc :ant)
;leave pheromone trail
(when-not (:home @oldp)
(alter oldp assoc :pher (inc (:pher @oldp))))
newloc))
(defn take-food [loc]
"Takes one food from current location. Must be called in a
transaction that has verified there is food available"
(let [p (place loc)
ant (:ant @p)]
(alter p assoc
:food (dec (:food @p))
:ant (assoc ant :food true))
loc))
(defn drop-food [loc]
"Drops food at current location. Must be called in a
transaction that has verified the ant has food"
(let [p (place loc)
ant (:ant @p)]
(alter p assoc
:food (inc (:food @p))
:ant (dissoc ant :food))
loc))
(defn rank-by
"returns a map of xs to their 1-based rank when sorted by keyfn"
[keyfn xs]
(let [sorted (sort-by (comp float keyfn) xs)]
(reduce (fn [ret i] (assoc ret (nth sorted i) (inc i)))
{} (range (count sorted)))))
(defn behave
"the main function for the ant agent"
[loc]
(let [p (place loc)
ant (:ant @p)
ahead (place (delta-loc loc (:dir ant)))
ahead-left (place (delta-loc loc (dec (:dir ant))))
ahead-right (place (delta-loc loc (inc (:dir ant))))
places [ahead ahead-left ahead-right]]
(. Thread (sleep ant-sleep-ms))
(dosync
(when running
(send-off *agent* #'behave))
(if (:food ant)
;going home
(cond
(:home @p)
(-> loc drop-food (turn 4))
(and (:home @ahead) (not (:ant @ahead)))
(move loc)
: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)))
;foraging
(cond
(and (pos? (:food @p)) (not (:home @p)))
(-> loc take-food (turn 4))
(and (pos? (:food @ahead)) (not (:home @ahead)) (not (:ant @ahead)))
(move loc)
: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)))))))
(defn evaporate
"causes all the pheromones to evaporate a bit"
[]
(dorun
(for [x (range dim) y (range dim)]
(dosync
(let [p (place [x y])]
(alter p assoc :pher (* evap-rate (:pher @p))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; UI ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(import
'(java.awt Color Graphics Dimension)
'(java.awt.image BufferedImage)
'(javax.swing JPanel JFrame))
;pixels per world cell
(def scale 5)
(defn fill-cell [#^Graphics g x y c]
(doto g
(.setColor c)
(.fillRect (* x scale) (* y scale) scale scale)))
(defn render-ant [ant #^Graphics g x y]
(let [black (. (new Color 0 0 0 255) (getRGB))
gray (. (new Color 100 100 100 255) (getRGB))
red (. (new Color 255 0 0 255) (getRGB))
[hx hy tx ty] ({0 [2 0 2 4]
1 [4 0 0 4]
2 [4 2 0 2]
3 [4 4 0 0]
4 [2 4 2 0]
5 [0 4 4 0]
6 [0 2 4 2]
7 [0 0 4 4]}
(:dir ant))]
(doto g
(.setColor (if (:food ant)
(new Color 255 0 0 255)
(new Color 0 0 0 255)))
(.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 [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))
bg (. img (getGraphics))]
(doto bg
(.setColor (. Color white))
(.fillRect 0 0 (. img (getWidth)) (. img (getHeight))))
(dorun
(for [x (range dim) y (range dim)]
(render-place bg (v (+ (* x dim) y)) x y)))
(doto bg
(.setColor (. Color blue))
(.drawRect (* scale home-off) (* scale home-off)
(* scale nants-sqrt) (* scale nants-sqrt)))
(. g (drawImage img 0 0 nil))
(. bg (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)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; use ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (comment
;demo
;; (load-file "/Users/rich/dev/clojure/ants.clj")
(def ants (setup))
(send-off animator animation)
(dorun (map #(send-off % behave) ants))
(send-off evaporator evaporation)
;; )