Changeset 28102 in project for release/4/kd-tree/trunk/kd-tree.scm


Ignore:
Timestamp:
01/16/13 03:06:44 (7 years ago)
Author:
Ivan Raikov
Message:

kd-tree: compute bucket-size automatically, use dist2 instead of equal? for point removal

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/kd-tree/trunk/kd-tree.scm

    r27840 r28102  
    2424;; K-D trees.
    2525;;
    26 ;; Copyright 2012 Ivan Raikov and the Okinawa Institute of
     26;; Copyright 2012-2013 Ivan Raikov and the Okinawa Institute of
    2727;; Science and Technology.
    2828;;
     
    7474          (only extras fprintf pp)
    7575          (prefix cis cis:))
     76
     77  (define log2 (foreign-lambda double "log2" double))
    7678
    7779
     
    367369
    368370                (list->kd-tree/depth
    369                  (lambda (m n points depth #!key (leaf-factor 10) (offset 0))
     371                 (lambda (m n points depth #!key (bucket-size (max (log2 (- n m)) 1)) (offset 0))
    370372
    371373                  (cond
    372374                   ((null? points) (KdLeaf cis:empty '() '() depth))
    373375
    374                    ((<= (- n m) leaf-factor)
     376                   ((<= (- n m) bucket-size)
    375377                    (let ((k (- n m)))
    376378
     
    409411                       
    410412                        (KdNode (list->kd-tree/depth m (+ m median-index) lt depth1
    411                                                      leaf-factor: leaf-factor)
     413                                                     bucket-size: bucket-size)
    412414                                p i v
    413415                                (list->kd-tree/depth (+ m median-index 1) n gte depth1
    414                                                      leaf-factor: leaf-factor)
     416                                                     bucket-size: bucket-size)
    415417                                axis
    416418                                (cis:shift offset (cis:interval m (- n 1))))))
     
    711713
    712714                (list->kd-tree/depth
    713                  (lambda (points depth #!key (leaf-factor 50))
     715                 (lambda (points depth bucket-size)
    714716
    715717;                 (fprintf (current-error-port) "kd-tree-remove:  points = ~A~%" points)
     
    719721                    ((null? points) (KdLeaf cis:empty '() '() depth))
    720722                   
    721                     ((<= (length points) leaf-factor)
     723                    ((<= (length points) bucket-size)
    722724
    723725                       (let* (
     
    750752                             (v (kd-elt-value median))
    751753                             (axis (modulo depth (dimension p)))
    752                              (l (list->kd-tree/depth lt depth1 leaf-factor: leaf-factor))
    753                              (r (list->kd-tree/depth gte depth1 leaf-factor: leaf-factor))
     754                             (l (list->kd-tree/depth lt depth1 bucket-size))
     755                             (r (list->kd-tree/depth gte depth1 bucket-size))
    754756                             )
    755757
     
    761763
    762764               (tree-remove
    763                 (lambda (t p-kill #!key (leaf-factor 10))
    764 
     765                (lambda (t p-kill #!key (bucket-size (max (log2 (kd-tree-size t)) 1)) (tol 1e-9))
     766                 
     767                  (let ((tol^2 (* tol tol)))
    765768                 
    766769;                  (fprintf (current-error-port) "kd-tree-remove: t = ~A~%" t)
     
    776779                                 (if vv
    777780                                     (let ((ipvs (filter-map
    778                                                   (lambda (i p v) (and (equal? p p-kill) (list i p v)))
     781                                                  (lambda (i p v) (and (< (dist2 p p-kill) tol^2) (list i p v)))
    779782                                                  (reverse (cis:elements ii)) pp vv)))
    780783
     
    784787                                            (let ((ii1 (fold (lambda (i ax) (cis:remove i ax))
    785788                                                             ii (map car ipvs)))
    786                                                   (pp1 (fold (lambda (x ax) (remove (lambda (p) (equal? p x)) ax))
     789                                                  (pp1 (fold (lambda (x ax) (remove (lambda (p) (< (dist2 p x) tol^2)) ax))
    787790                                                             pp (map cadr ipvs)))
    788791                                                  (vv1 (fold (lambda (x ax)
    789                                                                (remove (lambda (p) (equal? p x)) ax))
     792                                                               (remove (lambda (p) (< (dist2 p x) tol^2)) ax))
    790793                                                             vv (map caddr ipvs)))
    791794                                                  )
     
    797800                                            ))
    798801
    799                                      (let ((ips (filter-map (lambda (i p) (and (equal? p p-kill) (list i p)))
     802                                     (let ((ips (filter-map (lambda (i p) (and (< (dist2 p p-kill) tol^2) (list i p)))
    800803                                                            (reverse (cis:elements ii)) pp)))
    801804                                       
     
    805808                                            (let ((ii1 (fold (lambda (i ax) (cis:remove i ax))
    806809                                                             ii (map car ips)))
    807                                                   (pp1 (fold (lambda (x ax) (remove (lambda (p) (equal? p x)) ax))
     810                                                  (pp1 (fold (lambda (x ax) (remove (lambda (p) (< (dist2 p x) tol^2)) ax))
    808811                                                             pp (map cadr ips)))
    809812                                                  )
     
    818821                         (KdNode (l p i v r axis ci)
    819822
    820                                  (cond ((equal? p p-kill)
     823                                 (cond ((< (dist2 p p-kill) tol^2)
    821824                                        (let ((pts1 (append (kd-tree->list* l) (kd-tree->list* r))))
    822                                           (list->kd-tree/depth pts1 axis leaf-factor: leaf-factor)))
     825                                          (list->kd-tree/depth pts1 axis bucket-size)))
    823826
    824827                                       (else
     
    845848                                     ))
    846849                         ))
    847                 ))
     850                )))
    848851        tree-remove))
    849852
     
    961964      (make-<KdTree>
    962965       (lambda (points #!key
    963                        (leaf-factor 10)
    964966                       (make-point identity)
    965967                       (make-value #f)
     
    968970         ((list->kd-tree/depth make-point make-value)
    969971          0 (length points) points 0
    970           leaf-factor: leaf-factor offset: offset))
     972          offset: offset))
    971973
    972974       (make-kd-tree-nearest-neighbor point-class)
Note: See TracChangeset for help on using the changeset viewer.