Boids, originally written by Craig Reynolds in 1986, is an artificial live program which simulates flocking birds (but in this case just in 2D). It is an example of emergent behaviour; that is, the complexity of Boids arises from the interaction of individual agents adhering to a set of simple rules, (i) separation: steering to avoid crowding lo…

boids.cljs

(ns boids
  (:use [enchilada :only [canvas ctx value-of canvas-size]]
        [jayq.core :only [show]]
        [monet.core :only [animation-frame]]
        [monet.canvas :only [save restore 
                             begin-path move-to line-to close-path 
                             stroke stroke-style fill fill-rect fill-style 
                             rotate translate]]
        [boids.rules :only [step make-boid]])
  (:require [boids.vector :refer [heading]]))

(def r (js/parseFloat (value-of :r 3.0)))
(def width (first (canvas-size)))
(def height (second (canvas-size)))
(def stepper (step width height r))
(def rng (range (js/parseInt (value-of :boids 75))))
(def pi-over-2 (/ Math/PI 2))

(def boids 
  (mapv 
    #(make-boid (/ width 2) (/ height 2))
    rng))

(defn render! [ctx boids size]
  (->
    ctx
    (fill-style :white)
    (fill-rect {:x 0 :y 0 :w width :h height})
    (stroke-style :darkcyan)
    (fill-style :lightcyan))
  (doseq [boid boids
          :let [[x y] (:location boid)
                theta (+ (heading (:velocity boid)) pi-over-2)]]
    (->
      ctx
      (save)
      (translate x y)
      (rotate theta)
      (begin-path)
      (move-to 0 (* size -2))
      (line-to (- size) (* size 2))
      (line-to size (* size 2))
      (close-path)
      (fill)
      (stroke)
      (restore))))

(defn update [boids idx]
  (assoc boids idx (stepper (boids idx) boids)))

(defn animate [ctx boids size]
  (letfn [(loop [state]
            (fn []
              (animation-frame (loop (reduce update state rng)))
              (render! ctx state size)))]
    ((loop boids))))

(show canvas)
(animate ctx boids r)

rules.cljs

(ns boids.rules
  (:require [boids.vector :refer [make-vector rand-vector add sub mult div normalize dist mag limit add-all]]))

(def max-speed 2.0)
(def max-force 0.03)
(def zero-vec (make-vector 0 0))

(defn make-boid [x y]
  {:location (make-vector x y)
   :velocity (rand-vector 1)
   :acceleration (make-vector 0 0)})

(defn- apply-forces [boid forces]
  (assoc boid
    :acceleration (add
                    (:acceleration boid)
                    (add-all forces))))

(defn- diff [location1 location2 dist]
  (->
    (sub location1 location2)
    normalize
    (div dist)))

(def separate
  "Checks for nearby boids and steers away"
 {:init [0 zero-vec]
  :too-close? (fn [d] (and (> d 0.0) (< d 25.0)))
  :accumulator
    (fn [boid other d [count steer]]
      [(inc count) (add steer (diff (:location boid) (:location other) d))])
  :final
    (fn [boid [count steer]]
      (cond
        (pos? count)       (recur boid [0 (div steer count)])
        (pos? (mag steer)) (->
                             steer
                             normalize
                             (mult max-speed)
                             (sub (:velocity boid))
                             (limit max-force)
                             (mult 1.5))
        :else              (mult steer 1.5)))})

(def align
 {:init [0 zero-vec]
  :too-close? (fn [d] (and (> d 0.0) (< d 50.0)))
  :accumulator
    (fn [boid other d [count sum]]
      [(inc count) (add sum (:velocity other))])
  :final
    (fn [boid [count sum]]
      (if (pos? count)
        (->
          sum
          (div count)
          normalize
          (mult max-speed)
          (sub (:velocity boid))
          (limit max-force))
        zero-vec))})

