~jl2/quadtree

6142d911532c6555930f4f49f25c67b8c5a98844 β€” Jeremiah LaRocco 1 year, 5 months ago 13e498e + 85434a0 master
Merge remote-tracking branch 'srht/master'
8 files changed, 227 insertions(+), 144 deletions(-)

M bounds.lisp
M package.lisp
M point-quadtree.lisp
M pr-quadtree.lisp
M quadtree.lisp
M t/package.lisp
M util.lisp
M visualization.lisp
M bounds.lisp => bounds.lisp +28 -12
@@ 48,22 48,38 @@
          (vec2 x-max y-min)
          (vec2 x-max y-max))))

(defun random-point-in (bounds)
  "Return a list of four boundary points."
  (with-slots (x-min y-min x-max y-max) bounds
    (vec2 (+ x-min (* (- x-max x-min) (random 1.0)))
          (+ y-min (* (- y-max y-min) (random 1.0))))))

(defun random-points-in (bounds count)
  "Return a list of four boundary points."
  (with-slots (x-min y-min x-max y-max) bounds
    (loop for i below count collecting
         (vec2 (+ x-min (* (- x-max x-min) (random 1.0)))
               (+ y-min (* (- y-max y-min) (random 1.0)))))))

(defun split-bounds (bounds)
  (with-slots (x-min x-max y-min y-max) bounds
    (let ((x-mid (/ (+ x-max x-min) 2))
          (y-mid (/ (+ y-max y-min) 2)))
      (list (cons 'top-left (make-instance 'quadtree-bounds
                                              :x-min x-min :x-max x-mid
                                              :y-min y-mid :y-max y-max))
            (cons 'top-right (make-instance 'quadtree-bounds
                                               :x-min x-mid :x-max x-max
                                               :y-min y-mid :y-max y-max))
            (cons 'bottom-left (make-instance 'quadtree-bounds
                                           :x-min x-min :x-max x-mid
                                           :y-min y-min :y-max y-mid))
            (cons 'bottom-right (make-instance 'quadtree-bounds
                                            :x-min x-mid :x-max x-max
                                            :y-min y-min :y-max y-mid))))))
      (make-array 4
                  :initial-contents
                  (list 
                   (make-instance 'quadtree-bounds
                                  :x-min x-min :x-max x-mid
                                  :y-min y-mid :y-max y-max)
                   (make-instance 'quadtree-bounds
                                  :x-min x-mid :x-max x-max
                                  :y-min y-mid :y-max y-max)
                   (make-instance 'quadtree-bounds
                                  :x-min x-min :x-max x-mid
                                  :y-min y-min :y-max y-mid)
                   (make-instance 'quadtree-bounds
                                  :x-min x-mid :x-max x-max
                                  :y-min y-min :y-max y-mid))))))

