suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Reduce point3d rendering time by 50-70% by keeping points grouped

Browse Source 
The old depth sort hack split up groups of identical points in order
to sort them. Now the BSP tree build keeps them grouped, only splitting
groups of points as needed. Drawing parameters like color and pen
width are set only once for each group instead of once for each point.
The speedup is from reducing the number of calls to set them.
This commit is contained in:
Neil Toronto 2014-04-02 11:01:12 -06:00
parent e05ec03a6d
commit 04b49bcdd1
3 changed files with 90 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
pkgs/plot-pkgs/plot-lib/plot/private/plot3d/bsp.rkt
View File

@ -10,7 +10,7 @@
(provide (provide
;; BSP shapes ;; BSP shapes
(struct-out point) (struct-out points)
(struct-out line) (struct-out line)
(struct-out poly) (struct-out poly)
(struct-out lines) (struct-out lines)
@ -30,7 +30,7 @@
;; Parent type, not exported as a structure ;; Parent type, not exported as a structure
(struct shape ([data : Any]) #:transparent) (struct shape ([data : Any]) #:transparent)
(struct point shape ([vertex : FlVector]) (struct points shape ([vertices : (Listof FlVector)])
#:transparent) #:transparent)
(struct poly shape ([vertices : (Listof FlVector)] (struct poly shape ([vertices : (Listof FlVector)]
@ -81,11 +81,20 @@
;; =================================================================================================== ;; ===================================================================================================
;; Bin shapes: on the negative side of a plane, on the plane, or on the positive side ;; Bin shapes: on the negative side of a plane, on the plane, or on the positive side
(: bin-bsp-point (-> point FlVector (Values (Listof BSP-Shape) (Listof BSP-Shape)))) (: bin-bsp-points (-> points FlVector (Values (Listof BSP-Shape) (Listof BSP-Shape))))
(define (bin-bsp-point s plane) (define (bin-bsp-points s plane)
(define d (point3d-plane-dist (point-vertex s) plane)) (match-define (points data vs) s)
(cond [(flnonneg? d) (values empty (list s))] (define ds (map (λ ([v : FlVector]) (point3d-plane-dist v plane)) vs))
[else (values (list s) empty)])) (define-values (neg-vs pos-vs)
(for/fold ([neg-vs : (Listof FlVector) empty]
[pos-vs : (Listof FlVector) empty]
) ([v (in-list vs)])
(define d (point3d-plane-dist v plane))
(if (d . >= . 0.0)
(values neg-vs (cons v pos-vs))
(values (cons v neg-vs) pos-vs))))
(values (if (empty? neg-vs) empty (list (points data neg-vs)))
(if (empty? pos-vs) empty (list (points data pos-vs)))))
(: bin-bsp-line (-> line FlVector Boolean (Values (Listof BSP-Shape) (Listof BSP-Shape)))) (: bin-bsp-line (-> line FlVector Boolean (Values (Listof BSP-Shape) (Listof BSP-Shape))))
(define (bin-bsp-line s plane disjoint?) (define (bin-bsp-line s plane disjoint?)
@ -127,11 +136,14 @@
[(andmap flnonpos? ds) (values (list s) empty)] [(andmap flnonpos? ds) (values (list s) empty)]
[disjoint? (values empty empty)] [disjoint? (values empty empty)]
[else [else
(: vertices->lines (-> (Listof (Listof FlVector)) (Listof lines))) (: vertices->lines (-> (Listof (Listof FlVector)) (Listof BSP-Shape)))
(define (vertices->lines vss) (define (vertices->lines vss)
(append* (append*
(map (λ ([vs : (Listof FlVector)]) (map (λ ([vs : (Listof FlVector)])
(if ((length vs) . < . 2) empty (list (lines data vs)))) (define n (length vs))
(cond [(n . < . 2) empty]
[(n . = . 2) (list (line data (first vs) (second vs)))]
[else (list (lines data vs))]))
vss))) vss)))
(define-values (vss1 vss2) (split-lines3d vs plane)) (define-values (vss1 vss2) (split-lines3d vs plane))
@ -146,7 +158,7 @@
[else [else
(define s (first ss)) (define s (first ss))
(define-values (new-neg-ss new-pos-ss) (define-values (new-neg-ss new-pos-ss)
(cond [(point? s) (bin-bsp-point s plane)] (cond [(points? s) (bin-bsp-points s plane)]
[(line? s) (bin-bsp-line s plane disjoint?)] [(line? s) (bin-bsp-line s plane disjoint?)]
[(poly? s) (bin-bsp-poly s plane disjoint?)] [(poly? s) (bin-bsp-poly s plane disjoint?)]
[(lines? s) (bin-bsp-lines s plane disjoint?)] [(lines? s) (bin-bsp-lines s plane disjoint?)]
@ -171,8 +183,9 @@
(define (shapes->intervals ss i) (define (shapes->intervals ss i)
(for/list: ([s (in-list ss)]) (for/list: ([s (in-list ss)])
(match s (match s
[(point _ v) [(points _ vs)
(cons (flvector-ref v i) (flvector-ref v i))] (define xs (map (λ ([v : FlVector]) (flvector-ref v i)) vs))
(cons (apply min xs) (apply max xs))]
[(line _ v1 v2) [(line _ v1 v2)
(define x1 (flvector-ref v1 i)) (define x1 (flvector-ref v1 i))
(define x2 (flvector-ref v2 i)) (define x2 (flvector-ref v2 i))
@ -386,12 +399,13 @@
plane] plane]
[else #f])))])) [else #f])))]))
(: remove-null-shapes (-> (Listof BSP-Shape) (Listof BSP-Shape))) (: canonicalize-shapes (-> (Listof BSP-Shape) (Listof BSP-Shape)))
(define (remove-null-shapes ss) (define (canonicalize-shapes ss)
(append* (append*
(for/list : (Listof (Listof BSP-Shape)) ([s (in-list ss)]) (for/list : (Listof (Listof BSP-Shape)) ([s (in-list ss)])
(match s (match s
[(? point?) (list s)] [(points _ vs)
(if (empty? vs) empty (list s))]
[(line _ v1 v2) [(line _ v1 v2)
(if (equal? v1 v2) empty (list s))] (if (equal? v1 v2) empty (list s))]
[(poly data vs ls norm) [(poly data vs ls norm)
@ -399,13 +413,16 @@
(if ((length vs) . < . 3) empty (list (poly data vs ls norm))))] (if ((length vs) . < . 3) empty (list (poly data vs ls norm))))]
[(lines data vs) [(lines data vs)
(let ([vs (canonical-lines3d vs)]) (let ([vs (canonical-lines3d vs)])
(if ((length vs) . < . 2) empty (list (lines data vs))))])))) (define n (length vs))
(cond [(n . < . 2) empty]
[(n . = . 2) (list (line data (first vs) (second vs)))]
[else (list (lines data vs))]))]))))
;; =================================================================================================== ;; ===================================================================================================
(: build-bsp-tree (-> (Listof BSP-Shape) BSP-Tree)) (: build-bsp-tree (-> (Listof BSP-Shape) BSP-Tree))
(define (build-bsp-tree ss) (define (build-bsp-tree ss)
(let* ([ss (remove-null-shapes ss)]) (let* ([ss (canonicalize-shapes ss)])
(build-bsp-tree* ss))) (build-bsp-tree* ss)))
(: try-bsp-split (-> (Listof BSP-Shape) FlVector Boolean (-> (U #f BSP-Tree)) (U #f BSP-Tree))) (: try-bsp-split (-> (Listof BSP-Shape) FlVector Boolean (-> (U #f BSP-Tree)) (U #f BSP-Tree)))
@ -534,17 +551,17 @@
bsp)])) bsp)]))
;; --------------------------------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------------------------------
;; Phase 3: build by splitting on axis-aligned planes using lines and point vertices ;; Phase 3: build by splitting on axis-aligned planes using lines and points vertices
(: build-bsp-tree*/axial (-> (Listof BSP-Shape) (U #f BSP-Tree))) (: build-bsp-tree*/axial (-> (Listof BSP-Shape) (U #f BSP-Tree)))
(define (build-bsp-tree*/axial ss) (define (build-bsp-tree*/axial ss)
(define ls (filter lines? ss)) (define ls (filter lines? ss))
(define ps (filter point? ss)) (define ps (filter points? ss))
(cond (cond
[(and (empty? ls) (empty? ps)) #f] [(and (empty? ls) (empty? ps)) #f]
[else [else
(define vs (remove-duplicates (append (append* (map lines-vertices ls)) (define vs (remove-duplicates (append (append* (map lines-vertices ls))
(map point-vertex ps)))) (append* (map points-vertices ps)))))
(define axes (vertices->axes vs)) (define axes (vertices->axes vs))
(define center (list->flvector (map axis-mid axes))) (define center (list->flvector (map axis-mid axes)))
@ -566,7 +583,7 @@
(: bsp-tree-insert (-> BSP-Tree (Listof BSP-Shape) BSP-Tree)) (: bsp-tree-insert (-> BSP-Tree (Listof BSP-Shape) BSP-Tree))
(define (bsp-tree-insert bsp ss) (define (bsp-tree-insert bsp ss)
(bsp-tree-insert* bsp (remove-null-shapes ss))) (bsp-tree-insert* bsp (canonicalize-shapes ss)))
(: bsp-tree-insert* (-> BSP-Tree (Listof BSP-Shape) BSP-Tree)) (: bsp-tree-insert* (-> BSP-Tree (Listof BSP-Shape) BSP-Tree))
(define (bsp-tree-insert* bsp ss) (define (bsp-tree-insert* bsp ss)

54
pkgs/plot-pkgs/plot-lib/plot/private/plot3d/plot-area.rkt
View File

@ -716,12 +716,13 @@
(for/list ([s (in-list ss)]) (for/list ([s (in-list ss)])
(match s (match s
[(point data v) [(points data vs)
;; Bring point forward a smidge so if it's *on* a polygon it'll draw if on either side ;; Bring points forward a smidge so any *on* a polygon will draw on either side
(define frac #i1/10000) (define frac #i1/10000)
(point data (flvector (+ (flvector-ref v 0) (* dx frac)) (points data (for/list ([v (in-list vs)])
(flvector (+ (flvector-ref v 0) (* dx frac))
(+ (flvector-ref v 1) (* dy frac)) (+ (flvector-ref v 1) (* dy frac))
(+ (flvector-ref v 2) (* dz frac))))] (+ (flvector-ref v 2) (* dz frac)))))]
[(line data v1 v2) [(line data v1 v2)
;; Bring line forward by about half its apparent thickness ;; Bring line forward by about half its apparent thickness
(define frac (* 0.5 (/ pen-width area-size))) (define frac (* 0.5 (/ pen-width area-size)))
@ -847,7 +848,7 @@
(send pd set-pen pen-color pen-width pen-style) (send pd set-pen pen-color pen-width pen-style)
(send pd draw-lines (map norm->dc vs))) (send pd draw-lines (map norm->dc vs)))
(define (draw-glyph data v) (define (draw-glyph data vs)
(match-define (glyph-data alpha symbol size (match-define (glyph-data alpha symbol size
pen-color pen-width pen-style pen-color pen-width pen-style
brush-color brush-style) brush-color brush-style)
@ -855,16 +856,17 @@
(send pd set-alpha alpha) (send pd set-alpha alpha)
(send pd set-pen pen-color pen-width pen-style) (send pd set-pen pen-color pen-width pen-style)
(send pd set-brush brush-color brush-style) (send pd set-brush brush-color brush-style)
(send pd draw-glyphs (list (norm->dc v)) symbol size)) (send pd draw-glyphs (map norm->dc vs) symbol size))
(define (draw-text data v) (define (draw-text data vs)
(match-define (text-data alpha anchor angle dist str font-size font-family color outline?) data) (match-define (text-data alpha anchor angle dist str font-size font-family color outline?) data)
(send pd set-alpha alpha) (send pd set-alpha alpha)
(send pd set-font font-size font-family) (send pd set-font font-size font-family)
(send pd set-text-foreground color) (send pd set-text-foreground color)
(send pd draw-text str (norm->dc v) anchor angle dist #:outline? outline?)) (for ([v (in-list vs)])
(send pd draw-text str (norm->dc v) anchor angle dist #:outline? outline?)))
(define (draw-arrow data v) (define (draw-arrow data vs)
(match-define (arrow-data alpha v1 v2 outline-color pen-color pen-width pen-style) data) (match-define (arrow-data alpha v1 v2 outline-color pen-color pen-width pen-style) data)
(let ([v1 (norm->dc v1)] (let ([v1 (norm->dc v1)]
[v2 (norm->dc v2)]) [v2 (norm->dc v2)])
@ -874,17 +876,17 @@
(send pd set-pen pen-color pen-width pen-style) (send pd set-pen pen-color pen-width pen-style)
(send pd draw-arrow v1 v2))) (send pd draw-arrow v1 v2)))
(define (draw-point s) (define (draw-points s)
(match-define (point data v) s) (match-define (points data vs) s)
(cond [(glyph-data? data) (draw-glyph data v)] (cond [(glyph-data? data) (draw-glyph data vs)]
[(text-data? data) (draw-text data v)] [(text-data? data) (draw-text data vs)]
[(arrow-data? data) (draw-arrow data v)])) [(arrow-data? data) (draw-arrow data (first vs))]))
(define (draw-shape s) (define (draw-shape s)
(cond [(poly? s) (draw-polygon s)] (cond [(poly? s) (draw-polygon s)]
[(line? s) (draw-line s)] [(line? s) (draw-line s)]
[(lines? s) (draw-lines s)] [(lines? s) (draw-lines s)]
[(point? s) (draw-point s)] [(points? s) (draw-points s)]
[else (raise-argument-error 'draw-shape "known shape" s)])) [else (raise-argument-error 'draw-shape "known shape" s)]))
;; =============================================================================================== ;; ===============================================================================================
@ -1008,12 +1010,6 @@
(map plot->norm vs)))])))) (map plot->norm vs)))]))))
(define/public (put-lines vs) (define/public (put-lines vs)
#;
(for ([vs (vrational-sublists vs)])
(for ([v1 (in-list vs)]
[v2 (in-list (rest vs))])
(put-line v1 v2)))
(for ([vs (vrational-sublists vs)]) (for ([vs (vrational-sublists vs)])
(unless (empty? vs) (unless (empty? vs)
(let ([vss (if clipping? (let ([vss (if clipping?
@ -1117,17 +1113,17 @@
#:outline? [outline? #f] #:outline? [outline? #f]
#:layer [layer plot3d-area-layer]) #:layer [layer plot3d-area-layer])
(when (and (vrational? v) (in-bounds? v)) (when (and (vrational? v) (in-bounds? v))
(add-shape! layer (point (text-data alpha anchor angle dist str (add-shape! layer (points (text-data alpha anchor angle dist str
font-size font-family text-foreground outline?) font-size font-family text-foreground outline?)
(plot->norm v))))) (list (plot->norm v))))))
(define/public (put-glyphs vs symbol size #:layer [layer plot3d-area-layer]) (define/public (put-glyphs vs symbol size #:layer [layer plot3d-area-layer])
(for ([v (in-list vs)]) (let ([vs (filter (λ (v) (and (vrational? v) (in-bounds? v))) vs)])
(when (and (vrational? v) (in-bounds? v)) (unless (empty? vs)
(add-shape! layer (point (glyph-data alpha symbol size (add-shape! layer (points (glyph-data alpha symbol size
pen-color pen-width pen-style pen-color pen-width pen-style
brush-color brush-style) brush-color brush-style)
(plot->norm v)))))) (map plot->norm vs))))))
(define/public (put-arrow v1 v2) (define/public (put-arrow v1 v2)
(when (and (vrational? v1) (vrational? v2) (in-bounds? v1)) (when (and (vrational? v1) (vrational? v2) (in-bounds? v1))
@ -1135,9 +1131,9 @@
(define c (v* (v+ v1 v2) 1/2)) (define c (v* (v+ v1 v2) 1/2))
(define outline-color (->brush-color (plot-background))) (define outline-color (->brush-color (plot-background)))
(add-shape! plot3d-area-layer (add-shape! plot3d-area-layer
(point (arrow-data alpha (plot->norm v1) (plot->norm v2) (points (arrow-data alpha (plot->norm v1) (plot->norm v2)
outline-color pen-color pen-width pen-style) outline-color pen-color pen-width pen-style)
(plot->norm c)))] (list (plot->norm c))))]
[else [else
(put-line v1 v2)]))) (put-line v1 v2)])))
)) ; end class )) ; end class

16
pkgs/plot-pkgs/plot-test/plot/tests/plot3d-bsp-tests.rkt
View File

@ -72,6 +72,22 @@ slow parts
t)) t))
-1 1 #:width 2 #:color 2))) -1 1 #:width 2 #:color 2)))
(let* ([xs (sample (uniform-dist -1 1) 10000)]
[ys (sample (uniform-dist -1 1) 10000)]
[zs (sample (uniform-dist -1 1) 10000)]
[xyzs (map list xs ys zs)])
(time
(plot3d (list (isosurface3d (λ (x y z) (+ x y z)) 0 -1 1 -1 1 -1 1
#:samples 2
#:line-width 2)
(isosurface3d (λ (x y z) x) 0 #:samples 2
#:color "red"
#:line-width 2)
(isosurface3d (λ (x y z) (+ x (- y) z)) 0
#:samples 2
#:line-width 2)
(points3d xyzs #:sym 'dot)))))
(time (time
(plot3d (plot3d
(list (contour-intervals3d (list (contour-intervals3d