Changeset 27008 in project


Ignore:
Timestamp:
07/06/12 12:17:12 (9 years ago)
Author:
Ivan Raikov
Message:

spatial-trees: disabled f64vector->kd-tree constructor and tests

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

Legend:

Unmodified
Added
Removed
  • release/4/spatial-trees/trunk/axial-vectors.scm

    r26908 r27008  
    11(use srfi-4)   
     2
     3
    24(define (axial-vectors-ref axv i)
    35  (map (lambda (x) (f64vector-ref x i)) axv))
     
    1618 
    1719
    18 (define (axial-vectors-swap axv i j)
     20(define (axial-vectors-swap! axv i j)
    1921  (let ((t (axial-vectors-ref axv i)))
    2022    (axial-vectors-set! axv i (axial-vectors-ref axv j))
     
    5254                                               j))))
    5355                  (if (fx< i j)
    54                       (let ((tmp (axial-vectors-ref v j)))             
    55                         (axial-vectors-set! v j (axial-vectors-ref v i))        ; Swap V[I]
    56                         (axial-vectors-set! v i tmp)            ;  and V[J].
     56                      (begin
     57                        (axial-vectors-swap! v i j (axial-vectors-ref v i))
    5758                        (loop (fx+ i 1) (fx- j 1)))
    58                      
    5959                      (begin (recur l i) (recur (fx+ j 1) r)))))))
    6060          v))
  • release/4/spatial-trees/trunk/kd-tree.scm

    r26974 r27008  
    3030
    3131  (import (only srfi-1 xcons fold list-tabulate split-at every fold-right take filter filter-map remove zip)
    32           (only srfi-4 f64vector-ref f64vector-set! f64vector-length make-f64vector f64vector->list)
     32          (only srfi-4 f64vector-ref f64vector-set! f64vector-length make-f64vector f64vector->list
     33                u32vector-ref u32vector-set!)
    3334          (only extras fprintf pp)
    3435          (only foreign foreign-lambda)
     
    3839
    3940
    40 
    41 #>
    42 void cdslice(const int M, const int N, const double *X, double *Y)
    43 {
    44    unsigned int i,j;
    45 
    46    if (M >= N) return;
    47 
    48    for (j=0,i=M; i<=N; j++,i++)
    49    {
    50        Y[j] = X[i];
    51    }
    52 }
    53 <#
    54 
    55   (define dslice (foreign-lambda void "cdslice" int int f64vector f64vector))
    56 
    57   (define (f64vector-slice x m n)
    58     (if (>= m n) (error 'f64vector-slice "argument m is greater than or equal to n"))
    59     (let ((k (+ 1 (- n m))))
    60       (let ((y (make-f64vector k)))
    61         (dslice m n x y)
    62         y)))
    6341
    6442
     
    162140    ;; constructs a kd-tree from a list of points
    163141    list->kd-tree
    164     ;; constructs a kd-tree from a list of f64vectors
    165     f64vector->kd-tree
    166142    ;; nearest neighbor of a point
    167143    kd-tree-nearest-neighbor
     
    388364      )))
    389365
    390 
     366#|
    391367  (include "axial-vectors.scm")
    392368
     
    481457      f64vector->kd-tree/depth
    482458      )))
    483 
     459|#
    484460 
    485461  ;; Returns the nearest neighbor of p in tree t.
     
    724700                                                  (lambda (i p v) (and (equal? p p-kill) (list i p v)))
    725701                                                  (reverse (cis:elements ii)) pp vv)))
    726 
     702                                         ;(fprintf (current-error-port) "kd-tree-remove: ipvs = ~A~%" ipvs)
     703                                         ;(fprintf (current-error-port) "kd-tree-remove: pp = ~A~%" pp)
     704                                         ;(fprintf (current-error-port) "kd-tree-remove: vv = ~A~%" vv)
    727705                                       (and (pair? ipvs)
    728706                                            (let ((ii1 (fold (lambda (i ax) (cis:remove i ax))
     
    751729                         (KdNode (l p i r axis sz)
    752730
     731                                 ;(fprintf (current-error-port) "kd-tree-remove: p = ~A~%" p)
     732                                 ;(fprintf (current-error-port) "kd-tree-remove: p-kill = ~A~%" p-kill)
     733                                 
    753734                                 (if (equal? p p-kill)
    754735
     
    759740                                           (list->kd-tree* 0 (length pts1) pts1 axis)))
    760741
    761                                      (if (<= (coord axis p-kill)
    762                                              (coord axis p))
     742                                     (if (< (coord axis p-kill)
     743                                            (coord axis p))
    763744
    764745                                         (let* ((l1 (tree-remove l p-kill))
     
    881862    (let* ((list->kd-tree/depth
    882863            (make-list->kd-tree/depth point-class))
    883            (f64vector->kd-tree/depth
    884             (make-f64vector->kd-tree/depth point-class))
    885864           (kd-tree-remove
    886865            ((make-kd-tree-remove point-class)
     
    893872       (lambda (points #!key (leaf-factor 10) (point-ref identity) (make-value #f))
    894873         ((list->kd-tree/depth point-ref make-value) 0 (length points) points 0 leaf-factor: leaf-factor))
    895 
    896        (lambda (axial-vectors #!key (leaf-factor 10) (point-ref list->vector) (make-value #f))
    897          (let ((dimensions (length axial-vectors))
    898                (len (f64vector-length (car axial-vectors))))
    899            (if (zero? len) (KdLeaf cis:empty '() '() 0)
    900                ((f64vector->kd-tree/depth dimensions point-ref make-value) 0 (- len 1) axial-vectors 0 leaf-factor: leaf-factor))))
    901874
    902875       (make-kd-tree-nearest-neighbor point-class)
  • release/4/spatial-trees/trunk/spatial-trees.setup

    r26974 r27008  
    1616 
    1717  ;; Assoc list with properties for your extension:
    18   '((version 2.7)
     18  '((version 2.8)
    1919    ))
  • release/4/spatial-trees/trunk/tests/run.scm

    r26956 r27008  
    101101  (let ((n 1000) (k 40) (r 0.2) (randst (random-mtzig:init)))
    102102 
    103   (let recur ((ntrials 2))
     103  (let recur ((ntrials 10))
    104104    (let* ((xs (random-mtzig:f64vector-randn! n randst))
    105105           (ys (random-mtzig:f64vector-randn! n randst))
     
    131131
    132132
    133 (define (test2)
    134   (let ((n 100000) (k 40) (r 0.2) (randst (random-mtzig:init)))
    135  
    136   (let recur ((ntrials 1))
    137     (let ((xs (random-mtzig:f64vector-randn! n randst))
    138           (ys (random-mtzig:f64vector-randn! n randst))
    139           (zs (random-mtzig:f64vector-randn! n randst)))
    140 
    141       (let* (
    142              (axv   (list xs ys zs))
    143              (t     (with-instance ((<KdTree> KdTree3d)) (f64vector->kd-tree axv leaf-factor: 300)))
    144              (dd    (print "tree constructed!"))
    145              (pts (let precur ((i (- n 1)) (ax '()))
    146                   (let ((p (make-point (f64vector-ref xs i)
    147                                        (f64vector-ref ys i)
    148                                        (f64vector-ref zs i))))
    149                     (if (positive? i)
    150                         (precur (- i 1) (cons p ax))
    151                         (cons p ax)))))
    152              (xi    (inexact->exact (modulo (random-mtzig:random! randst) n)))
    153              (x     (list-ref pts xi))
    154              (xx    (with-instance ((<Point> Point3d))
    155                                    (make-point (+ 0.1 (coord 0 x))
    156                                                (- (coord 1 x) 0.1)
    157                                                (+ 0.1 (coord 2 x)))))
    158              )
    159 
    160 ;;      (print (with-instance ((<KdTree> KdTree3d)) (kd-tree->list* t)))
    161         (consistency-tests/3d pts t xx k r)
    162         ;;      (consistency-tests/2d pts t xx k r)
    163        
    164         (if (positive? ntrials)
    165             (recur (- ntrials 1)))
    166         )))
    167   ))
    168 
    169133
    170134(test1)
    171 (test2)
     135
Note: See TracChangeset for help on using the changeset viewer.