From 365ee2c70d133a35297eb606eb4ed35f85cdc81d Mon Sep 17 00:00:00 2001 From: Neil Toronto Date: Fri, 25 May 2012 10:36:48 +0900 Subject: [PATCH] 1d, 2d and 3d function renderers no longer sample outside the function's bounds 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. --- collects/plot/common/math.rkt | 4 + collects/plot/common/plot-element.rkt | 38 ++++---- collects/plot/common/sample.rkt | 124 +++++++++++++++++------- collects/plot/common/samplers.rkt | 15 ++- collects/plot/contracted/math.rkt | 2 +- collects/plot/plot2d/contour.rkt | 42 +++++--- collects/plot/plot2d/interval.rkt | 28 +++--- collects/plot/plot2d/line.rkt | 26 ++--- collects/plot/plot3d/contour.rkt | 51 ++++++---- collects/plot/plot3d/isosurface.rkt | 55 ++++++----- collects/plot/plot3d/surface.rkt | 18 ++-- collects/plot/scribblings/utils.scrbl | 3 + collects/plot/tests/low-level-tests.rkt | 0 13 files changed, 260 insertions(+), 146 deletions(-) mode change 100755 => 100644 collects/plot/tests/low-level-tests.rkt diff --git a/collects/plot/common/math.rkt b/collects/plot/common/math.rkt index 311daea418..c9eaf7083e 100644 --- a/collects/plot/common/math.rkt +++ b/collects/plot/common/math.rkt @@ -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 diff --git a/collects/plot/common/plot-element.rkt b/collects/plot/common/plot-element.rkt index 2b7035bedb..c5d491a3ab 100644 --- a/collects/plot/common/plot-element.rkt +++ b/collects/plot/common/plot-element.rkt @@ -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)) diff --git a/collects/plot/common/sample.rkt b/collects/plot/common/sample.rkt index 32c2449464..9f311bd37e 100644 --- a/collects/plot/common/sample.rkt +++ b/collects/plot/common/sample.rkt @@ -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)) diff --git a/collects/plot/common/samplers.rkt b/collects/plot/common/samplers.rkt index e27a66105a..91e58d59e4 100644 --- a/collects/plot/common/samplers.rkt +++ b/collects/plot/common/samplers.rkt @@ -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)) diff --git a/collects/plot/contracted/math.rkt b/collects/plot/contracted/math.rkt index 61ff02d7fb..5a234e2173 100644 --- a/collects/plot/contracted/math.rkt +++ b/collects/plot/contracted/math.rkt @@ -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?))] diff --git a/collects/plot/plot2d/contour.rkt b/collects/plot/plot2d/contour.rkt index a64ebdf2ca..09c072a1f6 100644 --- a/collects/plot/plot2d/contour.rkt +++ b/collects/plot/plot2d/contour.rkt @@ -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))) diff --git a/collects/plot/plot2d/interval.rkt b/collects/plot/plot2d/interval.rkt index b031871b7a..edc89e8fe9 100644 --- a/collects/plot/plot2d/interval.rkt +++ b/collects/plot/plot2d/interval.rkt @@ -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 diff --git a/collects/plot/plot2d/line.rkt b/collects/plot/plot2d/line.rkt index 980ebde674..22732d5e4e 100644 --- a/collects/plot/plot2d/line.rkt +++ b/collects/plot/plot2d/line.rkt @@ -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))) diff --git a/collects/plot/plot3d/contour.rkt b/collects/plot/plot3d/contour.rkt index aed91db4a9..2bc72588ad 100644 --- a/collects/plot/plot3d/contour.rkt +++ b/collects/plot/plot3d/contour.rkt @@ -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 diff --git a/collects/plot/plot3d/isosurface.rkt b/collects/plot/plot3d/isosurface.rkt index c0a016a79c..3c2e153aa3 100644 --- a/collects/plot/plot3d/isosurface.rkt +++ b/collects/plot/plot3d/isosurface.rkt @@ -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)))])) diff --git a/collects/plot/plot3d/surface.rkt b/collects/plot/plot3d/surface.rkt index 1566e7f29d..355bb4fb1c 100644 --- a/collects/plot/plot3d/surface.rkt +++ b/collects/plot/plot3d/surface.rkt @@ -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 diff --git a/collects/plot/scribblings/utils.scrbl b/collects/plot/scribblings/utils.scrbl index c9bd25e349..866c6d7db6 100644 --- a/collects/plot/scribblings/utils.scrbl +++ b/collects/plot/scribblings/utils.scrbl @@ -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} diff --git a/collects/plot/tests/low-level-tests.rkt b/collects/plot/tests/low-level-tests.rkt old mode 100755 new mode 100644