(def cohesion
 {:init [0 zero-vec]
  :too-close? (fn [d] (and (> d 0.0) (< d 50.0)))
  :accumulator
    (fn [boid other d [count sum]]
      [(inc count) (add sum (:location other))])
  :final
    (fn [boid [count sum]]
      (if (pos? count)
        (->
          sum
          (div count)
          (sub (:location boid))
          normalize
          (mult max-speed)
          (sub (:velocity boid))
          (limit max-force))
        zero-vec))})

(defn- calc-forces
  [boid peers & forces]
    (loop [ps   peers
           data (map :init forces)]
      ;(println data)
      (if (empty? ps)
        (map (fn [f d] ((:final f) boid d)) forces data)
        (let [other (first ps)
              distance (dist (:location boid) (:location other))]
          (recur
            (next ps)
            (map
              (fn [f d]
                   (if ((:too-close? f) distance)
                     ((:accumulator f) boid other distance d)
                     d))
              forces data))))))

(defn- flock [boid peers]
  (apply-forces boid
    (calc-forces boid peers
      separate
      align
      cohesion)))

(defn- update-location [boid]
  (let [new-velocity (->
                       (:velocity boid)
                       (add (:acceleration boid))
                       (limit max-speed))
        new-location (->
                       (:location boid)
                       (add new-velocity))]
    (assoc boid
      :location new-location
      :velocity new-velocity
      :acceleration zero-vec)))

(defn- bounds [value lower-limit upper-limit]
  (cond
    (< value lower-limit) upper-limit
    (> value upper-limit) lower-limit
    :else                 value))

(defn- wrap-around [boid w h r]
  (let [[x y] (:location boid)
        new-x (bounds x (- r) (+ w r))
        new-y (bounds y (- r) (+ h r))]
    (if (and (= x new-x) (= y new-y))
      boid
      (assoc boid :location (make-vector new-x new-y)))))

(defn step [w h r]
  (fn [boid peers]
    (->
      boid
      (flock peers)
      (update-location)
      (wrap-around w h r))))

vector.cljs

(ns boids.vector)

(defn add [[x1 y1] [x2 y2]]
  [(+ x1 x2) (+ y1 y2)])

(defn sub [[x1 y1] [x2 y2]]
  [(- x1 x2) (- y1 y2)])

(defn mult [[x y] n]
  [(* x n) (* y n)])

(defn div [[x y] n]
  [(/ x n) (/ y n)])

(defn dot [[x1 y1] [x2 y2]]
  (+
    (* x1 x2)
    (* y1 y2)))

(defn mag-sq [xy]
  (dot xy xy))

(defn mag [xy]
  (Math/sqrt (mag-sq xy)))

(defn normalize [xy]
  (let [m (mag xy)]
    (if (and (not= m 0) (not= m 1))
      (div xy m)
      xy)))

(defn dist [[x1 y1] [x2 y2]]
  (let [dx (- x1 x2)
        dy (- y1 y2)]
    (Math/sqrt
      (+
       (* dx dx)
       (* dy dy)))))

(defn limit [xy max]
  (if (> (mag-sq xy) (* max max))
    (-> xy normalize (mult max))
    xy))

(defn rotate [[x y] theta]
  [
    (- (* x (Math/cos theta))
       (* y (Math/sin theta)))
    (+ (* x (Math/sin theta))
       (* y (Math/cos theta)))])

(defn heading [[x y]]
  (- (Math/atan2 (- y) x)))

(defn rand-vector [n]
  (let [theta (* 2 Math/PI (rand))]
    [(* n (Math/sin theta)) (* n (Math/cos theta))]))

(defn make-vector [x y]
  [x y])

(defn add-all [vectors]
  (loop [vs vectors
         accum-x 0
         accum-y 0]
    (if (empty? vs)
      [accum-x accum-y]
      (let [[x y] (first vs)]
        (recur
          (rest vs)
          (+ accum-x x)
          (+ accum-y y))))))