Changeset 27050 in project


Ignore:
Timestamp:
07/12/12 02:33:49 (8 years ago)
Author:
Ivan Raikov
Message:

kd-tree: restructuring handling of node indices

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r27040 r27050  
    2121   kd-tree-points
    2222   kd-tree-indices
    23    kd-tree-min
    24    kd-tree-max
     23   kd-tree-min-index
     24   kd-tree-max-index
    2525   kd-tree-size
    2626  )
    … …  
    171171    (KdNode (left  kd-tree?)
    172172            (p     point?)
    173             (i     (lambda (v) (or (integer? v) (and (pair? v) (integer? (car v))))))
     173            (i     positive-or-zero-integer?)
     174            (v     (lambda (v) (or (not v) v)))
    174175            (right kd-tree?)
    175176            (axis  positive-or-zero-integer?)
    … …  
    195196  (define (kd-tree->list* t)
    196197    (kd-tree-fold-right*
    197      (lambda (i x ax)
    198        (cons (list i x) ax))
     198     (lambda (i v x ax) (cons (if v (list i v x) (list i x)) ax))
    199199     '() t))
    200200
    … …  
    204204           (KdLeaf (ii pp vv axis)
    205205                   (KdLeaf ii (map f pp) vv axis))
    206            (KdNode (l x i r axis ci)
     206           (KdNode (l x i v r axis ci)
    207207                   (KdNode (kd-tree-map f l)
    208208                           (f x)
    209                            i
     209                           i v
    210210                           (kd-tree-map f r)
    211211                           axis ci))
    … …  
    215215    (cases kd-tree t
    216216           (KdLeaf (ii pp vv axis) (for-each f pp))
    217            (KdNode (l x i r axis ci)
     217           (KdNode (l x i v r axis ci)
    218218                   (begin
    219219                     (kd-tree-for-each f l)
    … …  
    227227    (cases kd-tree t
    228228           (KdLeaf (ii pp vv axis) (for-each f (reverse (cis:elements ii)) vv pp))
    229            (KdNode (l x i r axis ci)
     229           (KdNode (l x i v r axis ci)
    230230                   (begin
    231231                     (kd-tree-for-each* f l)
    232                      (f i x)
     232                     (f i v x)
    233233                     (kd-tree-for-each* f r)
    234234                     ))
    … …  
    240240           (KdLeaf (ii pp vv axis)
    241241                   (fold-right f init pp))
    242            (KdNode (l p i r axis ci)
     242           (KdNode (l p i v r axis ci)
    243243                   (let* ((init2 (kd-tree-fold-right f init r))
    244244                          (init3 (f p init2)))
    … …  
    253253                       (fold-right f init (zip (reverse (cis:elements ii)) vv) pp)
    254254                       (fold-right f init (reverse (cis:elements ii)) pp)))
    255            (KdNode (l x i r axis ci)
     255           (KdNode (l x i v r axis ci)
    256256                   (let* ((init2 (kd-tree-fold-right* f init r))
    257                           (init3 (f i x init2)))
     257                          (init3 (f i v x init2)))
    258258                     (kd-tree-fold-right* f init3 l)))
    259259           ))
    … …  
    268268    (cases kd-tree t
    269269                  (KdLeaf (ii pp vv axis)  (list t))
    270                   (KdNode (l x i r axis ci)
     270                  (KdNode (l x i v r axis ci)
    271271                          (append (kd-tree-subtrees l)
    272272                                  (list t)
    … …  
    278278    (cases kd-tree t
    279279                  (KdLeaf (ii pp vv axis)  pp)
    280                   (KdNode (l x i r axis ci) (list x))
     280                  (KdNode (l x i v r axis ci) (list x))
    281281                  ))
    282 
    283282 
    284283  (define (kd-tree-indices t)
    285284    (cases kd-tree t
    286285                  (KdLeaf (ii pp vv axis) (cis:elements ii))
    287                   (KdNode (l x i r axis ci) (list i))
     286                  (KdNode (l x i v r axis ci) (list i))
     287                  ))
     288 
     289  (define (kd-tree-values t)
     290    (cases kd-tree t
     291                  (KdLeaf (ii pp vv axis) vv)
     292                  (KdNode (l x i v r axis ci) (list v))
    288293                  ))
    289294
    … …  
    293298           (KdNode (l x i r axis ci) (cis:cardinal ci))))
    294299
    295   (define (kd-tree-min t)
     300  (define (kd-tree-min-index t)
    296301    (cases kd-tree t
    297302           (KdLeaf (ii pp vv axis) (cis:get-min ii))
    298303           (KdNode (l x i r axis ci) (cis:get-min ci))))
    299304
    300   (define (kd-tree-max t)
    301 
    302     (cases kd-tree t
    303            (KdLeaf (ii pp vv axis)     
    304                    (cis:get-max ii))
    305            (KdNode (l x i r axis ci)
    306                    (cis:get-max ci))))
     305  (define (kd-tree-max-index t)
     306    (cases kd-tree t
     307           (KdLeaf (ii pp vv axis) (cis:get-max ii))
     308           (KdNode (l x i r axis ci) (cis:get-max ci))))
    307309
    308310
    … …  
    367369                        (KdNode (list->kd-tree/depth m (+ m median-index) lt depth1
    368370                                                     leaf-factor: leaf-factor)
    369                                 p v
     371                                p i v
    370372                                (list->kd-tree/depth (+ m median-index 1) n gte depth1
    371373                                                     leaf-factor: leaf-factor)
    … …  
    376378        list->kd-tree/depth
    377379      )))
    378 
    379 #|
    380   (include "axial-vectors.scm")
    381 
    382   ;; construct a kd-tree from f64vectors with point coordinates
    383   ;; the points argument must be a list of f64vector for each axis:
    384   ;;
    385   ;;  ( F64VECTOR-X F64VECTOR-Y F64VECTOR-Z ... )
    386   ;;
    387 
    388   (define=> (make-f64vector->kd-tree/depth <Point>)
    389 
    390     (lambda (dimensions make-point make-value)
    391 
    392       (letrec (
    393 
    394                (f64vector->kd-tree/depth
    395 
    396                 (lambda (m n axial-vectors depth #!key (leaf-factor 10) (offset 0))
    397 
    398                   (cond
    399                    ((> m n) (KdLeaf cis:empty  '() '() depth))
    400 
    401                    ((<= (- n m) leaf-factor)
    402                     (let ((k (- n m)))
    403 
    404                       (if (zero? k)
    405 
    406                           (let ((elt (axial-vectors-ref axial-vectors m))
    407                                 (axis (modulo depth dimensions)))
    408                             (let* ((ii (cis:shift offset (cis:singleton m)))
    409                                    (es (cis:elements ii))
    410                                    (ps (list (make-point elt)))
    411                                    (vs (and make-value (map (lambda (i v) (make-value i v)) es ps))))
    412 
    413                               (KdLeaf ii ps vs axis)))
    414 
    415                           (let* ((sl   (axial-vectors-slice axial-vectors m n))
    416                                  (axis (modulo depth dimensions))
    417                                  (elt< (lambda (p0 p1)
    418                                          (compare-coord axis (make-point p0) (make-point p1)))))
    419 
    420                             (axial-vectors-quick-sort! sl elt<)
    421                            
    422                             (let* ((ii (cis:shift offset (cis:interval m n)))
    423                                    (es (reverse (cis:elements ii)))
    424                                    (ps (map (compose make-point (lambda (i) (axial-vectors-ref sl (- i m)))) es))
    425                                    (vs (and make-value (map (lambda (i v) (make-value i v)) es ps)))
    426                                    )
    427 
    428                               (KdLeaf ii ps vs axis)
    429                               )))
    430                       ))
    431 
    432                    ((= m n)
    433 
    434                     (let* ((e (axial-vectors-ref axial-vectors m))
    435                            (ps (list (make-point e)) )
    436                            (vs (list (and make-value (make-value m e)) m))
    437                            )
    438 
    439                       (KdLeaf (cis:shift offset (cis:singleton m))
    440                               ps
    441                               vs
    442                               (modulo depth (dimension (car ps))))
    443                       ))
    444 
    445                    (else
    446                     (let* ((axis (modulo depth dimensions))
    447                            (elt< (lambda (p0 p1)
    448                                    (compare-coord axis (make-point p0) (make-point p1)))))
    449 
    450                       (axial-vectors-quick-sort! axial-vectors elt< m (+ 1 n))
    451 
    452                       (let* ((depth1 (+ 1 depth))
    453                              (median-index (+ m (quotient (- n m) 2)))
    454                              (median (axial-vectors-ref axial-vectors median-index))
    455                              (p (make-point median))
    456                              (i (+ offset median-index))
    457                              (v (or (and make-value (list i (make-value i median))) i)))
    458 
    459                         (KdNode (f64vector->kd-tree/depth
    460                                  m (- median-index 1) axial-vectors depth1
    461                                  leaf-factor: leaf-factor)
    462                                 p v
    463                                 (f64vector->kd-tree/depth
    464                                  (+ median-index 1) n axial-vectors depth1
    465                                  leaf-factor: leaf-factor)
    466                                 axis (+ 1 (- n m))))
    467                       ))
    468                    )))
    469                )
    470       f64vector->kd-tree/depth
    471       )))
    472 |#
    473380 
    474381  ;; Returns the nearest neighbor of p in tree t.
    … …  
    503410                               (minimum-by pp (lambda (a b) (negative? (compare-distance probe a b)))))
    504411
    505                        (KdNode (l p i r axis ci)
     412                       (KdNode (l p i v r axis ci)
    506413                               (if (and (tree-empty? l)
    507414                                        (tree-empty? r)) p
    … …  
    560467                                 (and v (reverse v))))
    561468
    562                        (KdNode (l p i r axis ci)
     469                       (KdNode (l p i v r axis ci)
    563470
    564471                               (if (and (tree-empty? l)
    … …  
    590497                                 (filter (lambda (p) (<= (fdist probe p) r2)) pp)))
    591498
    592                        (KdNode (l p i r axis ci)
     499                       (KdNode (l p i v r axis ci)
    593500                               (let ((maybe-pivot
    594501                                      (if (<= (fdist probe p) (* radius radius)) (list p) '())))
    … …  
    637544                                             
    638545
    639                        (KdNode (l p i r axis ci)
     546                       (KdNode (l p i v r axis ci)
    640547                               (let ((maybe-pivot
    641548                                      (if (<= (fdist probe p) (* radius radius))
    … …  
    740647                                     ))
    741648
    742                          (KdNode (l p i r axis ci)
     649                         (KdNode (l p i v r axis ci)
    743650
    744651                                 ;(fprintf (current-error-port) "kd-tree-remove: p = ~A~%" p)
    … …  
    766673                                                                   (cis:singleton i))
    767674                                                                  ((kd-tree-empty? ll)
    768                                                                    (kd-tree-min rr))
     675                                                                   (kd-tree-min-index rr))
    769676                                                                  (else
    770                                                                    (kd-tree-min ll))))
     677                                                                   (kd-tree-min-index ll))))
    771678                                                      (max1 (cond ((and (kd-tree-empty? ll)
    772679                                                                        (kd-tree-empty? rr))
    773680                                                                   (cis:empty))
    774681                                                                  ((kd-tree-empty? rr)
    775                                                                    (kd-tree-max ll))
     682                                                                   (kd-tree-max-index ll))
    776683                                                                  (else
    777                                                                    (kd-tree-max rr))))
     684                                                                   (kd-tree-max-index rr))))
    778685                                                      )
    779686
    780                                                 (KdNode ll p i rr axis
     687                                                (KdNode ll p i v rr axis
    781688                                                        (cis:add (if (integer? i) i (car i))
    782689                                                                 (cis:interval min1 max1)))
    … …  
    794701                                                                   (cis:singleton i))
    795702                                                                  ((kd-tree-empty? ll)
    796                                                                    (kd-tree-min rr))
     703                                                                   (kd-tree-min-index rr))
    797704                                                                  (else
    798                                                                    (kd-tree-min ll))))
     705                                                                   (kd-tree-min-index ll))))
    799706                                                      (max1 (cond ((and (kd-tree-empty? ll)
    800707                                                                        (kd-tree-empty? rr))
    801708                                                                   (cis:empty))
    802709                                                                  ((kd-tree-empty? rr)
    803                                                                    (kd-tree-max ll))
     710                                                                   (kd-tree-max-index ll))
    804711                                                                  (else
    805                                                                    (kd-tree-max rr))))
     712                                                                   (kd-tree-max-index rr))))
    806713                                                      )
    807                                                 (KdNode ll p i rr axis
     714                                                (KdNode ll p i v rr axis
    808715                                                        (cis:add (if (integer? i) i (car i))
    809716                                                                 (cis:interval min1 max1)))
    … …  
    826733             (KdLeaf (ii pp vv axis)  #t)
    827734
    828              (KdNode (l p i r axis ci)
     735             (KdNode (l p i v r axis ci)
    829736                     (let ((x (coord axis p)))
    830737                       (and (every (lambda (y) (<= (coord axis y) x ))
    … …  
    855762                           
    856763
    857                (KdNode (l p i r axis ci)
     764               (KdNode (l p i v r axis ci)
    858765                       (if (= axis x-axis)
    859766                           
    … …  
    889796                               pts))
    890797
    891                (KdNode (l p i r axis ci)
     798               (KdNode (l p i v r axis ci)
    892799                       (if (= axis x-axis)
    893800                           
Note: See TracChangeset for help on using the changeset viewer.