Last active
December 26, 2015 11:39
-
-
Save rm-hull/7145520 to your computer and use it in GitHub Desktop.
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…
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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)))) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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)))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment