Create a gist now

Instantly share code, notes, and snippets.

@rm-hull /boids.cljs
Last active Dec 26, 2015

What would you like to do?
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…
(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
#(make-boid (/ width 2) (/ height 2))
(defn render! [ctx boids size]
(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)]]
(translate x y)
(rotate theta)
(move-to 0 (* size -2))
(line-to (- size) (* size 2))
(line-to size (* size 2))
(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)
(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)
(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)))
(fn [boid other d [count steer]]
[(inc count) (add steer (diff (:location boid) (:location other) d))])
(fn [boid [count steer]]
(pos? count) (recur boid [0 (div steer count)])
(pos? (mag steer)) (->
(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)))
(fn [boid other d [count sum]]
[(inc count) (add sum (:velocity other))])
(fn [boid [count sum]]
(if (pos? count)
(div count)
(mult max-speed)
(sub (:velocity boid))
(limit max-force))
(def cohesion
{:init [0 zero-vec]
:too-close? (fn [d] (and (> d 0.0) (< d 50.0)))
(fn [boid other d [count sum]]
[(inc count) (add sum (:location other))])
(fn [boid [count sum]]
(if (pos? count)
(div count)
(sub (:location boid))
(mult max-speed)
(sub (:velocity boid))
(limit max-force))
(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))]
(next ps)
(fn [f d]
(if ((:too-close? f) distance)
((:accumulator f) boid other distance d)
forces data))))))
(defn- flock [boid peers]
(apply-forces boid
(calc-forces boid peers
(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]
(< 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))
(assoc boid :location (make-vector new-x new-y)))))
(defn step [w h r]
(fn [boid peers]
(flock peers)
(wrap-around w h r))))
(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)
(defn dist [[x1 y1] [x2 y2]]
(let [dx (- x1 x2)
dy (- y1 y2)]
(* dx dx)
(* dy dy)))))
(defn limit [xy max]
(if (> (mag-sq xy) (* max max))
(-> xy normalize (mult max))
(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)]
(rest vs)
(+ accum-x x)
(+ accum-y y))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment