Initial sketches toward a 2d swarm-like alife system in Clojure/Quil

vp2d.clj

;; Initial sketches toward a 2d swarm-like alife system in Clojure/Quil
;; Lee Spector, [email protected], 20140409

(ns vp2d.core
  (:use quil.core)
  (:gen-class))

(def all-pods (atom []))

(def iteration (atom 0))

(def two-pi (* 2 Math/PI))

(def screen-size 750)

(def pod-size 20)

(defn random-pod []
  {:id (gensym "pod-")
   :position [(rand-int screen-size) (rand-int screen-size)]
   :rotation (rand two-pi)
   :velocity [(- (rand 2.0) 1.0) (- (rand 2.0) 1.0)]
   :wander-constant  2.0
   :world-center-constant 0.1
   :center-constant 0.1 
   :velocity-constant 1.0
   :spacing-constant 1.0
   :max-velocity 10
   :max-acceleration 2
   :cruise-distance 2
   :neighbors []
   })

(defn add-random-pod []
  (swap! all-pods
         conj
         (random-pod)))

(defn setup []
  (smooth)
  (no-stroke)
  (doall (repeatedly 1000 add-random-pod)))

(defn wrap-angle
  [a]
  (cond (< a 0.0) (- two-pi a)
        (> a two-pi) (- a two-pi)
        :else a))

(defn draw-pods []
  (doseq [p @all-pods]
    (let [[x y] (:position p)]
      (push-matrix)
      (translate x y)
      (rotate (:rotation p))
      ;; outer membrane
      (fill 128, 255, 0, 100)
      (ellipse 0 0 pod-size pod-size)
      ;; nucleus
      (fill 32, 64, 1, 196) 
      (ellipse 0 0 (/ pod-size 2) (/ pod-size 2))
      ;; heading, relative to 12 o'clock
      (fill 255, 255, 0, 196)
      (ellipse 0 (* pod-size -0.375) (* pod-size 0.25) (* pod-size 0.25))
      (pop-matrix)
      )))

(defn length [[x y]]
  (sqrt (+ (* x x) (* y y))))

