near/heyarne.thi.ng.utils
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Simplify poisson-disk-sampling and make it more performant

Browse source
This commit is contained in:
heyarne 2020-07-22 14:11:47 +02:00
commit 8ba6a1fc8d
1 changed files with 20 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

36
src/heyarne/thi/ng/utils/poisson.clj
View file

@ -25,9 +25,8 @@
([container k r] ([container k r]
(poisson container k r (g/random-point-inside container))) (poisson container k r (g/random-point-inside container)))
([container k r seed] ([container k r seed]
(let [bounds (g/bounds container) (let [in-container? (partial g/contains-point? container)]
keep-sample? (partial g/contains-point? bounds)] (loop [tree (tree/quadtree (g/bounds container))
(loop [tree (tree/quadtree bounds)
active #{seed}] active #{seed}]
(if (seq active) (if (seq active)
;; while the active list is not empty, choose a random index from it and ;; while the active list is not empty, choose a random index from it and
@ -39,19 +38,21 @@
(comp (take k) (comp (take k)
(map #(-> (m/*! % (+ r (m/random r))) (map #(-> (m/*! % (+ r (m/random r)))
(m/+! sample))) (m/+! sample)))
(filter keep-sample?)) (filter in-container?))
;; take the first sample that is not within distance r ;; take the first sample that is not within distance r
(find-first #(not (tree/points-in-circle? tree % r))) (find-first #(not (tree/points-in-circle? tree % r)))
nil nil
(repeatedly v/randvec2))] (repeatedly v/randvec2))]
(if fit (if fit
;; If a point is adequately far from existing samples, emit it as the next sample and add it to the active list ;; 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)) (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 ;; 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 ;; we're done! let's flatten the tree; we don't need to select anything
;; our generated samples by calling #(contains-point? container %) ;; because all points in the tree are restricted to our container anyways
(persistent! (tree/select-with tree (partial g/intersect-shape container) (partial g/contains-point? container)))))))) (persistent! (tree/select-with tree (constantly true) (constantly true))))))))
(comment (comment
;; let's run some benchmarks (on my Thinkpad x230 from 2012) ;; let's run some benchmarks (on my Thinkpad x230 from 2012)
@ -62,17 +63,18 @@
(crit/with-progress-reporting (crit/with-progress-reporting
(crit/bench (poisson (r/rect [-100 -100] [100 100]) 20 10))) (crit/bench (poisson (r/rect [-100 -100] [100 100]) 20 10)))
;; Execution time mean : 25.688646 ms ;; Execution time mean : 25.615302 ms
;; Execution time std-deviation : 1.258751 ms ;; Execution time std-deviation : 1.870445 ms
;; Execution time lower quantile : 24.332119 ms ( 2.5%) ;; Execution time lower quantile : 24.278897 ms ( 2.5%)
;; Execution time upper quantile : 28.330404 ms (97.5%) ;; Execution time upper quantile : 29.560016 ms (97.5%)
;; Overhead used : 1.897778 ns ;; Overhead used : 1.897778 ns
(crit/with-progress-reporting (crit/with-progress-reporting
(crit/bench (poisson (c/circle [-100 -100] 200) 20 10))) (crit/bench (poisson (c/circle [-100 -100] 200) 20 10)))
;; Execution time mean : 126.305551 ms ;; Execution time mean : 99.726122 ms
;; Execution time std-deviation : 8.107330 ms ;; Execution time std-deviation : 4.367676 ms
;; Execution time lower quantile : 119.070887 ms ( 2.5%) ;; Execution time lower quantile : 94.578971 ms ( 2.5%)
;; Execution time upper quantile : 147.724269 ms (97.5%) ;; Execution time upper quantile : 110.680752 ms (97.5%)
;; Overhead used : 1.897778 ns ;; Overhead used : 1.897778 ns
) )