convex-hull.cljs

(ns giornata.core
  (:require [enchilada :refer [canvas ctx value-of canvas-size]]
            [jayq.core :refer [show]]
            [monet.core :refer [animation-frame]]
            [monet.canvas :refer [save restore
                                  circle
                                  begin-path move-to line-to close-path
                                  stroke stroke-style fill fill-rect fill-style
                                  rotate translate]]
            [giornata.hull :refer [convex-hull]]
            [giornata.gen :refer [gen-points]]
            [cljs.core.async :as a :refer [chan <! >! timeout]])
  (:require-macros [cljs.core.async.macros :refer [go alt!]]))

(enable-console-print!)

(def width (first (canvas-size)))
(def height (second (canvas-size)))
(def padding 50)
(def delay 250)

(defn points
  [w h]
  (gen-points 20
              padding (- width padding)
              padding (- height padding)))

(defn draw-points
  [ctx points]
  (doseq [[x y] points]
    (when (and x y)
      (circle ctx {:x x :y y :r 4})
      (stroke ctx)))
  ctx)

(defn draw-hull
  [ctx points]
  (when points
    (begin-path ctx)
    (doseq [[[ax ay] [bx by]] (partition 2 1 points)]
      (move-to ctx ax ay)
      (line-to ctx bx by))
    (close-path ctx))

  ctx)

(defn render!
  [ctx {:keys [points op hull dropped all-dropped]} & [other-hull]]
  (-> ctx
      (fill-style :white)
      (fill-rect {:x 0 :y 0 :w width :h height})

      (fill-style :white)
      (stroke-style :#6A4A3C)
      (draw-points points)

      (fill-style :#00A0B0)
      (stroke-style :transparent)
      (draw-points hull)

      (fill-style :#F9BF76)
      (stroke-style :transparent)
      (draw-points all-dropped)

      (fill-style :#EB6841)
      (stroke-style :transparent)
      (draw-points [dropped])

      (stroke-style :#00A0B0)
      (draw-hull hull)
      (stroke)
      (draw-hull other-hull)
      (stroke)))

(defn render-final!
  [ctx points upper lower]
  (-> ctx
      (fill-style :white)
      (fill-rect {:x 0 :y 0 :w width :h height})

      (fill-style :#F9BF76)
      (stroke-style :transparent)
      (draw-points points)

      (fill-style :#00A0B0)
      (stroke-style :transparent)
      (draw-points upper)
      (draw-points lower)

      (stroke-style :#00A0B0)
      (draw-hull upper)
      (stroke)
      (draw-hull lower)
      (stroke)))

(defn animate [ctx steps]
  (go
   (doseq [step (:upper steps)]
     (animation-frame identity)
     (render! ctx step)
     (<! (timeout delay)))
   (let [other-hull (:hull (last (:upper steps)))]
     (doseq [step (:lower steps)]
       (animation-frame identity)
       (render! ctx step other-hull)
       (<! (timeout delay))))

   (render-final! ctx
                  (:points steps)
                  (-> steps :upper last :hull)
                  (-> steps :lower last :hull))))

(show canvas)
(animate ctx (convex-hull (points width height)))
;;(animate ctx (convex-hull [[20 120] [30 70] [60 180] [120 60] [160 140]]))

gen.cljs

(ns giornata.gen)

(defn gen-points
  "Generates a vector of n points with coordinates in [0, max-x) and [0, max-y)."
  [n min-x max-x min-y max-y]
  (for [i (range n)]
    [(+ (rand-int (- max-x min-x)) min-x)
     (+ (rand-int (- max-y min-y)) min-y)]))

hull.cljs

(ns giornata.hull)

(defn point-sort
  [points]
  (sort (fn [[ax ay] [bx by]]
          (or (< ax bx)
              (and (= ax bx)
                   (< ay by))))
        points))

(defn signed-area
  [a b c]
  (* (/ 1 2)
     (+ (* (first b) (second a) -1)
        (* (first c) (second a))
        (* (first a) (second b))
        (* (first c) (second b) -1)
        (* (first a) (second c) -1)
        (* (first b) (second c)))))

(defn right-turn?
  [a b c]
  (< (signed-area a b c) 0))

(defn collinear?
  [a b c]
  (< (signed-area a b c) 0.0001))

;;[points (vec (concat (subvec hull 0 (- (count hull) 2)
;;                     (subvec hull (dec (count hull)) (count hull))))]

(defn step-hull
  [{:keys [points hull all-dropped]}]
  (cond (and (> (count hull) 2)
             (not (apply right-turn? (take-last 3 hull))))
        (let [dropped (nth hull (- (count hull) 2))]
          {:op :drop
           :points points
           :hull (concat (drop-last 2 hull)
                         [(last hull)])
           :all-dropped (conj all-dropped dropped)
           :dropped dropped})

        (empty? points)
        {:op :fin
         :points nil
         :hull hull
         :all-dropped all-dropped}
        
        :else
        {:op :add
         :points (rest points)
         :hull (conj (vec hull) (first points))
         :all-dropped all-dropped}))

(defn convex-hull
  [points]
  (let [sorted (point-sort points)
        upper (iterate step-hull {:op :start
                                  :points sorted})
        lower (iterate step-hull {:op :start
                                  :points (reverse sorted)})]
    {:points points
     :upper (take-while #(not (= (:op %) :fin)) upper)
     :lower (take-while #(not (= (:op %) :fin)) lower)}))