(defn nrm [xy]
  (let [len (length xy)]
    (if (zero? len)
      xy
      (map #(/ % len) xy))))

(defn *v [& vecs-or-nums]
  (apply map * (map #(if (number? %) [% %] %) vecs-or-nums)))

(defn +v [& vecs-or-nums]
  (apply map + (map #(if (number? %) [% %] %) vecs-or-nums)))

(defn -v [& vecs-or-nums]
  (apply map - (map #(if (number? %) [% %] %) vecs-or-nums)))

(defn sign [n] (if (neg? n) -1 1))

(defn wrap ;; to [-1 1]
  [n]
  (* (sign n) (mod (Math/abs n) 1)))

(defn pd [n d]
  (if (zero? d) 0.0 (/ n d)))

(defn velocity->rotation
  [[x y]]
  (let [atan #(Math/atan %)
        ;; http://en.wikipedia.org/wiki/Atan2
        atan2 (fn [y x]
                (cond (> x 0) (atan (/ y x))
                      (and (>= y 0) (< x 0)) (+ (atan (/ y x)) Math/PI)
                      (and (< y 0) (< x 0)) (- (atan (/ y x)) Math/PI)
                      (and (> y 0) (= x 0)) (/ Math/PI 2)
                      (and (< y 0) (= x 0)) (- (/ Math/PI 2))
                      :else 0)) ]
    ;;http://stackoverflow.com/questions/2276855/xna-2d-vector-angles-whats-the-correct-way-to-calculate
    (atan2 x (- y))
    ))
    

(defn fly
  [pod]
  (let [neighbors (:neighbors pod)
        close-neighbors (filter #(< (length (map - (:position pod) (:position %)))
                                    (:cruise-distance pod))
                                neighbors)
        acceleration (*v (:max-acceleration pod)
                         (nrm 
                           (+v (*v (:world-center-constant pod)
                                    (nrm (if (> (length (-v (:position pod) [500 500])) 10)
                                           (-v [500 500] (:position pod))
                                           [0 0])))
                               (*v (:center-constant pod)
                                   (nrm (if (empty? neighbors)
                                          [0 0]
                                          (map - 
                                               (map #(/ % (count neighbors))
                                                    (apply +v (map :position neighbors)))
                                               (:position pod)))))
                               (*v (:velocity-constant pod)
                                   (nrm (if (empty? neighbors)
                                          [0 0]
                                          (map - 
                                               (map #(/ % (count neighbors))
                                                    (apply +v (map :velocity neighbors)))
                                               (:velocity pod)))))
                               (*v (:spacing-constant pod)
                                   (nrm (if (empty? close-neighbors)
                                          [0 0]
                                          (apply +v (map #(map - 
                                                               (:position pod)
                                                               (:position %))
                                                         close-neighbors)))))
                               (*v (:wander-constant pod)
                                    (nrm (repeatedly 2 #(- (* (rand) 2) 1)))))))
        ;_ (println "acceleration" acceleration)
        velocity (let [new-velocity (map + (:velocity pod) acceleration)]
                   (if (> (length new-velocity) (:max-velocity pod))
                     (*v (:max-velocity pod) (nrm new-velocity))
                     new-velocity))
        position (map + (:position pod) velocity)]
    (-> pod
      (assoc :velocity velocity)
      (assoc :position position)
      (assoc :rotation (velocity->rotation (nrm velocity)))
      )))

(defn move-pods
  []
  (swap! all-pods
         (fn [pods]
           (doall (pmap fly pods)))))

(defn xy->gridxy
  [xy alpha steps step-size]
  (doall (map (fn [coord] 
                (max 0 
                     (min (dec steps) 
                          (int (/ (- coord alpha) step-size)))))
              xy)))

(defn make-world-grid
  [pods alpha steps step-size]
  (loop [grid (vec (repeat steps (vec (repeat steps []))))
         remaining (map #(assoc % :neighbors nil) pods)]
    (if (empty? remaining)
      grid
      (recur (update-in grid 
                        (xy->gridxy (:position (first remaining)) alpha steps step-size)
                        conj
                        (first remaining))
             (rest remaining)))))

(defn update-neighbors
  []
  (swap! all-pods
         (fn [pods]
           (let [alpha (apply min (map #(apply min (:position %)) pods))
                 omega (apply max (map #(apply max (:position %)) pods))
                 delta pod-size
                 steps (max 1 (int (/ (- omega alpha) delta)))
                 step-size (int (/ (- omega alpha) steps))
                 world-grid (make-world-grid pods alpha steps step-size)]
             (doall (map (fn [p]
                           (let [[x y] (xy->gridxy (:position p) alpha steps step-size)
                                 in-range (fn [c] (<= 0 c (dec steps)))
                                 window (fn [c] (map #(+ c %) [-1 0 1]))]
                             (assoc p :neighbors
                                    (filter #(< (length (map - 
                                                             (:position p)
                                                             (:position %)))
                                                delta)
                                            (apply concat
                                                   (doall (for [xs (filter in-range (window x))
                                                                ys (filter in-range (window y))]
                                                            (get-in world-grid [xs ys]))))))))
                         pods))))))

(defn print-stats []
  (println "avg neighbors" (float (/ (reduce + (map count (map :neighbors @all-pods)))
                                     (count @all-pods)))))

(defn draw
  []
  (background 175 175 205)
  (swap! iteration inc)
  (move-pods)
  (draw-pods)
  (update-neighbors)
  ;(println @all-pods)
  ;(print-stats)
  )

(defn -main [& args]
  (sketch
    :title "vp2d"
    :setup setup
    :draw draw
    :size [screen-size screen-size]
    ;:renderer :opengl #_:p3d
    ;:mouse-moved mouse-moved
    ;:on-close #(System/exit 0)
    ))

;(-main)