scatterplot.clj

(require '[scicloj.metamorph.ml.rdatasets :as rdatasets])
(require '[tablecloth.api :as tc])
(require '[membrane.ui :as ui ])
(require '[membrane.component :refer [defeffect defui]])
(require '[wadogo.scale :as s])
(require '[membrane.skia.paragraph :as para])
(import 'com.github.davidmoten.rtree.RTree
        'com.github.davidmoten.rtree.Entries
        'com.github.davidmoten.rtree.geometry.Geometries)

(def penguins (tc/drop-missing (rdatasets/palmerpenguins-penguins)))

(defn circle [x y radius]
  (ui/translate (- x radius)
                (- y radius)
                (ui/rounded-rectangle (* 2 radius)
                        (* 2 radius)
                        radius)))

(def x-data (:bill-length-mm penguins))
(def y-data (:bill-depth-mm penguins))

(def r 3)
(def plot-width 400)
(def plot-height 300)
(def tick-size 10)

(def x-scale 
  (s/scale :linear {:domain [(* 0.9 (apply min x-data)) 
                             (* 1.1 (apply max x-data))]
                    :range [0 plot-width]}))

(def y-scale 
  (s/scale :linear {:domain [(* 0.9 (apply min y-data))
                             (* 1.1 (apply max y-data))]
                    :range [0 (- plot-height)]}))

(defn ->screen-x [x] 
  (x-scale x))

(defn ->screen-y [y]
  (y-scale y))

(def xs
  (into []
        (map ->screen-x)
        x-data))

(def ys
  (into []
        (map ->screen-y)
        y-data))

(def marks
  (ui/with-color 
   [0.4 0.4 0.4]
   (ui/with-style 
    ::ui/style-stroke-and-fill
    (into []
          (map (fn [[x y]]
                 (circle x y r)))
          (map vector xs ys)))))

(defn centered-text [x y text]
  (let [p (para/paragraph text
                          nil
                          {:paragraph-style/text-style
                           #:text-style {:font-size 12}})
        [w h] (ui/bounds p)]
    (ui/translate (+ x (- (quot w 2)))
                  (+ y (- (quot h 2)))
                  p)))

(defn right-aligned-text [x y text]
  (let [p (para/paragraph text
                          nil
                          {:paragraph-style/text-style
                           #:text-style {:font-size 12}})
        [w h] (ui/bounds p)]
    (ui/translate (- x w)
                  (+ y (- (quot h 2)))
                  p)))

(def x-tick-marks
  (into []
        (comp
         (map ->screen-x)
         (remove zero?)
         (map (fn [x]
                [;; tick label
                 (centered-text x 15
                                (format "%.0f" (s/inverse x-scale x) ))
                 ;; white background grid
                 (ui/with-color 
                  [1 1 1]
                  (ui/with-style 
                   ::ui/style-stroke
                   (ui/path [x 0] [x (second (s/range y-scale))])))
                 ;; tick mark
                 (ui/with-color 
                 [0 0 0]
                 (ui/with-style 
                  ::ui/style-stroke
                  (ui/path [x (quot tick-size 2)] [x (- (quot tick-size 2))])))])))
        (s/ticks x-scale)))

(def y-tick-marks
  (into []
        (comp
         (map ->screen-y)
         (remove zero?)
         (map (fn [y]
                [;; tick label
                 (right-aligned-text -10 y
                                     (format "%.0f" (s/inverse y-scale y) ))
                 ;; white background grid
                 (ui/with-color 
                  [1 1 1]
                  (ui/with-style 
                   ::ui/style-stroke
                   (ui/path [0 y] [(second (s/range x-scale)) y])))
                 ;; tick mark
                 (ui/with-color 
                  [0 0 0]
                  (ui/with-style 
                   ::ui/style-stroke
                   (ui/path [(quot tick-size 2) y] [(- (quot tick-size 2)) y])))
                 ])))
        (s/ticks y-scale)))


(def axes
  (ui/with-color 
   [0 0 0]
   (ui/with-style 
    ::ui/style-stroke
    [(ui/path [0 0] [(second (s/range x-scale)) 0])
     (ui/path [0 0] [0 (second (s/range y-scale))])])))

(def background
  (ui/filled-rectangle [0.95 0.95 0.95]
                       (second (s/range x-scale))
                       (second (s/range y-scale))))

(def x-scale-label 
  (centered-text (quot (second (s/range x-scale))
                       2)
                 35
                 "bill-length-mm"))

(def y-scale-label 
  (ui/rotate
   -90
   (centered-text (- (quot (second (s/range y-scale))
                           2))
                  -35
                  "bill-depth-mm")))

;; interactivity
(defn make-rtree [circles]
  (RTree/create (map (fn [{:keys [x y radius] :as circle}]
                       (let [geom (Geometries/circle
                                   (double x)
                                   (double y)
                                   (double radius))]
                         (Entries/entry circle geom)))
                     circles)))

(defn search-rtree [rt [x y]]
  (-> (.search ^RTree rt (Geometries/point (double x) (double y)))
      (.toBlocking)
      (.toIterable)
      (->> (map (fn [entry]
                  (.value ^com.github.davidmoten.rtree.Entry entry))))
      first))

(def chart-rtree
  (make-rtree
   (eduction
    (map (fn [[x y]]
           {:x x
            :y y
            :radius r}))
    (map vector xs ys))))

(defn wrap-interactive [{:keys [$mpos $hover-text $hover-mark] :as data}
                        body]
  (ui/on
   :mouse-down
   (fn [_]
     (membrane.skia/save-image "interactive-chart.png" 
                               (ui/padding 16 (my-chart data)))
     nil)
   :mouse-move
   (fn [[mx my]]
     (let [my (- my plot-height)
           [new-hover-text new-hover-mark]
           (when-let [{:keys [x y]} (search-rtree chart-rtree [mx my])]
             (let [bill-length (s/inverse x-scale x)
                   bill-depth (s/inverse y-scale y)]
               [(format "bill-length: %.1f\nbill-depth: %.1f" bill-length bill-depth )
                (ui/with-color 
                 [1 0 0]
                 (ui/with-style 
                  ::ui/style-stroke-and-fill
                  (circle x y r)))]))
           intents [[:set $mpos 
                     [(s/inverse x-scale mx)
                      (s/inverse y-scale my)]]]
           intents (if new-hover-text
                     (conj intents 
                           [:set $hover-text new-hover-text]
                           [:set $hover-mark new-hover-mark])
                     intents)]
       intents))
   
  body))

;; chart component
(defui my-chart [{:keys [hover-text hover-mark mpos] :as data}]
  (let [chart-graphic [background axes x-scale-label y-scale-label x-tick-marks y-tick-marks marks hover-mark]]
    (ui/translate 75 0
                  (ui/vertical-layout
                   (wrap-interactive
                    data
                    (ui/fixed-bounds 
                     [plot-width plot-height]
                     (ui/translate 0 plot-height chart-graphic)))
                   (ui/spacer 0 20)
                   (when mpos
                     (ui/label (format "x: %.0f\ny: %.0f" (first mpos) (second mpos))))
                   (when hover-text
                     (ui/label hover-text))))))

(comment
  ;; show interactive chart
  (dev/add-component-as-applet #'my-chart 
                             {})
  ,)