commit 0d48190199885b1d14e35b83052b7a8890785285 Author: heyarne Date: Sun Jul 12 15:26:17 2020 +0200 Initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..bc4b3e6 --- /dev/null +++ b/.gitignore @@ -0,0 +1,72 @@ + +# Created by https://www.toptal.com/developers/gitignore/api/clojure,emacs +# Edit at https://www.toptal.com/developers/gitignore?templates=clojure,emacs + +### Clojure ### +pom.xml +pom.xml.asc +*.jar +*.class +/lib/ +/classes/ +/target/ +/checkouts/ +.lein-deps-sum +.lein-repl-history +.lein-plugins/ +.lein-failures +.nrepl-port +.cpcache/ + +### Emacs ### +# -*- mode: gitignore; -*- +*~ +\#*\# +/.emacs.desktop +/.emacs.desktop.lock +*.elc +auto-save-list +tramp +.\#* + +# Org-mode +.org-id-locations +*_archive + +# flymake-mode +*_flymake.* + +# eshell files +/eshell/history +/eshell/lastdir + +# elpa packages +/elpa/ + +# reftex files +*.rel + +# AUCTeX auto folder +/auto/ + +# cask packages +.cask/ +dist/ + +# Flycheck +flycheck_*.el + +# server auth directory +/server/ + +# projectiles files +.projectile + +# directory configuration +.dir-locals.el + +# network security +/network-security.data + + +# End of https://www.toptal.com/developers/gitignore/api/clojure,emacs diff --git a/deps.edn b/deps.edn new file mode 100644 index 0000000..7e37fba --- /dev/null +++ b/deps.edn @@ -0,0 +1,3 @@ +{:paths ["src"] + :deps {thi.ng/geom {:mvn/version "1.0.0-RC4"} + criterium {:mvn/version "0.4.6"}}} diff --git a/src/heyarne/thi/ng/utils/poisson.clj b/src/heyarne/thi/ng/utils/poisson.clj new file mode 100644 index 0000000..a9f01fe --- /dev/null +++ b/src/heyarne/thi/ng/utils/poisson.clj @@ -0,0 +1,72 @@ +(ns heyarne.thi.ng.utils.poisson + (:require + [thi.ng.math.core :as m] + [thi.ng.geom.vector :as v] + [thi.ng.geom.core :as g] + [thi.ng.geom.spatialtree :as tree])) + +;; Poisson-Disk-Sampling +;; +;; This namespace implements Poisson-Disk-Sampling in two dimensions with the help of a quadtree. + +(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 + vector of samples. When no `seed` is given, starts at a random point + inside `container`." + ([container k r] + (poisson container k r (g/random-point-inside container))) + ([container k r seed] + (let [bounds (g/bounds container) + 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))) + ;; 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))] + (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))))))))) + +(comment + ;; let's run some benchmarks (on my Thinkpad x230 from 2012) + + (require '[criterium.core :as crit]) + (require '[thi.ng.geom.circle :as c]) + (require '[thi.ng.geom.rect :as r]) + + (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 + + (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 + )