Changeset 27836 in project


Ignore:
Timestamp:
11/16/12 07:00:15 (7 years ago)
Author:
Ivan Raikov
Message:

kd-tree: specialized tree-rebuilding routine for remove procedure

File:
1 edited

Legend:

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

    r27829 r27836  
    6464   kd-tree-max-index
    6565   kd-tree-size
    66    kd-tree-indices
    6766  )
    6867
     
    316315    (cases kd-tree t
    317316                  (KdLeaf (ii pp vv axis) ii)
    318                   (KdNode (l x i v r axis ci) (cis:singleton i))
     317                  (KdNode (l x i v r axis ci) ci)
    319318                  ))
    320319
     
    340339           (KdNode (l x i v r axis ci) (cis:get-max ci))))
    341340
    342 
    343   (define (kd-tree-indices t)
    344     (cases kd-tree t
    345                   (KdLeaf (ii pp vv axis) ii)
    346                   (KdNode (l x i v r axis ci)
    347                           (cis:union (cis:singleton i)
    348                                      (cis:union (kd-tree-indices l)
    349                                                 (kd-tree-indices r))))
    350                   ))
    351341
    352342
     
    683673                ))
    684674        k-nearest-neighbors)))
    685  
     675
     676
     677  (define (kd-elt-index x) (let ((xp (car x))) (if (number? xp) xp (car xp))))
     678  (define (kd-elt-value x) (and (pair? (car x)) (cadar x)))
     679  (define (kd-elt-point x) (cadr x))
    686680 
    687681  ;; removes the point p from t.
    688682  (define=> (make-kd-tree-remove <Point>)
    689     (lambda (list->kd-tree list->kd-tree*)
    690       (letrec ((tree-remove
    691                 (lambda (t p-kill)
     683      (letrec (
     684               ;; a variant of list->kd-tree specialized for
     685               ;; kd-tree-remove. Specifically, it preserves the
     686               ;; original point indices.  This variant of
     687               ;; list->kd-tree assumes that the input list of points
     688               ;; has the form ( (INDEX POINT VALUE) ... )
     689
     690               (split
     691                (lambda (points depth)
     692
     693;                 (fprintf (current-error-port) "kd-tree-remove: split: points = ~A~%" points)
     694                 
     695                  (let* ((axis   (modulo depth (dimension (kd-elt-point (car points)))))
     696                         (cmpfn  (lambda (p0 p1) (compare-coord axis (kd-elt-point p0) (kd-elt-point p1))))
     697                         (sorted (sort points cmpfn))
     698                         (median-index (quotient (length sorted) 2))
     699                         )
     700
     701                    (let-values (((lte gte) (split-at sorted median-index)))
     702
     703                      (let ((median (kd-elt-point (car gte))))
     704
     705                        (let-values (((lt xeq) (span (lambda (x) (< (coord axis (kd-elt-point x)) (coord axis median))) lte)))
     706                         
     707                          (if (null? xeq)
     708                              (values (car gte) lt (cdr gte))
     709                              (let ((split-index (length lt)))
     710                                (values (car xeq) lt (append (cdr xeq) gte))))
     711                        ))
     712                      ))
     713                  ))
     714
     715                (list->kd-tree/depth
     716                 (lambda (points depth #!key (leaf-factor 50))
     717
     718;                 (fprintf (current-error-port) "kd-tree-remove:  points = ~A~%" points)
     719                   
     720                   (cond
     721
     722                    ((null? points) (KdLeaf cis:empty '() '() depth))
     723                   
     724                    ((<= (length points) leaf-factor)
     725
     726                       (let* (
     727                              (ps (map kd-elt-point points))
     728                              (ii (fold (lambda (x ax) (cis:add x ax)) cis:empty (map kd-elt-index points)))
     729                              (vs (let ((vs (map kd-elt-value points))) (and (every identity vs) vs)))
     730                             )
     731                       
     732                        (KdLeaf ii ps vs (modulo depth (dimension (car ps))))
     733                        )
     734                       )
     735                   
     736                    ((null? (cdr points))
     737
     738                     (let* ((ps (map kd-elt-point points))
     739                            (ii (fold (lambda (x ax) (cis:add x ax)) cis:empty (map kd-elt-index points)))
     740                            (vs (map kd-elt-value points)))
     741                       
     742                       (KdLeaf ii ps vs (modulo depth (dimension (car ps))))
     743                       )
     744                     )
     745                   
     746                   (else
     747                    (let-values (((median lt gte)
     748                                  (split points depth)))
     749                     
     750                      (let* ((depth1 (+ 1 depth))
     751                             (i (kd-elt-index median))
     752                             (p (kd-elt-point median))
     753                             (v (kd-elt-value median))
     754                             (axis (modulo depth (dimension p)))
     755                             (l (list->kd-tree/depth lt depth1 leaf-factor: leaf-factor))
     756                             (r (list->kd-tree/depth gte depth1 leaf-factor: leaf-factor))
     757                             )
     758
     759                        (KdNode l p i v r axis
     760                                (cis:add i (cis:union (kd-tree-node-indices l) (kd-tree-node-indices r))))
     761                        ))
     762                    ))
     763                 ))
     764
     765               (tree-remove
     766                (lambda (t p-kill #!key (leaf-factor 10))
    692767
    693768                 
     
    746821                         (KdNode (l p i v r axis ci)
    747822
    748 ;                                (fprintf (current-error-port) "kd-tree-remove (KdNode): p = ~A~%" p)
    749 ;                                (fprintf (current-error-port) "kd-tree-remove (KdNode): p-kill = ~A~%" p-kill)
    750 ;                                (fprintf (current-error-port) "kd-tree-remove (KdNode): equal? p p-kill = ~A~%" (equal? p p-kill))
    751 ;                                (fprintf (current-error-port) "kd-tree-remove (KdNode): coord axis p = ~A~%" (coord axis p))
    752 ;                                (fprintf (current-error-port) "kd-tree-remove (KdNode): coord axis p-kill = ~A~%" (coord axis p-kill))
    753                                  
    754                                  (if (equal? p p-kill)
    755 
    756                                      (let ((offset (if (kd-tree-empty? l) (+ i 1) (kd-tree-min-index l))))
    757                                        (if v
    758                                            (let ((pts1 (append (kd-tree->list* l) (kd-tree->list* r))))
    759                                              (list->kd-tree* 0 (length pts1) pts1 axis offset: offset))
    760                                            (let ((pts1 (append (kd-tree->list l) (kd-tree->list r))))
    761                                              (list->kd-tree 0 (length pts1) pts1 axis offset: offset))
    762                                          ))
    763 
    764 
    765                                      (if (< (coord axis p-kill) (coord axis p))
     823                                 (cond ((equal? p p-kill)
     824                                        (let ((pts1 (append (kd-tree->list* l) (kd-tree->list* r))))
     825                                          (list->kd-tree/depth pts1 axis leaf-factor: leaf-factor)))
     826
     827                                       (else
     828
     829                                        (if (< (coord axis p-kill) (coord axis p))
    766830
    767831                                         (let* ((l1   (tree-remove l p-kill))
    768                                                 (l1-is (and l1 (kd-tree-indices l1))))
    769 
    770                                            (and l1
    771                                                 (KdNode l1 p i v r axis
    772                                                         (cis:add i (cis:union l1-is (kd-tree-indices r)))))
     832                                                (l1-is (and l1 (kd-tree-node-indices l1)))
     833                                                (r-is  (kd-tree-node-indices r))
     834                                                (ci1   (cis:add i (cis:union l1-is r-is))))
     835
     836                                           (and l1 (KdNode l1 p i v r axis ci1))
    773837                                           )
    774838                                         
    775839                                         (let* ((r1   (tree-remove r p-kill))
    776                                                 (r1-is (and r1 (kd-tree-indices r1))))
    777 
    778                                            (and r1
    779                                                 (KdNode l p i v r1 axis
    780                                                         (cis:add i (cis:union (kd-tree-indices l) r1-is))))
    781                                            ))
     840                                                (r1-is (and r1 (kd-tree-node-indices r1)))
     841                                                (l-is  (kd-tree-node-indices l))
     842                                                (ci1   (cis:add i (cis:union r1-is l-is))))
     843
     844                                           (and r1 (KdNode l p i v r1 axis ci1))
     845
     846                                           )))
    782847                                     
    783848                                     ))
    784849                         ))
    785850                ))
    786         tree-remove)))
     851        tree-remove))
    787852
    788853
     
    893958            (make-list->kd-tree/depth point-class))
    894959           (kd-tree-remove
    895             ((make-kd-tree-remove point-class)
    896              (list->kd-tree/depth identity #f)
    897              (list->kd-tree/depth cadr (lambda (i v) (cadar v)))))
     960            (make-kd-tree-remove point-class) )
    898961           (kd-tree-nearest-neighbor
    899962            (make-kd-tree-nearest-neighbor point-class)))
Note: See TracChangeset for help on using the changeset viewer.