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

1d, 2d and 3d function renderers no longer sample outside the function's bounds

Browse Source 
This makes it more efficient to plot piecewise functions by drawing each piece with one renderer, and possible to plot functions with discontinuities by using a renderer to draw each continuous piece.
This commit is contained in:
Neil Toronto 2012-05-25 10:36:48 +09:00
parent cee88f05dd
commit 365ee2c70d
13 changed files with 260 additions and 146 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/plot/common/math.rkt
View File

@ -558,6 +558,10 @@
[x2 (in-list (rest xs))])
(ivl x1 x2))]))
(defproc (clamp-real [x real?] [i ivl?]) real?
(match-define (ivl a b) i)
(max (min x b) a))
;; ===================================================================================================
;; Rectangles

38
collects/plot/common/plot-element.rkt
View File

@ -36,8 +36,7 @@
(λ (r)
(match-define (vector xi yi) r)
(cond [(ivl-known? xi)
(match-define (ivl x-min x-max) xi)
(match-define (sample xs ys y-min y-max) (f x-min x-max samples))
(match-define (sample xs ys y-min y-max) (f xi samples))
(vector xi (ivl y-min y-max))]
[else r])))
@ -45,8 +44,7 @@
(λ (r)
(match-define (vector xi yi) r)
(cond [(ivl-known? yi)
(match-define (ivl y-min y-max) yi)
(match-define (sample ys xs x-min x-max) (f y-min y-max samples))
(match-define (sample ys xs x-min x-max) (f yi samples))
(vector (ivl x-min x-max) yi)]
[else r])))
@ -66,10 +64,8 @@
(λ (r)
(match-define (vector xi yi zi) r)
(cond [(and (ivl-known? xi) (ivl-known? yi))
(match-define (ivl x-min x-max) xi)
(match-define (ivl y-min y-max) yi)
(match-define (2d-sample xs ys zss z-min z-max)
(f x-min x-max samples y-min y-max samples))
(f (vector xi yi) (vector samples samples)))
(vector xi yi (ivl z-min z-max))]
[else r])))
@ -87,12 +83,21 @@
(let/ec break
;; Shortcut eval: if the plot bounds are all given, the code below just returns them anyway
(when (rect-known? given-bounds-rect) (break given-bounds-rect))
;; Objective: find the fixpoint of F starting at given-bounds-rect
;; A list of elements' known bounds rects
(define elem-bounds-rects (filter values (map plot-element-bounds-rect elems)))
;; The minimum bounding rectangle
(define min-bounds-rect
(cond [(empty? elem-bounds-rects) given-bounds-rect]
[else (rect-join given-bounds-rect
(rect-meet given-bounds-rect
(apply rect-join elem-bounds-rects)))]))
;; Objective: find the fixpoint of F starting at min-bounds-rect
(define (F bounds-rect) (rect-meet given-bounds-rect (apply-bounds* elems bounds-rect)))
;; Iterate joint bounds to (hopefully) a fixpoint
(define-values (bounds-rect area delta-area)
(for/fold ([bounds-rect given-bounds-rect]
[area (rect-area given-bounds-rect)] [delta-area #f]
(for/fold ([bounds-rect min-bounds-rect]
[area (rect-area min-bounds-rect)]
[delta-area #f]
) ([n (in-range max-iters)])
;(printf "bounds-rect = ~v~n" bounds-rect)
;; Get new bounds from the elements' bounds functions
@ -120,13 +125,6 @@
(define (apply-bounds elem bounds-rect)
(match-define (plot-element elem-bounds-rect elem-bounds-fun _) elem)
;(printf "elem-bounds-rect = ~v~n" elem-bounds-rect)
(let* ([new-bounds-rect (if elem-bounds-rect
(rect-meet bounds-rect elem-bounds-rect)
bounds-rect)]
[new-bounds-rect (if elem-bounds-fun
(elem-bounds-fun (rect-inexact->exact new-bounds-rect))
new-bounds-rect)]
[new-bounds-rect (if elem-bounds-rect
(rect-join new-bounds-rect elem-bounds-rect)
new-bounds-rect)])
new-bounds-rect))
(let* ([bounds-rect (if elem-bounds-fun (elem-bounds-fun bounds-rect) bounds-rect)]
[bounds-rect (if elem-bounds-rect (rect-join elem-bounds-rect bounds-rect) bounds-rect)])
bounds-rect))

124
collects/plot/common/sample.rkt
View File

@ -10,9 +10,16 @@
(provide (all-defined-out))
(defproc (build-linear-seq [start real?] [step real?]
[num exact-nonnegative-integer?]) (listof real?)
(for/list ([n (in-range num)])
(+ start (* n step))))
[num exact-nonnegative-integer?]
[min-val real? start]
[max-val real? (+ start (* (- num 1) step))]
) (listof real?)
(define n-start (max 0 (inexact->exact (floor (/ (- min-val start) step)))))
(define n-end (min num (+ (inexact->exact (ceiling (/ (- max-val start) step))) 1)))
(for*/list ([n (in-range n-start n-end)]
[x (in-value (+ start (* n step)))]
#:when (<= min-val x max-val))
x))
(defproc (linear-seq [start real?] [end real?] [num exact-nonnegative-integer?]
[#:start? start? boolean? #t]
@ -57,6 +64,41 @@
(match-define (invertible-function _ finv) (apply-axis-transform transform start end))
(map finv (linear-seq start end num #:start? start? #:end? end?)))
;; ===================================================================================================
(define (ensure-endpoints xs i-min i-max)
(cond [(empty? xs) (cond [(i-min . = . i-max) (list i-min)]
[else (list i-min i-max)])]
[else
(define xs-min (first xs))
(define xs-max (last xs))
(let* ([xs (if (xs-min . <= . i-min) xs (cons i-min xs))]
[xs (if (xs-max . >= . i-max) xs (append xs (list i-max)))])
xs)]))
(defproc (sample-points [outer-ivl rational-ivl?] [inner-ivl ivl?]
[num exact-nonnegative-integer?]
[transform axis-transform/c id-transform]) (listof real?)
(let* ([inner-ivl (ivl-meet inner-ivl outer-ivl)]
[inner-ivl (ivl-inexact->exact inner-ivl)]
[outer-ivl (ivl-inexact->exact outer-ivl)])
(match-define (ivl o-min o-max) outer-ivl)
(match-define (ivl i-min i-max) inner-ivl)
(match-define (invertible-function f finv) (apply-axis-transform transform o-min o-max))
(cond
[(ivl-empty? inner-ivl) empty]
[(= num 0) empty]
[(or (= o-min o-max) (= num 1))
(cond [(<= i-min o-min i-max) (build-list num (λ _ o-min))]
[else empty])]
[else
(define step (/ (- o-max o-min) (- num 1)))
(let* ([xs (map finv (build-linear-seq o-min step num (f i-min) (f i-max)))]
[xs (remove-duplicates (map (λ (x) (clamp-real x inner-ivl)) xs))])
(ensure-endpoints xs i-min i-max))])))
;; ===================================================================================================
(struct mapped-function (f fmap) #:transparent
#:property prop:procedure
(λ (g x) ((mapped-function-f g) x)))
@ -75,26 +117,28 @@
(struct 2d-sample (xs ys zss z-min z-max) #:transparent)
(struct 3d-sample (xs ys zs dsss d-min d-max) #:transparent)
(defcontract sampler/c (real? real? exact-nonnegative-integer? . -> . sample?))
(defcontract sampler/c
(-> rational-ivl? exact-nonnegative-integer? sample?))
(defcontract 2d-sampler/c (real? real? exact-nonnegative-integer?
real? real? exact-nonnegative-integer?
. -> . 2d-sample?))
(defcontract 2d-sampler/c
(-> (vector/c rational-ivl? rational-ivl?)
(vector/c exact-nonnegative-integer? exact-nonnegative-integer?)
2d-sample?))
(defcontract 3d-sampler/c (real? real? exact-nonnegative-integer?
real? real? exact-nonnegative-integer?
real? real? exact-nonnegative-integer?
. -> . 3d-sample?))
(defcontract 3d-sampler/c
(-> (vector/c rational-ivl? rational-ivl? rational-ivl?)
(vector/c exact-nonnegative-integer? exact-nonnegative-integer? exact-nonnegative-integer?)
3d-sample?))
(defproc (make-function->sampler [transform-thnk (-> axis-transform/c)]
) ((real? . -> . real?) . -> . sampler/c)
(λ (f)
) (-> (real? . -> . real?) ivl? sampler/c)
(λ (f inner-ivl)
(define memo (make-hash))
(λ (x-min x-max x-samples)
(λ (outer-ivl num)
(define tx (transform-thnk))
(hash-ref! memo (vector x-min x-max x-samples tx)
(hash-ref! memo (vector outer-ivl num tx)
(λ ()
(define xs (nonlinear-seq x-min x-max x-samples tx))
(define xs (sample-points outer-ivl inner-ivl num tx))
(define ys (map* f xs))
(define rys (filter rational? ys))
(define-values (y-min y-max)
@ -106,20 +150,25 @@
(defproc (make-2d-function->sampler [transform-x-thnk (-> axis-transform/c)]
[transform-y-thnk (-> axis-transform/c)]
) ((real? real? . -> . real?) . -> . 2d-sampler/c)
(λ (f)
) (-> (real? real? . -> . real?)
(vector/c ivl? ivl?)
2d-sampler/c)
(λ (f inner-rect)
(define memo (make-hash))
(λ (x-min x-max x-samples y-min y-max y-samples)
(λ (outer-rect nums)
(define tx (transform-x-thnk))
(define ty (transform-y-thnk))
(hash-ref! memo (vector x-min x-max x-samples tx y-min y-max y-samples ty)
(hash-ref! memo (vector outer-rect nums tx ty)
(λ ()
(define xs (nonlinear-seq x-min x-max x-samples tx))
(define ys (nonlinear-seq y-min y-max y-samples ty))
(match-define (vector outer-x-ivl outer-y-ivl) outer-rect)
(match-define (vector inner-x-ivl inner-y-ivl) inner-rect)
(match-define (vector x-num y-num) nums)
(define xs (sample-points outer-x-ivl inner-x-ivl x-num tx))
(define ys (sample-points outer-y-ivl inner-y-ivl y-num ty))
(define z-min #f)
(define z-max #f)
(define zss (for/vector #:length y-samples ([y (in-list ys)])
(for/vector #:length x-samples ([x (in-list xs)])
(define zss (for/vector #:length (length ys) ([y (in-list ys)])
(for/vector #:length (length xs) ([x (in-list xs)])
(let ([z (f x y)])
(when (rational? z)
(unless (and z-min (z . >= . z-min)) (set! z-min z))
@ -132,25 +181,28 @@
(defproc (make-3d-function->sampler [transform-x-thnk (-> axis-transform/c)]
[transform-y-thnk (-> axis-transform/c)]
[transform-z-thnk (-> axis-transform/c)]
) ((real? real? real? . -> . real?) . -> . 3d-sampler/c)
(λ (f)
) (-> (real? real? real? . -> . real?)
(vector/c ivl? ivl? ivl?)
3d-sampler/c)
(λ (f inner-rect)
(define memo (make-hash))
(λ (x-min x-max x-samples y-min y-max y-samples z-min z-max z-samples)
(λ (outer-rect nums)
(define tx (transform-x-thnk))
(define ty (transform-y-thnk))
(define tz (transform-z-thnk))
(hash-ref! memo (vector x-min x-max x-samples tx
y-min y-max y-samples ty
z-min z-max z-samples tz)
(hash-ref! memo (vector outer-rect nums tx ty tz)
(λ ()
(define xs (nonlinear-seq x-min x-max x-samples tx))
(define ys (nonlinear-seq y-min y-max y-samples ty))
(define zs (nonlinear-seq z-min z-max z-samples tz))
(match-define (vector outer-x-ivl outer-y-ivl outer-z-ivl) outer-rect)
(match-define (vector inner-x-ivl inner-y-ivl inner-z-ivl) inner-rect)
(match-define (vector x-num y-num z-num) nums)
(define xs (sample-points outer-x-ivl inner-x-ivl x-num tx))
(define ys (sample-points outer-y-ivl inner-y-ivl y-num ty))
(define zs (sample-points outer-z-ivl inner-z-ivl z-num tz))
(define d-min #f)
(define d-max #f)
(define dsss (for/vector #:length z-samples ([z (in-list zs)])
(for/vector #:length y-samples ([y (in-list ys)])
(for/vector #:length x-samples ([x (in-list xs)])
(define dsss (for/vector #:length (length zs) ([z (in-list zs)])
(for/vector #:length (length ys) ([y (in-list ys)])
(for/vector #:length (length xs) ([x (in-list xs)])
(let ([d (f x y z)])
(when (rational? d)
(unless (and d-min (d . >= . d-min)) (set! d-min d))

15
collects/plot/common/samplers.rkt
View File

@ -5,18 +5,23 @@
(require racket/match racket/flonum racket/math racket/contract racket/list
unstable/latent-contract/defthing
"parameters.rkt"
"sample.rkt")
"sample.rkt"
"math.rkt")
(provide (all-defined-out))
(defthing function->sampler ((real? . -> . real?) . -> . sampler/c)
(defthing function->sampler ((real? . -> . real?) ivl? . -> . sampler/c)
(make-function->sampler plot-x-transform))
(defthing inverse->sampler ((real? . -> . real?) . -> . sampler/c)
(defthing inverse->sampler ((real? . -> . real?) ivl? . -> . sampler/c)
(make-function->sampler plot-y-transform))
(defthing 2d-function->sampler ((real? real? . -> . real?) . -> . 2d-sampler/c)
(defthing 2d-function->sampler (-> (real? real? . -> . real?)
(vector/c ivl? ivl?)
2d-sampler/c)
(make-2d-function->sampler plot-x-transform plot-y-transform))
(defthing 3d-function->sampler ((real? real? real? . -> . real?) . -> . 3d-sampler/c)
(defthing 3d-function->sampler (-> (real? real? real? . -> . real?)
(vector/c ivl? ivl? ivl?)
3d-sampler/c)
(make-3d-function->sampler plot-x-transform plot-y-transform plot-z-transform))

2
collects/plot/contracted/math.rkt
View File

@ -21,7 +21,7 @@
empty-ivl unknown-ivl rational-ivl?
(activate-contract-out
ivl-empty? ivl-known? ivl-rational? ivl-singular? ivl-length ivl-center ivl-zero-length?
ivl-inexact->exact ivl-contains? bounds->intervals))
ivl-inexact->exact ivl-contains? bounds->intervals clamp-real))
;; Rectangles
(provide (contract-out [rect-meet (->* () () #:rest (listof (vectorof ivl?)) (vectorof ivl?))]

42
collects/plot/plot2d/contour.rkt
View File

@ -13,9 +13,11 @@
;; One contour line
(define ((isoline-render-proc g z samples color width style alpha label) area)
(match-define (vector (ivl x-min x-max) (ivl y-min y-max)) (send area get-bounds-rect))
(define sample (g x-min x-max (animated-samples samples)
y-min y-max (animated-samples samples)))
(match-define (vector x-ivl y-ivl) (send area get-bounds-rect))
(match-define (ivl x-min x-max) x-ivl)
(match-define (ivl y-min y-max) y-ivl)
(define num (animated-samples samples))
(define sample (g (vector x-ivl y-ivl) (vector num num)))
(match-define (2d-sample xs ys zss z-min z-max) sample)
(when (<= z-min z z-max)
@ -43,8 +45,10 @@
[#:alpha alpha (real-in 0 1) (line-alpha)]
[#:label label (or/c string? #f) #f]
) renderer2d?
(define g (2d-function->sampler f))
(renderer2d (vector (ivl x-min x-max) (ivl y-min y-max)) #f default-ticks-fun
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(define g (2d-function->sampler f (vector x-ivl y-ivl)))
(renderer2d (vector x-ivl y-ivl) #f default-ticks-fun
(isoline-render-proc g z samples color width style alpha label)))
;; ===================================================================================================
@ -52,9 +56,11 @@
(define ((contours-render-proc g levels samples colors widths styles alphas label) area)
(let/ec return
(match-define (vector (ivl x-min x-max) (ivl y-min y-max)) (send area get-bounds-rect))
(define sample (g x-min x-max (animated-samples samples)
y-min y-max (animated-samples samples)))
(match-define (vector x-ivl y-ivl) (send area get-bounds-rect))
(match-define (ivl x-min x-max) x-ivl)
(match-define (ivl y-min y-max) y-ivl)
(define num (animated-samples samples))
(define sample (g (vector x-ivl y-ivl) (vector num num)))
(match-define (2d-sample xs ys zss z-min z-max) sample)
(match-define (list (tick zs _ labels) ...) (contour-ticks (plot-z-ticks) z-min z-max levels #f))
@ -95,8 +101,10 @@
[#:alphas alphas (alphas/c (listof real?)) (contour-alphas)]
[#:label label (or/c string? #f) #f]
) renderer2d?
(define g (2d-function->sampler f))
(renderer2d (vector (ivl x-min x-max) (ivl y-min y-max)) #f default-ticks-fun
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(define g (2d-function->sampler f (vector x-ivl y-ivl)))
(renderer2d (vector x-ivl y-ivl) #f default-ticks-fun
(contours-render-proc g levels samples colors widths styles alphas label)))
;; ===================================================================================================
@ -106,9 +114,11 @@
g levels samples colors styles contour-colors contour-widths contour-styles alphas label)
area)
(let/ec return
(match-define (vector (ivl x-min x-max) (ivl y-min y-max)) (send area get-bounds-rect))
(define sample (g x-min x-max (animated-samples samples)
y-min y-max (animated-samples samples)))
(match-define (vector x-ivl y-ivl) (send area get-bounds-rect))
(match-define (ivl x-min x-max) x-ivl)
(match-define (ivl y-min y-max) y-ivl)
(define num (animated-samples samples))
(define sample (g (vector x-ivl y-ivl) (vector num num)))
(match-define (2d-sample xs ys zss z-min z-max) sample)
(match-define (list (tick zs _ labels) ...) (contour-ticks (plot-z-ticks) z-min z-max levels #t))
@ -171,8 +181,10 @@
[#:alphas alphas (alphas/c (listof ivl?)) (contour-interval-alphas)]
[#:label label (or/c string? #f) #f]
) renderer2d?
(define g (2d-function->sampler f))
(renderer2d (vector (ivl x-min x-max) (ivl y-min y-max)) #f default-ticks-fun
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(define g (2d-function->sampler f (vector x-ivl y-ivl)))
(renderer2d (vector x-ivl y-ivl) #f default-ticks-fun
(contour-intervals-render-proc g levels samples colors styles
contour-colors contour-widths contour-styles
alphas label)))

28
collects/plot/plot2d/interval.rkt
View File

@ -125,9 +125,9 @@
line2-color line2-width line2-style
alpha label)
area)
(match-define (vector (ivl x-min x-max) y-ivl) (send area get-bounds-rect))
(match-define (sample x1s y1s y1-min y1-max) (f1 x-min x-max samples))
(match-define (sample x2s y2s y2-min y2-max) (f2 x-min x-max samples))
(match-define (vector x-ivl y-ivl) (send area get-bounds-rect))
(match-define (sample x1s y1s _ _) (f1 x-ivl samples))
(match-define (sample x2s y2s _ _) (f2 x-ivl samples))
(define v1s (map vector x1s y1s))
(define v2s (map vector x2s y2s))
@ -153,9 +153,11 @@
[#:alpha alpha (real-in 0 1) (interval-alpha)]
[#:label label (or/c string? #f) #f]
) renderer2d?
(define g1 (function->sampler f1))
(define g2 (function->sampler f2))
(renderer2d (vector (ivl x-min x-max) (ivl y-min y-max))
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(define g1 (function->sampler f1 x-ivl))
(define g2 (function->sampler f2 x-ivl))
(renderer2d (vector x-ivl y-ivl)
(function-interval-bounds-fun g1 g2 samples)
default-ticks-fun
(function-interval-render-proc g1 g2 samples color style
@ -171,9 +173,9 @@
line2-color line2-width line2-style
alpha label)
area)
(match-define (vector x-ivl (ivl y-min y-max)) (send area get-bounds-rect))
(match-define (sample y1s x1s x1-min x1-max) (f1 y-min y-max samples))
(match-define (sample y2s x2s x2-min x2-max) (f2 y-min y-max samples))
(match-define (vector x-ivl y-ivl) (send area get-bounds-rect))
(match-define (sample y1s x1s _ _) (f1 y-ivl samples))
(match-define (sample y2s x2s _ _) (f2 y-ivl samples))
(define v1s (map vector x1s y1s))
(define v2s (map vector x2s y2s))
@ -199,9 +201,11 @@
[#:alpha alpha (real-in 0 1) (interval-alpha)]
[#:label label (or/c string? #f) #f]
) renderer2d?
(define g1 (inverse->sampler f1))
(define g2 (inverse->sampler f2))
(renderer2d (vector (ivl x-min x-max) (ivl y-min y-max))
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(define g1 (inverse->sampler f1 y-ivl))
(define g2 (inverse->sampler f2 y-ivl))
(renderer2d (vector x-ivl y-ivl)
(inverse-interval-bounds-fun g1 g2 samples)
default-ticks-fun
(inverse-interval-render-proc g1 g2 samples color style

26
collects/plot/plot2d/line.rkt
View File

@ -76,8 +76,8 @@
;; Function
(define ((function-render-proc f samples color width style alpha label) area)
(match-define (vector (ivl x-min x-max) y-ivl) (send area get-bounds-rect))
(match-define (sample xs ys y-min y-max) (f x-min x-max samples))
(match-define (vector x-ivl y-ivl) (send area get-bounds-rect))
(match-define (sample xs ys y-min y-max) (f x-ivl samples))
(send area put-alpha alpha)
(send area put-pen color width style)
@ -96,18 +96,20 @@
[#:alpha alpha (real-in 0 1) (line-alpha)]
[#:label label (or/c string? #f) #f]
) renderer2d?
(define g (function->sampler f))
(renderer2d (vector (ivl x-min x-max) (ivl y-min y-max))
(function-bounds-fun g samples)
default-ticks-fun
(function-render-proc g samples color width style alpha label)))
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(let ([f (function->sampler f x-ivl)])
(renderer2d (vector x-ivl y-ivl)
(function-bounds-fun f samples)
default-ticks-fun
(function-render-proc f samples color width style alpha label))))
;; ===================================================================================================
;; Inverse function
(define ((inverse-render-proc f samples color width style alpha label) area)
(match-define (vector x-ivl (ivl y-min y-max)) (send area get-bounds-rect))
(match-define (sample ys xs x-min x-max) (f y-min y-max samples))
(match-define (vector x-ivl y-ivl) (send area get-bounds-rect))
(match-define (sample ys xs x-min x-max) (f y-ivl samples))
(send area put-alpha alpha)
(send area put-pen color width style)
@ -126,8 +128,10 @@
[#:alpha alpha (real-in 0 1) (line-alpha)]
[#:label label (or/c string? #f) #f]
) renderer2d?
(define g (inverse->sampler f))
(renderer2d (vector (ivl x-min x-max) (ivl y-min y-max))
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(define g (inverse->sampler f y-ivl))
(renderer2d (vector x-ivl y-ivl)
(inverse-bounds-fun g samples)
default-ticks-fun
(inverse-render-proc g samples color width style alpha label)))

51
collects/plot/plot3d/contour.rkt
View File

@ -11,10 +11,12 @@
;; One contour line in 3D (using marching squares)
(define ((isoline3d-render-proc f z samples color width style alpha label) area)
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
(send area get-bounds-rect))
(define sample (f x-min x-max (animated-samples samples)
y-min y-max (animated-samples samples)))
(match-define (vector x-ivl y-ivl z-ivl) (send area get-bounds-rect))
(match-define (ivl x-min x-max) x-ivl)
(match-define (ivl y-min y-max) y-ivl)
(match-define (ivl z-min z-max) z-ivl)
(define num (animated-samples samples))
(define sample (f (vector x-ivl y-ivl) (vector num num)))
(when (<= z-min z z-max)
(send area put-alpha alpha)
@ -45,10 +47,13 @@
[#:alpha alpha (real-in 0 1) (line-alpha)]
[#:label label (or/c string? #f) #f]
) renderer3d?
(define g (2d-function->sampler f))
(let ([z-min (if z-min z-min z)]
[z-max (if z-max z-max z)])
(renderer3d (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(define z-ivl (ivl z-min z-max))
(define g (2d-function->sampler f (vector x-ivl y-ivl)))
(renderer3d (vector x-ivl y-ivl z-ivl)
#f default-ticks-fun
(isoline3d-render-proc g z samples color width style alpha label))))
@ -56,10 +61,12 @@
;; Contour lines in 3D (using marching squares)
(define ((contours3d-render-proc f levels samples colors widths styles alphas label) area)
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
(send area get-bounds-rect))
(define sample (f x-min x-max (animated-samples samples)
y-min y-max (animated-samples samples)))
(match-define (vector x-ivl y-ivl z-ivl) (send area get-bounds-rect))
(match-define (ivl x-min x-max) x-ivl)
(match-define (ivl y-min y-max) y-ivl)
(match-define (ivl z-min z-max) z-ivl)
(define num (animated-samples samples))
(define sample (f (vector x-ivl y-ivl) (vector num num)))
;; can't use the actual z ticks because some or all could be collapsed
(match-define (list (tick zs _ labels) ...) (contour-ticks (plot-z-ticks) z-min z-max levels #f))
@ -101,8 +108,11 @@
[#:alphas alphas (alphas/c (listof real?)) (contour-alphas)]
[#:label label (or/c string? #f) #f]
) renderer3d?
(define g (2d-function->sampler f))
(renderer3d (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(define z-ivl (ivl z-min z-max))
(define g (2d-function->sampler f (vector x-ivl y-ivl)))
(renderer3d (vector x-ivl y-ivl z-ivl)
(surface3d-bounds-fun g samples)
default-ticks-fun
(contours3d-render-proc g levels samples colors widths styles alphas label)))
@ -114,10 +124,12 @@
f levels samples colors styles line-colors line-widths line-styles
contour-colors contour-widths contour-styles alphas label)
area)
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
(send area get-bounds-rect))
(define sample (f x-min x-max (animated-samples samples)
y-min y-max (animated-samples samples)))
(match-define (vector x-ivl y-ivl z-ivl) (send area get-bounds-rect))
(match-define (ivl x-min x-max) x-ivl)
(match-define (ivl y-min y-max) y-ivl)
(match-define (ivl z-min z-max) z-ivl)
(define num (animated-samples samples))
(define sample (f (vector x-ivl y-ivl) (vector num num)))
;; can't use the actual z ticks because some or all could be collapsed
(match-define (list (tick zs _ labels) ...) (contour-ticks (plot-z-ticks) z-min z-max levels #t))
@ -193,8 +205,11 @@
[#:alphas alphas (alphas/c (listof ivl?)) (contour-interval-alphas)]
[#:label label (or/c string? #f) #f]
) renderer3d?
(define g (2d-function->sampler f))
(renderer3d (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(define z-ivl (ivl z-min z-max))
(define g (2d-function->sampler f (vector x-ivl y-ivl)))
(renderer3d (vector x-ivl y-ivl z-ivl)
(surface3d-bounds-fun g samples)
default-ticks-fun
(contour-intervals3d-render-proc g levels samples colors styles

55
collects/plot/plot3d/isosurface.rkt
View File

@ -13,11 +13,12 @@
(define ((isosurface3d-render-proc
f d samples color style line-color line-width line-style alpha label)
area)
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
(send area get-bounds-rect))
(define sample (f x-min x-max (animated-samples samples)
y-min y-max (animated-samples samples)
z-min z-max (animated-samples samples)))
(match-define (vector x-ivl y-ivl z-ivl) (send area get-bounds-rect))
(match-define (ivl x-min x-max) x-ivl)
(match-define (ivl y-min y-max) y-ivl)
(match-define (ivl z-min z-max) z-ivl)
(define num (animated-samples samples))
(define sample (f (vector x-ivl y-ivl z-ivl) (vector num num num)))
(match-define (3d-sample xs ys zs dsss d-min d-max) sample)
(send area put-alpha alpha)
@ -50,8 +51,11 @@
[#:alpha alpha (real-in 0 1) (surface-alpha)]
[#:label label (or/c string? #f) #f]
) renderer3d?
(define g (3d-function->sampler f))
(renderer3d (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max)) #f default-ticks-fun
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(define z-ivl (ivl z-min z-max))
(define g (3d-function->sampler f (vector x-ivl y-ivl z-ivl)))
(renderer3d (vector x-ivl y-ivl z-ivl) #f default-ticks-fun
(isosurface3d-render-proc
g d samples color style line-color line-width line-style alpha label)))
@ -61,11 +65,12 @@
(define ((isosurfaces3d-render-proc f rd-min rd-max levels samples colors styles
line-colors line-widths line-styles alphas label)
area)
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
(send area get-bounds-rect))
(define sample (f x-min x-max (animated-samples samples)
y-min y-max (animated-samples samples)
z-min z-max (animated-samples samples)))
(match-define (vector x-ivl y-ivl z-ivl) (send area get-bounds-rect))
(match-define (ivl x-min x-max) x-ivl)
(match-define (ivl y-min y-max) y-ivl)
(match-define (ivl z-min z-max) z-ivl)
(define num (animated-samples samples))
(define sample (f (vector x-ivl y-ivl z-ivl) (vector num num num)))
(match-define (3d-sample xs ys zs dsss fd-min fd-max) sample)
(define d-min (if rd-min rd-min fd-min))
@ -103,7 +108,6 @@
(send area put-polygons polys
(vector (* 1/2 (+ xa xb)) (* 1/2 (+ ya yb)) (* 1/2 (+ za zb)))))))))
(cond
[(and label (not (empty? ds))) (rectangle-legend-entries
label ds colors styles line-colors line-widths line-styles)]
@ -125,8 +129,11 @@
[#:alphas alphas (alphas/c (listof real?)) (isosurface-alphas)]
[#:label label (or/c string? #f) #f]
) renderer3d?
(define g (3d-function->sampler f))
(renderer3d (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max)) #f default-ticks-fun
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(define z-ivl (ivl z-min z-max))
(define g (3d-function->sampler f (vector x-ivl y-ivl z-ivl)))
(renderer3d (vector x-ivl y-ivl z-ivl) #f default-ticks-fun
(isosurfaces3d-render-proc g d-min d-max levels samples colors styles
line-colors line-widths line-styles alphas
label)))
@ -135,11 +142,12 @@
(define ((polar3d-render-proc f g samples color style line-color line-width line-style alpha label)
area)
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
(send area get-bounds-rect))
(define sample (g x-min x-max (animated-samples samples)
y-min y-max (animated-samples samples)
z-min z-max (animated-samples samples)))
(match-define (vector x-ivl y-ivl z-ivl) (send area get-bounds-rect))
(match-define (ivl x-min x-max) x-ivl)
(match-define (ivl y-min y-max) y-ivl)
(match-define (ivl z-min z-max) z-ivl)
(define num (animated-samples samples))
(define sample (g (vector x-ivl y-ivl z-ivl) (vector num num num)))
(match-define (3d-sample xs ys zs dsss d-min d-max) sample)
(define (draw-cube xa xb ya yb za zb d d1 d2 d3 d4 d5 d6 d7 d8)
@ -218,9 +226,12 @@
[y-max (if y-max y-max (apply max* rys))]
[z-min (if z-min z-min (apply min* rzs))]
[z-max (if z-max z-max (apply max* rzs))])
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(define z-ivl (ivl z-min z-max))
(define new-f (2d-polar->3d-function f))
(define g (3d-function->sampler new-f))
(renderer3d (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max)) #f
(define g (3d-function->sampler new-f (vector x-ivl y-ivl z-ivl)))
(renderer3d (vector x-ivl y-ivl z-ivl) #f
default-ticks-fun
(polar3d-render-proc new-f g samples color style
line-color line-width line-style alpha label)))]))

18
collects/plot/plot3d/surface.rkt
View File

@ -11,11 +11,14 @@
(define ((surface3d-render-proc f samples color style line-color line-width line-style alpha label)
area)
(match-define (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
(send area get-bounds-rect))
(define sample (f x-min x-max (animated-samples samples)
y-min y-max (animated-samples samples)))
(match-define (vector x-ivl y-ivl z-ivl) (send area get-bounds-rect))
(define num (animated-samples samples))
(define sample (f (vector x-ivl y-ivl) (vector num num)))
(match-define (ivl x-min x-max) x-ivl)
(match-define (ivl y-min y-max) y-ivl)
(match-define (ivl z-min z-max) z-ivl)
(send area put-alpha alpha)
(send area put-brush color style)
(send area put-pen line-color line-width line-style)
@ -43,8 +46,11 @@
[#:alpha alpha (real-in 0 1) (surface-alpha)]
[#:label label (or/c string? #f) #f]
) renderer3d?
(define g (2d-function->sampler f))
(renderer3d (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))
(define x-ivl (ivl x-min x-max))
(define y-ivl (ivl y-min y-max))
(define z-ivl (ivl z-min z-max))
(define g (2d-function->sampler f (vector x-ivl y-ivl)))
(renderer3d (vector x-ivl y-ivl z-ivl)
(surface3d-bounds-fun g samples)
default-ticks-fun
(surface3d-render-proc g samples color style

3
collects/plot/scribblings/utils.scrbl
View File

@ -461,6 +461,9 @@ Use this to construct inputs for @(racket rectangles) and @(racket rectangles3d)
@examples[#:eval plot-eval (bounds->intervals (linear-seq 0 1 5))]
}
@doc-apply[clamp-real]{
}
@;----------------------------------------------------------------------------------------------------
@;{
@subsection[#:tag "math.rectangles"]{Rectangles and Rectangle Functions}

0
collects/plot/tests/low-level-tests.rkt Executable file → Normal file
View File