(defmethod print-object ((bound quadtree-bounds) stream)
  (with-slots (x-min y-min x-max y-max) bound

M package.lisp => package.lisp +22 -9
@@ 16,14 16,25 @@

(defpackage :quadtree
  (:use #:cl #:j-utils #:alexandria #:3d-vectors)
  (:export #:split-size
           #:point-quadtree
           #:pr-quadtree
  (:export
   #:*top-left*
   #:*top-right*
   #:*bottom-left*
   #:*bottom-right*
           #:quadtree-bounds
           #:from-point-range
           #:inside-p
           #:bounds-to-points
           #:split-bounds
           #:random-point-in
           #:random-points-in

           #:split-size

           #:quadtree
           #:point-quadtree
           #:pr-quadtree

           #:qsize
           #:locate
           #:closest


@@ 31,13 42,11 @@
           #:depth-first
           #:remove-item
           #:remove-from
           #:range-find

           #:quadrant-of
           #:opposite-quadrant
           #:top-left
           #:top-right
           #:bottom-left
           #:bottom-right
           #:range-find

           #:make-entry
           #:is-point
           #:remove-value


@@ 45,5 54,9 @@
           #:contains
           #:view-quadtree
           #:random-quadtree
           #:build-grid-quadtree
           #:parametric-quadtree
           #:parametric-animation))
           #:parametric-animation
           #:benchmark-random-pr-quadtree-search
           #:benchmark-random-point-quadtree-search
           #:benchmark-grid-quadtree-search))

M point-quadtree.lisp => point-quadtree.lisp +21 -17
@@ 21,7 21,8 @@
  (:documentation "A point quadtree, where space is subdivided at each point."))

(defmethod insert ((qt point-quadtree) new-point new-item)
  (with-slots (entry size) qt
  (declare (optimize (speed 3) (safety 1) (debug 1)))
  (with-slots (entry children size) qt
    (incf size)
    (cond ((null entry)
           (setf entry (make-entry new-point new-item)))


@@ 31,24 32,26 @@

          (t
           (let ((quad (quadrant-of (slot-value entry 'point) new-point)))
             (when (null (slot-value qt quad))
               (setf (slot-value qt quad) (make-instance 'point-quadtree)))
             (insert (slot-value qt quad) new-point new-item))))))
             (when (null (aref children quad))
               (setf (aref children quad) (make-instance 'point-quadtree)))
             (insert (aref children quad) new-point new-item))))))

(defmethod depth-first ((qt point-quadtree) function)
  (with-slots (entry size top-left top-right bottom-left bottom-right) qt
    (when top-left
      (depth-first top-left function))
    (when top-right
      (depth-first top-right function))
    (when bottom-right
      (depth-first bottom-right function))
    (when bottom-left
      (depth-first bottom-left function))
  (declare (optimize (speed 3) (safety 1) (debug 1)))
  (with-slots (entry children size) qt
    (when (aref children *top-left*)
      (depth-first (aref children *top-left*) function))
    (when (aref children *top-right*)
      (depth-first (aref children *top-right*) function))
    (when (aref children *bottom-right*)
      (depth-first (aref children *bottom-right*) function))
    (when (aref children *bottom-left*)
      (depth-first (aref children *bottom-left*) function))
    (when entry
      (funcall function entry))))

(defmethod locate ((qt point-quadtree) the-item test)
  (declare (optimize (speed 3) (safety 1) (debug 1)))
  (let ((results nil))
    (depth-first
     qt


@@ 61,17 64,18 @@
  (error "Not implemented."))

(defmethod range-find ((qt point-quadtree) search-point range)
  (declare (optimize (speed 3) (safety 1) (debug 1)))
  (let ((bounds (from-point-range search-point range)))
    (labels
        ((rfind (qt)
           (with-slots (entry size) qt
           (with-slots (entry children size) qt
             (let* ((quadrants (mapcar (curry #'quadrant-of (slot-value entry 'point))
                                       (bounds-to-points bounds)))
                    (unique-quads (remove-duplicates quadrants :test #'equal))
                    (unique-quads (remove-duplicates quadrants :test #'=))
                    (rvals (loop
                              for quad in unique-quads
                              when (slot-value qt quad)
                              append (rfind (slot-value qt quad)))))
                              when (aref children quad)
                              append (rfind (aref children quad)))))
               (if (inside-p (slot-value entry 'point) bounds)
                 (cons entry rvals)
                 rvals)))))

M pr-quadtree.lisp => pr-quadtree.lisp +21 -17
@@ 26,31 26,34 @@
(declaim (inline needs-split))
(defun needs-split (qt)
  "Returns true when a quadtree has more than *split-size* entries."
  (declare (optimize (speed 3) (safety 1) (debug 1)))
  (with-slots (entries) qt
    (> (length entries) *split-size*)))

(defun split-quadtree (qt)
  "Split a quadtree into 4 new nodes."
  (with-slots (bounds entries size) qt
    (dolist (new-bound (split-bounds bounds))
      (let ((quad-name (car new-bound))
            (this-bound (cdr new-bound)))
        (setf (slot-value qt quad-name) (make-instance 'pr-quadtree :bounds this-bound))
        (dolist (entry entries)
          (when (inside-p (slot-value entry 'point) this-bound)
            (incf (slot-value (slot-value qt quad-name) 'size))
            (push entry (slot-value (slot-value qt quad-name) 'entries))))
        (when (needs-split (slot-value qt quad-name))
          (split-quadtree (slot-value qt quad-name)))))
  (declare (optimize (speed 3) (safety 1) (debug 1)))
  (with-slots (bounds children entries size) qt
    (loop for this-bound across (split-bounds bounds)
       for quad-idx from 0
       do
         (setf (aref children quad-idx) (make-instance 'pr-quadtree :bounds this-bound))
         (dolist (entry entries)
           (when (inside-p (slot-value entry 'point) this-bound)
             (incf (slot-value (aref children quad-idx) 'size))
             (push entry (slot-value (aref children quad-idx) 'entries))))
         (when (needs-split (aref children quad-idx))
           (split-quadtree (aref children quad-idx))))
    (setf entries nil)))

(defmethod insert ((qt pr-quadtree) new-point new-item)
  (with-slots (bounds entries size top-left top-right bottom-left bottom-right) qt
  (declare (optimize (speed 3) (safety 1) (debug 1)))
  (with-slots (bounds children entries size ) qt
    (when (not (inside-p new-point bounds))
      (error "~a is not inside quadtree bounds." new-point))
    (cond
      ;; Empty tree
      ((every #'null (list entries top-left top-right bottom-left bottom-right))
      ((every #'null (list entries (aref children *top-left*) (aref children *top-right*) (aref children *bottom-left*) (aref children *bottom-right*)))
       (setf entries (list (make-entry new-point new-item))))

      ;; Not empty but smaller than *split-size*


@@ 64,21 67,22 @@
                  (split-quadtree qt))))))
      (t
       (let ((quad (quadrant-of (midpoint bounds) new-point)))
         (insert (slot-value qt quad) new-point new-item))))
         (insert (aref children quad) new-point new-item))))
    (incf size)))


(defmethod range-find ((qt pr-quadtree) search-point range)
  (declare (optimize (speed 3) (safety 1) (debug 1)))
  (let ((find-bound (from-point-range search-point range)))
    (labels
        ((rfind (qt)
           (with-slots (entries bounds size) qt
           (with-slots (entries children bounds size) qt
             (if (null entries)
                 ;; Recursion case
                 ;; Entries is null, so all data is in subtrees
                 ;; For each quadtree, if it's qsize > 0 then 
                 (loop for quad in '(top-left bottom-left top-right bottom-right)
                    for sub-tree = (slot-value qt quad) then (slot-value qt quad)
                 (loop for quad in (list *top-left* *bottom-left* *top-right* *bottom-right*)
                    for sub-tree = (aref children quad) then (aref children quad)
                    when (and sub-tree (not (zerop (qsize sub-tree))))
                    append (rfind sub-tree))
                 ;; End recursion case

M quadtree.lisp => quadtree.lisp +25 -19
@@ 16,18 16,25 @@

(in-package :quadtree)

(defparameter *top-left* 0)
(defparameter *top-right* 1)
(defparameter *bottom-left* 2)
(defparameter *bottom-right* 3)

(defclass quadtree ()
  (
   (size :initform 0 :type fixnum)
   (top-left :initform nil :type (or null quadtree))
   (top-right :initform nil :type (or null quadtree))
   (bottom-left :initform nil :type (or null quadtree))
   (bottom-right :initform nil :type (or null quadtree)))
  ((size :initform 0 :type fixnum)
   (children :initform (make-array 4 :element-type '(or null quadtree::quadtree) :initial-element nil) :type (simple-vector 4))
   ;; (top-left :initform nil :type (or null quadtree))
   ;; (top-right :initform nil :type (or null quadtree))
   ;; (bottom-left :initform nil :type (or null quadtree))
   ;; (bottom-right :initform nil :type (or null quadtree))
   )
  (:documentation "A QuadTree class."))

(defgeneric qsize (qt)
  (:documentation "Returns the number of points in the quadtree."))

(declaim (inline insert locate depth-first closest range-find remove-item remove-from qsize))
(defgeneric insert (qt point new-item)
  (:documentation "Inserts item into qt at point.  Duplicates are allowed."))



@@ 66,27 73,26 @@
  "Returns the quadrant of pt relative to root."
  (cond ((and (< (vx pt) (vx root))
              (>= (vy pt) (vy root)))
         'top-left)
         *top-left*)
        ((and (< (vx pt) (vx root))
              (< (vy pt) (vy root)))
         'bottom-left)
         *bottom-left*)
        ((and (>= (vx pt) (vx root))
              (>= (vy pt) (vy root)))
         'top-right)
         *top-right*)
        ((and (>= (vx pt) (vx root))
              (< (vy pt) (vy root)))
         'bottom-right)))
         *bottom-right*)))

(defun opposite-quadrant (quad)
  "Returns the quadrant 180 degrees from quad."
  (cond ((eq quad 'top-left)
         'bottom-right)
        ((eq quad 'top-right)
         'bottom-left)
        ((eq quad 'bottom-left)
         'top-right)
        ((eq quad 'bottom-right)
         'top-left)
  (cond ((eq quad *top-left*)
         *bottom-right*)
        ((eq quad *top-right*)
         *bottom-left*)
        ((eq quad *bottom-left*)
         *top-right*)
        ((eq quad *bottom-right*)
         *top-left*)
        (t (error "Unknown quadrant! ~a" quad))))



M t/package.lisp => t/package.lisp +10 -18
@@ 62,13 62,6 @@
      (is-true (= 2 (length lr)))
      (is-true (find rp3 lr :test #'v=)))))

(defun build-grid-quadtree (type width height)
  (let ((qt (make-instance type)))
    (dotimes (i width)
      (dotimes (j height)
        (insert qt (vec2 i j) (* i j))))
    qt))

(test point-quadtree-range-find
  (let ((qt (make-instance 'point-quadtree)))
    (insert qt (vec2 0.0 0.0) 1)


@@ 78,8 71,7 @@
    (insert qt (vec2 4.0 0.0) 5)
    (insert qt (vec2 5.0 0.0) 6)
    (is-true (= 2 (length (range-find qt (vec2 2.5 0.0) 1.0)))))

  (let* ((qt (build-grid-quadtree 'point-quadtree 5 5))
  (let* ((qt (build-grid-quadtree 'point-quadtree (from-point-range (vec2 2.5 2.5) 2.5) 5 5))
         (first-results (range-find qt (vec2 2 2) 1.0))
         (second-results (range-find qt (vec2 2.5 2.5) 1.0)))
    (is-true (= 4 (length first-results)))


@@ 144,10 136,10 @@


(test quadrant-of
  (is-true (eq 'top-left     (quadrant-of (vec2 0.0 0.0) (vec2 -1.0 1.0))))
  (is-true (eq 'top-right    (quadrant-of (vec2 0.0 0.0) (vec2 1.0 1.0))))
  (is-true (eq 'bottom-left  (quadrant-of (vec2 0.0 0.0) (vec2 -1.0 -1.0))))
  (is-true (eq 'bottom-right (quadrant-of (vec2 0.0 0.0) (vec2 1.0 -1.0)))))
  (is-true (= *top-left*     (quadrant-of (vec2 0.0 0.0) (vec2 -1.0 1.0))))
  (is-true (= *top-right*    (quadrant-of (vec2 0.0 0.0) (vec2 1.0 1.0))))
  (is-true (= *bottom-left*  (quadrant-of (vec2 0.0 0.0) (vec2 -1.0 -1.0))))
  (is-true (= *bottom-right* (quadrant-of (vec2 0.0 0.0) (vec2 1.0 -1.0)))))

(test quadtree-bounds
  (let* ((bounds (from-point-range (vec2 0.0 0.0) 5.0))


@@ 162,10 154,10 @@
    (is-true  (inside-p (vec2 -2.5 2.5) bounds))
    (is-true  (inside-p (vec2 -2.5 -2.5) bounds))
    (let ((sb (split-bounds bounds)))
      (is-true (inside-p (vec2 2.5 2.5) (cdr (assoc 'quadtree:top-right sb))))
      (is-true (inside-p (vec2 -2.5 2.5) (cdr (assoc 'quadtree:top-left sb))))
      (is-true (inside-p (vec2 2.5 -2.5) (cdr (assoc 'quadtree:bottom-right sb))))
      (is-true (inside-p (vec2 -2.5 -2.5) (cdr (assoc 'quadtree:bottom-left sb)))))))
      (is-true (inside-p (vec2 2.5 2.5) (aref sb quadtree:*top-right*)))
      (is-true (inside-p (vec2 -2.5 2.5) (aref sb quadtree:*top-left*)))
      (is-true (inside-p (vec2 2.5 -2.5) (aref sb quadtree:*bottom-right*)))
      (is-true (inside-p (vec2 -2.5 -2.5) (aref sb quadtree:*bottom-left*))))))


(test entries


@@ 215,7 207,7 @@
    (insert qt (vec2 5.0 0.0) 6)
    (is-true (= 2 (length (range-find qt (vec2 2.5 0.0) 1.0)))))

  (let* ((qt (build-grid-quadtree 'pr-quadtree 5 5))
  (let* ((qt (build-grid-quadtree 'pr-quadtree (from-point-range (vec2 2.5 2.5) 2.5) 5 5))
         (first-results (range-find qt (vec2 2 2) 1.0))
         (second-results (range-find qt (vec2 2.5 2.5) 1.0)))
    (is-true (= 4 (length first-results)))

M util.lisp => util.lisp +66 -21
@@ 14,14 14,6 @@
;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

(defun random-quadtree (type radius count)
  "Create a random quadtree of specified type', with 'count' points within
-radius and radius of the origin along both axes."
  (let ((qt (make-instance type)))
    (dotimes (i count)
      (quadtree:insert qt (vec2-random (- radius) radius) i))
    qt))

(defun parametric-quadtree (&key
                              (type 'pr-quadtree)
                              (t-min 0.0)


@@ 34,15 26,13 @@
                                                     :x-max 25.0
                                                     :y-min -25.0
                                                     :y-max 25.0)))
  "Create a quadtree of specified type, where all of the points lie on the curve
specified by parametric function (xf(t), yf(t))"
  (let* ((qt (if (eq type 'pr-quadtree)
                 (make-instance 'quadtree:pr-quadtree :bounds bounds)
                 (make-instance type)))
         (dt (/ (- t-max t-min) steps)))
    (loop for i below steps
       for tv = (+ t-min (* dt i))
       do
       do 
         (quadtree:insert qt (vec2 (funcall xf tv) (funcall yf tv)) i))
    qt))



@@ 63,8 53,6 @@ specified by parametric function (xf(t), yf(t))"
                               (x-scale 20.0)
                               (y-scale 20.0)
                               (frames 60))
  "Generate frames of an animation showing quadtree refinement as points are added.
Animation shows points on a parametric curve, generated using parametric-quadtree."
  (dotimes (i frames)
    (let ((qt (quadtree:parametric-quadtree :t-min t-min
                                            :t-max t-max


@@ 76,13 64,70 @@ Animation shows points on a parametric curve, generated using parametric-quadtre
          (file-name (format nil "~aframe~5,'0d.png" output-directory i)))
      (quadtree:view-quadtree qt file-name :x-scale x-scale :y-scale y-scale :width width :height height :open-png nil))))

(defun benchmark-quadtree-search ()
(defun insert-random-points (qt count bounds)
  (loop
     for pt in (random-points-in bounds count)
     do
       (insert qt pt 0)))

(defun random-quadtree (type radius count)
  (let* ((bounds (from-point-range (vec2 0.0 0.0) radius))
         (qt (if (eq type 'point-quadtree)
                 (make-instance 'point-quadtree)
                 (make-instance 'pr-quadtree :bounds bounds))))
    (insert-random-points qt count bounds )
    qt))



(defun benchmark-random-pr-quadtree-search ( point-count find-count)
  (dotimes (i 16)
    (let* ((quadtree::*split-size* (* (1+ i) 2))
           (qt (quadtree:parametric-quadtree)))
      (dotimes (i 10)
        (let ((pt (vec2-random -10.0 10.0))
              (rg (+ 0.1 (random 10.0))))
          (let ((results (quadtree:range-find qt pt rg )))
            ))))))
δΈ€
           (radius 100.0))
      (format t "Split size: ~a~%Building quadtree of size ~a" quadtree::*split-size* point-count)
      (let ((qt (time (random-quadtree 'pr-quadtree radius point-count))))
        (format t "Performing ~a random range-finds~%" find-count)
        (time
         (dotimes (i find-count)
           (let ((pt (vec2-random (- radius) radius))
                 (rg (+ 0.1 (random radius))))
             (quadtree:range-find qt pt rg ))))
        qt))))

(defun benchmark-random-point-quadtree-search ( point-count find-count)
  (let* ((radius 100.0))
    (format t "Building quadtree of size ~a" point-count)
    (let ((qt (time (random-quadtree 'point-quadtree radius point-count))))
      (format t "Performing ~a random range-finds~%" find-count)
      (time
       (dotimes (i find-count)
         (let ((pt (vec2-random (- radius) radius))
               (rg (+ 0.1 (random radius))))
           (quadtree:range-find qt pt rg ))))
      qt)))

(defun build-grid-quadtree (type bounds x-count y-count)
  (with-slots (x-min x-max y-min y-max) bounds
    (let ((qt (if (equal type 'point-quadtree)
                (make-instance 'point-quadtree)
                (make-instance 'pr-quadtree :bounds bounds)))
          (dx (/ (- x-max x-min) x-count))
          (dy (/ (- y-max x-min) y-count)))
      (dotimes (i x-count)
        (let ((x-value (+ x-min (* dx i))))
          (dotimes (j y-count)
            (let ((y-value (+ y-min (* dy j))))
              (insert qt (vec2 x-value y-value) 0)))))
      qt)))
(defun benchmark-grid-quadtree-search (x-count y-count find-count)
  (let* ((radius 100.0)
         (bounds (from-point-range (vec2 0.0 0.0) radius))
         (pt-qt (build-grid-quadtree 'point-quadtree bounds x-count y-count))
         (pr-qt (build-grid-quadtree 'pr-quadtree bounds x-count y-count)))
    (dotimes (i find-count)
      (let* ((pt (vec2-random (- radius) radius))
            (rg (+ 0.1 (random radius)))
            (pt-find (quadtree:range-find pt-qt pt rg ))
            (pr-find (quadtree:range-find pr-qt pt rg )))
        (assert (= (length pt-find) (length pr-find)))))
    (values pt-qt pr-qt)))

M visualization.lisp => visualization.lisp +34 -31
@@ 82,38 82,42 @@
      (cl-cairo2:scale x-scale y-scale)
      (labels
          ((draw-quadtree (qt bound)
             (with-slots (entry top-left bottom-left top-right bottom-right) qt
             (with-slots (entry children) qt
               (with-slots (point) entry
                 (draw-point point (/ 4 x-scale))

                 (when (or top-left bottom-left top-right bottom-right)
                   (draw-cross point bound)
                 (let ((top-left (aref children *top-left*))
                       (bottom-left (aref children *bottom-left*))
                       (top-right (aref children *top-right*))
                       (bottom-right (aref children *bottom-right*)))
                   (when (or top-left bottom-left top-right bottom-right)
                     (draw-cross point bound)

                   (with-slots (x-min y-min x-max y-max) bound
                     (when top-left
                       (draw-quadtree top-left (make-instance 'quadtree-bounds
                                                              :x-min x-min
                                                              :x-max (vx point)
                                                              :y-min (vy point)
                                                              :y-max y-max)))
                     (when top-right
                       (draw-quadtree top-right (make-instance 'quadtree-bounds
                                                               :x-min (vx point)
                                                               :x-max x-max
                                                               :y-min (vy point)
                                                               :y-max y-max)))
                     (when bottom-left
                       (draw-quadtree bottom-left (make-instance 'quadtree-bounds
                                                                 :x-min x-min
                                                                 :x-max (vx point)
                                                                 :y-min y-min
                                                                 :y-max (vy point))))
                     (when bottom-right
                       (draw-quadtree bottom-right (make-instance 'quadtree-bounds
                                                                  :x-min (vx point)
                                                                  :x-max x-max
                                                                  :y-min y-min
                                                                  :y-max (vy point))))))))))
                     (with-slots (x-min y-min x-max y-max) bound
                       (when top-left
                         (draw-quadtree top-left (make-instance 'quadtree-bounds
                                                                :x-min x-min
                                                                :x-max (vx point)
                                                                :y-min (vy point)
                                                                :y-max y-max)))
                       (when top-right
                         (draw-quadtree top-right (make-instance 'quadtree-bounds
                                                                 :x-min (vx point)
                                                                 :x-max x-max
                                                                 :y-min (vy point)
                                                                 :y-max y-max)))
                       (when bottom-left
                         (draw-quadtree bottom-left (make-instance 'quadtree-bounds
                                                                   :x-min x-min
                                                                   :x-max (vx point)
                                                                   :y-min y-min
                                                                   :y-max (vy point))))
                       (when bottom-right
                         (draw-quadtree bottom-right (make-instance 'quadtree-bounds
                                                                    :x-min (vx point)
                                                                    :x-max x-max
                                                                    :y-min y-min
                                                                    :y-max (vy point)))))))))))
        (draw-quadtree qt (make-instance 'quadtree-bounds
                                         :x-min -1000.0
                                         :x-max 1000.0


@@ 143,15 147,14 @@
      (cl-cairo2:scale x-scale y-scale)
      (labels
          ((draw-quadtree (qt)
             (with-slots (entries bounds) qt
             (with-slots (entries children bounds) qt
               (draw-bound bounds)

               (dolist (entry entries)
                 (draw-point (slot-value entry 'point) (/ 4 x-scale)))

               (loop
                  for quad in '(top-left bottom-left top-right bottom-right)
                  for sub-tree = (slot-value qt quad) then (slot-value qt quad)
                  for sub-tree across children
                  when (and sub-tree
                            (not (zerop (qsize sub-tree))))
                  do