Changeset 27053 in project


Ignore:
Timestamp:
07/12/12 06:50:20 (8 years ago)
Author:
Ivan Raikov
Message:

kd-tree: additional bugfixes due to new internal format

Location:
release/4/kd-tree/trunk
Files:
2 edited

Legend:

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

    r27052 r27053  
    243243           (KdLeaf (ii pp vv axis)
    244244                   (if vv
    245                        (fold-right f init (reverse (cis:elements ii)) vv pp)
     245                       (fold-right f init (zip (reverse (cis:elements ii)) vv) pp)
    246246                       (fold-right f init (reverse (cis:elements ii)) pp)))
    247247           (KdNode (l x i v r axis ci)
     
    321321               (split
    322322                (lambda (m n points depth)
     323
    323324                  (let* ((axis   (modulo depth (dimension (make-point (car points)))))
    324325                         (cmpfn  (lambda (p0 p1)
     
    333334                (list->kd-tree/depth
    334335                 (lambda (m n points depth #!key (leaf-factor 10) (offset 0))
     336
    335337                  (cond
    336338                   ((null? points) (KdLeaf cis:empty '() '() depth))
     
    347349                                           es)))
    348350                             )
     351                       
    349352                        (KdLeaf ii ps vs (modulo depth (dimension (car ps))))
    350353                        )))
     
    354357                           (ps (list (make-point e)) )
    355358                           (vs (and make-value (list (make-value m e)))))
     359                     
    356360                      (KdLeaf (cis:shift offset (cis:singleton m) )
    357361                              ps vs
     
    362366                    (let-values (((median median-index lt gte)
    363367                                  (split m n points depth)))
     368
    364369                     
    365370                      (let* ((depth1 (+ 1 depth))
     
    367372                             (p (make-point median))
    368373                             (v (and make-value (make-value i median)))
     374
    369375                             (axis (modulo depth (dimension p))))
    370376                       
     
    435441
    436442    (letrec ((find-nearest
    437               (lambda (t1 t2 i p probe xp x-probe)
     443              (lambda (t1 t2 i v p probe xp x-probe)
    438444
    439445                (let* ((candidates1
    440446                        (let ((best1 (nearest-neighbor t1 probe)))
    441                           (or (and best1 (list best1 (list i p)))
    442                               (list (list i p)))))
     447                          (or (and best1 (list best1 (if v (list (list i v) p) (list i p))))
     448                              (list (if v (list (list i v) p) (list i p))))
     449                          ))
    443450                       
    444451                       (sphere-intersects-plane?
     
    461468                (cases kd-tree t
    462469                       (KdLeaf (ii pp vv axis)
    463                                (let ((v
     470                               (let ((res
    464471                                      (if vv
    465472                                          (minimum-by pp (lambda (a b) (negative? (compare-distance probe a b)))
     
    467474                                          (minimum-by pp (lambda (a b) (negative? (compare-distance probe a b)))
    468475                                                      (reverse (cis:elements ii))))))
    469                                  (and v (reverse v))))
     476                                 (and res (reverse res))))
    470477
    471478                       (KdNode (l p i v r axis ci)
     
    473480                               (if (and (tree-empty? l)
    474481                                        (tree-empty? r))
    475                                    (list i p)
     482
     483                                   (if v (list (list i v) p) (list i p))
     484
    476485                                   (let ((x-probe (coord axis probe))
    477486                                         (xp (coord axis p))
    478487                                         (xi i))
    479488                                     (if (<= x-probe xp)
    480                                          (find-nearest l r i p probe xp x-probe)
    481                                          (find-nearest r l i p probe xp x-probe))
     489                                         (find-nearest l r i v p probe xp x-probe)
     490                                         (find-nearest r l i v p probe xp x-probe))
    482491                                     ))
    483492                               ))
     
    541550                       (KdLeaf (ii pp vv axis) 
    542551                               (let ((rr (* radius radius)))
    543                                  (filter-map (lambda (p i) (and (<= (fdist probe p) rr) (cons i p)))
    544                                              pp (cis:elements ii))
    545                                  ))
     552                                 (if vv
     553                                     (filter-map (lambda (i v p) (and (<= (fdist probe p) rr) (list (list i v) p)))
     554                                                 (reverse (cis:elements ii)) vv pp)
     555                                     (filter-map (lambda (i p) (and (<= (fdist probe p) rr) (list i p)))
     556                                                 (reverse (cis:elements ii)) pp)
     557                                     )))
    546558                                             
    547559
     
    793805        (cases kd-tree t
    794806               (KdLeaf (ii pp vv axis)
    795                        (append (filter-map (lambda (p i)
    796                                              (and (<= x1 (coord x-axis p))
    797                                                   (<= (coord x-axis p) x2)
    798                                                   (cons i p)))
    799                                        pp (cis:elements ii))
    800                                pts))
     807                       (append
     808                        (if vv
     809                            (filter-map (lambda (i v p)
     810                                          (and (<= x1 (coord x-axis p))
     811                                               (<= (coord x-axis p) x2)
     812                                               (list (list i v) p)))
     813                                        (reverse (cis:elements ii)) vv pp)
     814                            (filter-map (lambda (i p)
     815                                          (and (<= x1 (coord x-axis p))
     816                                               (<= (coord x-axis p) x2)
     817                                               (list i p)))
     818                                        (reverse (cis:elements ii)) pp))
     819                        pts))
    801820
    802821               (KdNode (l p i v r axis ci)
     
    805824                           (cond ((and (<= x1 (coord axis p))
    806825                                       (<= (coord axis p) x2))
    807                                    (recur l (cons (cons i p) (recur r pts))))
     826                                   (recur l (cons (if v (list (list i v) p) (list i p)) (recur r pts))))
    808827                                 
    809828                                 ((< (coord axis p) x1)
     
    815834                           (if (and (<= x1 (coord x-axis p))
    816835                                    (<= (coord x-axis p) x2))
    817                                (recur l (cons (cons i p) (recur r pts)))
     836                               (recur l (cons (if v (list (list i v) p) (list i p)) (recur r pts)))
    818837                               (recur l (recur r pts)))
    819838                           ))
  • release/4/kd-tree/trunk/kd-tree.setup

    r27052 r27053  
    44  (make-pathname #f fn ##sys#load-dynamic-extension))   
    55
    6 (compile -d -O2  -S -s kd-tree.scm -j kd-tree)
     6(compile -d0 -O2  -S -s kd-tree.scm -j kd-tree)
    77(compile -s kd-tree.import.scm)
    88
Note: See TracChangeset for help on using the changeset viewer.