Changeset 25915 in project


Ignore:
Timestamp:
02/16/12 09:46:22 (8 years ago)
Author:
Ivan Raikov
Message:

spatial-tree: extensions to the kd-tree API

Location:
release/4/spatial-trees/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • release/4/spatial-trees/trunk/kd-tree.scm

    r25912 r25915  
    1111   kd-tree->list
    1212   kd-tree-map
     13   kd-tree-for-each
     14   kd-tree-i-for-each
    1315   kd-tree-fold-right
    1416   kd-tree-subtrees
     17   kd-tree-point
    1518   list->kd-tree
    1619   kd-tree-nearest-neighbor
    … …  
    1821   kd-tree-k-nearest-neighbors
    1922   kd-tree-remove
     23   kd-tree-slice
     24   kd-tree-i-slice
    2025   kd-tree-is-valid?
    2126   kd-tree-all-subtrees-are-valid?
    … …  
    120125                      (KdNode (list->kd-tree/depth (take sorted-points median-index) (+ 1 depth))
    121126                              (list-ref sorted-points median-index)
     127                              median-index
    122128                              (list->kd-tree/depth (drop sorted-points (+ median-index 1)) (+ 1 depth))
    123129                              axis)
    … …  
    156162                (cases kd-tree t
    157163                       (KdEmpty () #f)
    158                        (KdNode (l p r axis)
     164                       (KdNode (l p i r axis)
    159165                               (if (and (tree-empty? l)
    160166                                        (tree-empty? r)) p
    … …  
    181187                (cases kd-tree t
    182188                       (KdEmpty ()  '())
    183                        (KdNode (l p r axis)
     189                       (KdNode (l p i r axis)
    184190                               (let ((maybe-pivot (if (<= (dist2 probe p) (* radius radius))
    185191                                                      (list p) '())))
    … …  
    230236                (cases kd-tree t
    231237                       (KdEmpty () (KdEmpty))
    232                        (KdNode (l p r axis)
     238                       (KdNode (l p i r axis)
    233239                               (if (equal? p p-kill)
    234240                                   (list->kd-tree/depth
    … …  
    239245                                   (if (<= (coord axis p-kill)
    240246                                           (coord axis p))
    241                                        (KdNode (remove l p-kill) p r axis)
    242                                        (KdNode l p (remove r p-kill) axis))
     247                                       (KdNode (remove l p-kill) p i r axis)
     248                                       (KdNode l p i (remove r p-kill) axis))
    243249                                   ))
    244250                       ))
    … …  
    257263      (cases kd-tree t
    258264             (KdEmpty () #t)
    259              (KdNode (l p r axis)
     265             (KdNode (l p i r axis)
    260266                     (let ((x (coord axis p)))
    261267                       (and (every (lambda (y) (<= (coord axis y) x ))
    … …  
    276282    (KdNode (left  kd-tree?)
    277283            (p     point3d?)
     284            (i     integer?)
    278285            (right kd-tree?)
    279286            (axis  integer?))
    … …  
    291298    (cases kd-tree t
    292299           (KdEmpty () (KdEmpty))
    293            (KdNode (l x r axis)
     300           (KdNode (l x i r axis)
    294301                   (KdNode (kd-tree-map f l)
    295302                           (f x)
    … …  
    298305           ))
    299306 
     307  (define (kd-tree-for-each f t)
     308    (cases kd-tree t
     309           (KdEmpty () (begin))
     310           (KdNode (l x i r axis)
     311                   (begin
     312                     (kd-tree-for-each f l)
     313                     (f x)
     314                     (kd-tree-for-each f r)
     315                     ))
     316           ))
     317
     318  (define (kd-tree-i-for-each f t)
     319    (cases kd-tree t
     320           (KdEmpty () (begin))
     321           (KdNode (l x i r axis)
     322                   (begin
     323                     (kd-tree-i-for-each f l)
     324                     (f i x)
     325                     (kd-tree-i-for-each f r)
     326                     ))
     327           ))
     328 
    300329  (define (kd-tree-fold-right f init t)
    301330    (cases kd-tree t
    302331           (KdEmpty () init)
    303            (KdNode (l x r _)
     332           (KdNode (l x i r _)
    304333                   (let* ((init2 (kd-tree-fold-right f init r))
    305334                          (init3 (f x init2)))
    306335                     (kd-tree-fold-right f init3 l)))
    307336           ))
     337
     338  (define=> (make-kd-tree-slice <Point>)
     339    (lambda (x-axis x1 x2 t)
     340      (let recur ((t t)  (pts '()))
     341        (cases kd-tree t
     342               (KdEmpty () pts)
     343               (KdNode (l p i r axis)
     344                       (if (= axis x-axis)
     345                           
     346                           (cond ((and (<= x1 (coord axis p))
     347                                       (<= (coord axis p) x2))
     348                                   (recur l (cons p (recur r pts))))
     349                                 
     350                                 ((< (coord axis p) x1)
     351                                  (recur r pts))
     352                               
     353                                 ((< x2 (coord axis p))
     354                                  (recur l pts)))
     355                           
     356                           (if (and (<= x1 (coord x-axis p))
     357                                    (<= (coord x-axis p) x2))
     358                               (recur l (cons p (recur r pts)))
     359                               (recur l (recur r pts)))
     360                           ))
     361               ))
     362      ))
     363 
     364 
     365  (define=> (make-kd-tree-i-slice <Point>)
     366    (lambda (x-axis x1 x2 t)
     367      (let recur ((t t)  (pts '()))
     368        (cases kd-tree t
     369               (KdEmpty () pts)
     370               (KdNode (l p i r axis)
     371                       (if (= axis x-axis)
     372                           
     373                           (cond ((and (<= x1 (coord axis p))
     374                                       (<= (coord axis p) x2))
     375                                   (recur l (cons (cons i p) (recur r pts))))
     376                                 
     377                                 ((< (coord axis p) x1)
     378                                  (recur r pts))
     379                               
     380                                 ((< x2 (coord axis p))
     381                                  (recur l pts)))
     382                           
     383                           (if (and (<= x1 (coord x-axis p))
     384                                    (<= (coord x-axis p) x2))
     385                               (recur l (cons p (recur r pts)))
     386                               (recur l (recur r pts)))
     387                           ))
     388               ))
     389      ))
     390 
     391 
    308392 
    309393 
    … …  
    315399                  (KdEmpty ()
    316400                           (list (KdEmpty)))
    317                   (KdNode (l x r axis)
     401                  (KdNode (l x i r axis)
    318402                          (append (kd-tree-subtrees l)
    319403                                  (list t)
    … …  
    321405                  ))
    322406 
     407  (define (kd-tree-point t)
     408    (cases kd-tree t
     409                  (KdEmpty ()  #f)
     410                  (KdNode (l x i r axis) x)
     411                  ))
     412 
    323413  (define list->kd-tree/depth
    324414    (make-list->kd-tree/depth Point-point3d))
    … …  
    335425  (define kd-tree-remove (make-kd-tree-remove Point-point3d))
    336426 
     427  (define kd-tree-slice (make-kd-tree-slice Point-point3d))
     428
     429  (define kd-tree-i-slice (make-kd-tree-i-slice Point-point3d))
     430 
    337431  (define kd-tree-is-valid? (make-kd-tree-is-valid? Point-point3d))
    338432 

  • release/4/spatial-trees/trunk/spatial-trees.setup

    r25912 r25915  
    1818  '((version 1.0)
    1919    ))
    20 
    21 
Note: See TracChangeset for help on using the changeset viewer.