From a50ce7db4fbbaacad7f738603b9b60ed2a9f7f78 Mon Sep 17 00:00:00 2001
From: heyarne <arne@schlueter.is>
Date: Wed, 22 Jul 2020 09:45:00 +0200
Subject: [PATCH] Transducers are magical

---
 README.org                           |  2 +-
 src/heyarne/thi/ng/utils/poisson.clj | 60 +++++++++++++++-------------
 2 files changed, 34 insertions(+), 28 deletions(-)

diff --git a/README.org b/README.org
index 1d4c0de..e0becbe 100644
--- a/README.org
+++ b/README.org
@@ -1,6 +1,6 @@
 #+TITLE: heyarne.thi.ng/utils
 
-Contains some helpers when working with [[https://github.com/thi-ng/geom/tree/1.0.0-RC4][~thi.ng/geom~]].
+Contains some helpers when working with ~[[https://github.com/thi-ng/geom/tree/1.0.0-RC4][thi.ng/geom]]~.
 
 ** Implemented
 
diff --git a/src/heyarne/thi/ng/utils/poisson.clj b/src/heyarne/thi/ng/utils/poisson.clj
index a9f01fe..64598f4 100644
--- a/src/heyarne/thi/ng/utils/poisson.clj
+++ b/src/heyarne/thi/ng/utils/poisson.clj
@@ -9,6 +9,14 @@
 ;;
 ;; This namespace implements Poisson-Disk-Sampling in two dimensions with the help of a quadtree.
 
+(defn- find-first
+  "Returns a reducing function that returns the first item in a collection
+  satisifying `pred?`"
+  [pred?]
+  (completing (fn [_ candidate]
+                (when (pred? candidate)
+                  (reduced candidate)))))
+
 (defn poisson
   "Given a `container` to find points within, the numbers of samples to generate
   in each step `k` and a minimum distance between to samples `r`, returns a
@@ -21,31 +29,29 @@
          keep-sample? (partial g/contains-point? bounds)]
      (loop [tree (tree/quadtree bounds)
             active #{seed}]
-       (if (empty? active)
-         ;; we're done! let's flatten the tree. note that we throw out some of
-         ;; our generated samples by calling #(contains-point? container %)
-         (persistent! (tree/select-with tree (constantly true) (partial g/contains-point? container)))
+       (if (seq active)
          ;; while the active list is not empty, choose a random index from it and
          ;; generate up to `k` within a radius of [r, 2r]; for each point in turn,
          ;; check if it is within distance r of existing samples
          (let [sample (first active)
-               candidates (into []
-                                (comp
-                                 (map #(-> (m/*! % (+ r (m/random r)))
-                                           (m/+! sample)))
-                                 (filter keep-sample?))
-                                (repeatedly k v/randvec2))
-               fit (when (seq candidates)
-                     (reduce (fn
-                               ([_ candidate]
-                                (when-not (tree/points-in-circle? tree candidate r)
-                                  (reduced candidate))))
-                             candidates))]
+               fit (transduce
+                    ;; take k samples and keep the ones within our container
+                    (comp (take k)
+                          (map #(-> (m/*! % (+ r (m/random r)))
+                                    (m/+! sample)))
+                          (filter keep-sample?))
+                    ;; take the first sample that is not within distance r
+                    (find-first #(not (tree/points-in-circle? tree % r)))
+                    nil
+                    (repeatedly v/randvec2))]
            (if fit
              ;;  If a point is adequately far from existing samples, emit it as the next sample and add it to the active list
              (recur (g/add-point tree fit fit) (conj active fit))
              ;; if no such point is found, remove the sample from the list of active samples
-             (recur tree (disj active sample)))))))))
+             (recur tree (disj active sample))))
+         ;; we're done! let's flatten the tree. note that we throw out some of
+         ;; our generated samples by calling #(contains-point? container %)
+         (persistent! (tree/select-with tree (partial g/intersect-shape container) (partial g/contains-point? container))))))))
 
 (comment
   ;; let's run some benchmarks (on my Thinkpad x230 from 2012)
@@ -56,17 +62,17 @@
 
   (crit/with-progress-reporting
     (crit/bench (poisson (r/rect [-100 -100] [100 100]) 20 10)))
-  ;;            Execution time mean : 33.575985 ms
-  ;;   Execution time std-deviation : 805.351384 µs
-  ;;  Execution time lower quantile : 32.545556 ms ( 2.5%)
-  ;;  Execution time upper quantile : 35.375681 ms (97.5%)
-  ;;                  Overhead used : 1.869092 ns
+  ;;            Execution time mean : 25.688646 ms
+  ;;   Execution time std-deviation : 1.258751 ms
+  ;;  Execution time lower quantile : 24.332119 ms ( 2.5%)
+  ;;  Execution time upper quantile : 28.330404 ms (97.5%)
+  ;;                  Overhead used : 1.897778 ns
 
   (crit/with-progress-reporting
     (crit/bench (poisson (c/circle [-100 -100] 200) 20 10)))
-   ;;           Execution time mean : 170.229276 ms
-   ;;  Execution time std-deviation : 16.657318 ms
-   ;; Execution time lower quantile : 156.769577 ms ( 2.5%)
-   ;; Execution time upper quantile : 225.024192 ms (97.5%)
-   ;;                 Overhead used : 1.869092 ns
+  ;;            Execution time mean : 126.305551 ms
+  ;;   Execution time std-deviation : 8.107330 ms
+  ;;  Execution time lower quantile : 119.070887 ms ( 2.5%)
+  ;;  Execution time upper quantile : 147.724269 ms (97.5%)
+  ;;                  Overhead used : 1.897778 ns
   )