Browse code
Adding octcone implementation
Ed L authored on 04/05/2016 02:12:43Showing 1 changed files
| ... | ... |
@@ -18,18 +18,76 @@ |
| 18 | 18 |
(with-slots (nw-bucket ne-bucket sw-bucket se-bucket center) octcone |
| 19 | 19 |
(with-accessors ((center-y 3dr::point-y) (center-z 3dr::point-z)) center |
| 20 | 20 |
(with-accessors ((point-y 3dr::point-y) (point-z 3dr::point-z)) point |
| 21 |
- (vector-push-extend |
|
| 22 |
- point |
|
| 23 |
- (if (< point-y center-y) |
|
| 24 |
- (if (< point-z center-z) sw-bucket nw-bucket) |
|
| 25 |
- (if (< point-z center-z) se-bucket ne-bucket))))))) |
|
| 21 |
+ (vector-push-extend point |
|
| 22 |
+ (if (< point-y center-y) |
|
| 23 |
+ (if (< point-z center-z) |
|
| 24 |
+ sw-bucket |
|
| 25 |
+ nw-bucket) |
|
| 26 |
+ (if (< point-z center-z) |
|
| 27 |
+ se-bucket |
|
| 28 |
+ ne-bucket))))))) |
|
| 26 | 29 |
|
| 27 |
-(defparameter *octc* (make-instance 'octcone :center (vector 0 0 0))) |
|
| 30 |
+(defun normalize-bucket (octcone bucket) |
|
| 31 |
+ (let ((the-bucket (slot-value octcone bucket))) |
|
| 32 |
+ (setf (slot-value octcone bucket) |
|
| 33 |
+ (sort the-bucket #'< :key (lambda (point) (3dr::c-distance point #(0 0 0))))))) |
|
| 34 |
+ |
|
| 35 |
+(defun normalize-buckets (octcone) |
|
| 36 |
+ (loop for bucket in '(nw-bucket ne-bucket se-bucket sw-bucket) |
|
| 37 |
+ collect (normalize-bucket octcone bucket))) |
|
| 38 |
+ |
|
| 39 |
+(defun half-power-two (low high) |
|
| 40 |
+ (expt 2 |
|
| 41 |
+ (floor |
|
| 42 |
+ (log |
|
| 43 |
+ (abs |
|
| 44 |
+ (+ low |
|
| 45 |
+ (floor (- high low) |
|
| 46 |
+ 2))) |
|
| 47 |
+ 2)))) |
|
| 48 |
+ |
|
| 49 |
+(defun subdivide-bucket (octcone bucket) |
|
| 50 |
+ (let ((the-bucket (slot-value octcone bucket))) |
|
| 51 |
+ (when (< 0 (length the-bucket)) |
|
| 52 |
+ (let* ((max-y (reduce #'max the-bucket :key #'3dr::point-y)) |
|
| 53 |
+ (min-y (reduce #'min the-bucket :key #'3dr::point-y)) |
|
| 54 |
+ |
|
| 55 |
+ (max-z (reduce #'max the-bucket :key #'3dr::point-z)) |
|
| 56 |
+ (min-z (reduce #'min the-bucket :key #'3dr::point-z)) |
|
| 57 |
+ |
|
| 58 |
+ (new-octc (make-instance 'octcone |
|
| 59 |
+ :center (vector 0 |
|
| 60 |
+ (half-power-two min-y max-y) |
|
| 61 |
+ (half-power-two min-z max-z))))) |
|
| 62 |
+ |
|
| 63 |
+ (values (prog1 new-octc |
|
| 64 |
+ (map nil |
|
| 65 |
+ (lambda (point) (bucket-point point new-octc)) |
|
| 66 |
+ the-bucket)) |
|
| 67 |
+ (vector min-y max-y) |
|
| 68 |
+ (vector min-z max-z)))))) |
|
| 69 |
+ |
|
| 70 |
+(defun subdivide-buckets (octcone) |
|
| 71 |
+ (loop for bucket in '(nw-bucket ne-bucket se-bucket sw-bucket) |
|
| 72 |
+ collect (subdivide-bucket octcone bucket))) |
|
| 73 |
+ |
|
| 74 |
+(defun show-bucket-sizes (octcone) |
|
| 75 |
+ (loop for bucket in '(nw-bucket ne-bucket se-bucket sw-bucket) |
|
| 76 |
+ collect (length (slot-value octcone bucket)))) |
|
| 77 |
+ |
|
| 78 |
+(defvar *octc*) |
|
| 79 |
+(defvar *points*) |
|
| 80 |
+ |
|
| 81 |
+(defun main () |
|
| 82 |
+ (setf *octc* (make-instance 'octcone :center (vector 0 0 0))) |
|
| 83 |
+ |
|
| 84 |
+ (flet ((100- (x) (- 100 x))) |
|
| 85 |
+ (setf *points* |
|
| 86 |
+ (loop repeat 1000 |
|
| 87 |
+ collect (vector (random 200) (100- (random 200)) (100- (random 200)))))) |
|
| 88 |
+ |
|
| 89 |
+ (mapcar (lambda (x) |
|
| 90 |
+ (bucket-point x *octc*)) |
|
| 91 |
+ *points*)) |
|
| 28 | 92 |
|
| 29 |
-(flet ((10- (x) (- 10 x))) |
|
| 30 |
- (defparameter *points* (loop repeat 100 |
|
| 31 |
- collect (vector (10- (random 20)) (10- (random 20)) (10- (random 20)))))) |
|
| 32 | 93 |
|
| 33 |
-(mapcar (lambda (x) |
|
| 34 |
- (bucket-point x *octc*)) |
|
| 35 |
- *points*) |