Changeset 25912 in project
 Timestamp:
 02/15/12 08:00:43 (8 years ago)
 Location:
 release/4/spatialtrees/trunk
 Files:

 2 added
 2 deleted
 1 edited
Legend:
 Unmodified
 Added
 Removed

release/4/spatialtrees/trunk/kdtree.scm
r25904 r25912 25 25 (import scheme chicken datastructures) 26 26 27 (requirelibrary srfi1 )27 (requirelibrary srfi1 extras) 28 28 (requireextension typeclass datatype) 29 29 30 (import (only srfi1 fold listtabulate drop take every)) 30 (import (only srfi1 xcons fold listtabulate drop take every) 31 (only extras fprintf)) 31 32 32 33 … … 46 47 47 48 ) 49 50 (define (minimumby lst less?) 51 (if (null? lst) #f 52 (let recur ((lst (cdr lst)) (m (car lst))) 53 (if (null? lst) m 54 (if (less? (car lst) m) 55 (recur (cdr lst) (car lst)) 56 (recur (cdr lst) m) 57 )) 58 ))) 48 59 49 60 (define (sum lst) (fold + 0. lst)) … … 53 64 (lambda (a b) 54 65 (let ((diff2 (lambda (i) (let ((v ( (coord i a) (coord i b)))) (* v v))))) 55 (sum (listtabulate (  (dimension a) 1) diff2)))))66 (sum (listtabulate (dimension a) diff2))))) 56 67 57 68 (comparedistance … … 75 86 ) 76 87 88 (definerecordprinter (point3d p out) 89 (fprintf out "#<~a,~a,~a>" 90 (point3dx p) 91 (point3dy p) 92 (point3dz p) 93 )) 77 94 78 95 (define Pointpoint3d … … 99 116 (sort points (lambda (a b) (< (coord axis a) (coord axis b))))) 100 117 (medianindex 101 (quotient ( length sortedpoints) 2)))102 118 (quotient ( (length sortedpoints) 1) 2))) 119 103 120 (KdNode (list>kdtree/depth (take sortedpoints medianindex) (+ 1 depth)) 104 121 (listref sortedpoints medianindex) 105 (list>kdtree/depth (drop sortedpoints (+ 1 medianindex)) (+ 1 depth))122 (list>kdtree/depth (drop sortedpoints (+ medianindex 1)) (+ 1 depth)) 106 123 axis) 107 124 )) … … 116 133 (letrec ((findnearest 117 134 (lambda (t1 t2 p probe xp xprobe) 135 118 136 (let* ((candidates1 119 137 (let ((best1 (nearestneighbor t1 probe))) 120 138 (or (and best1 (list best1 p)) (list p)))) 121 (sphereintersectsplane? 122 (<= (expt ( xprobe xp) 2.) (dist2 probe p))) 139 140 (sphereintersectsplane? 141 (let ((v ( xprobe xp))) 142 (< (* v v) (dist2 probe (car candidates1))))) 143 123 144 (candidates2 124 145 (if sphereintersectsplane? 125 (append candidates1 (or (nearestneighbor t2 probe) '())) 146 (let ((nn (nearestneighbor t2 probe))) 147 (if nn (append candidates1 (list nn)) candidates1)) 126 148 candidates1))) 127 (car (sort candidates2 (lambda (a b) (positive? (comparedistance probe a b))))) 149 150 (minimumby candidates2 (lambda (a b) (negative? (comparedistance probe a b)))) 128 151 ))) 152 129 153 130 154 (nearestneighbor … … 137 161 (let ((xprobe (coord axis probe)) 138 162 (xp (coord axis p))) 163 139 164 (if (<= xprobe xp) 140 165 (findnearest l r p probe xp xprobe) … … 234 259 (KdNode (l p r axis) 235 260 (let ((x (coord axis p))) 236 (and (every (lambda (y) (<= x (coord axis y))) (kdtree>list l)) 237 (every (lambda (y) (<= x (coord axis y))) (kdtree>list r))))) 261 (and (every (lambda (y) (<= (coord axis y) x )) 262 (kdtree>list l)) 263 (every (lambda (y) (>= (coord axis y) x)) 264 (kdtree>list r))))) 238 265 ))) 239 266
Note: See TracChangeset
for help on using the changeset viewer.