200 lines
8.8 KiB
Racket
200 lines
8.8 KiB
Racket
#lang racket/base
|
|
|
|
;; A compatibility module for the old 'plot'.
|
|
|
|
(require racket/contract racket/class racket/snip racket/draw racket/vector
|
|
unstable/latent-contract unstable/latent-contract/defthing
|
|
;; Plotting
|
|
"common/math.rkt"
|
|
"common/contract.rkt"
|
|
"common/plot-element.rkt"
|
|
"plot2d/plot-area.rkt"
|
|
"plot3d/plot-area.rkt"
|
|
(prefix-in new. (only-in "main.rkt"
|
|
x-axis y-axis
|
|
plot-x-ticks plot-y-ticks plot-z-ticks
|
|
points error-bars vector-field
|
|
plot-title plot-x-label plot-y-label plot-z-label
|
|
plot-foreground plot-background
|
|
plot3d-angle plot3d-altitude))
|
|
"deprecated/renderers.rkt"
|
|
;; Miscellaneous
|
|
"deprecated/math.rkt")
|
|
|
|
(provide mix
|
|
(activate-contract-out plot-color?
|
|
plot plot3d
|
|
points vector-field error-bars
|
|
line
|
|
contour shade
|
|
surface)
|
|
(only-doc-out (all-defined-out))
|
|
;; Miscellaneous
|
|
make-vec derivative gradient)
|
|
|
|
(define (mix . data)
|
|
(for/fold ([f (λ (area) (void))]) ([d (in-list data)])
|
|
(λ (area)
|
|
(f area)
|
|
(d area)
|
|
(void))))
|
|
|
|
(defproc (plot-color? [v any/c]) boolean?
|
|
(and (member v '(white black yellow green aqua pink wheat gray brown blue violet cyan
|
|
turquoise magenta salmon red))
|
|
#t))
|
|
|
|
(define ((renderer2d->plot-data r) area)
|
|
((renderer2d-render-proc r) area)
|
|
(void))
|
|
|
|
(define ((renderer3d->plot-data r) area)
|
|
((renderer3d-render-proc r) area)
|
|
(void))
|
|
|
|
;; ===================================================================================================
|
|
;; Plotting
|
|
|
|
(define x-axis-data (renderer2d->plot-data (new.x-axis)))
|
|
(define y-axis-data (renderer2d->plot-data (new.y-axis)))
|
|
|
|
(defproc (plot [data ((is-a?/c 2d-plot-area%) . -> . void?)]
|
|
[#:width width real? 400] [#:height height real? 400]
|
|
[#:x-min x-min real? -5] [#:x-max x-max real? 5]
|
|
[#:y-min y-min real? -5] [#:y-max y-max real? 5]
|
|
[#:x-label x-label string? "X axis"] [#:y-label y-label string? "Y axis"]
|
|
[#:title title string? ""]
|
|
[#:fgcolor fgcolor (list/c byte? byte? byte?) '(0 0 0)]
|
|
[#:bgcolor bgcolor (list/c byte? byte? byte?) '(255 255 255)]
|
|
[#:lncolor lncolor (list/c byte? byte? byte?) '(255 0 0)]
|
|
[#:out-file out-file (or/c path-string? output-port? #f) #f]
|
|
) (is-a?/c image-snip%)
|
|
(define x-ticks ((new.plot-x-ticks) x-min x-max))
|
|
(define y-ticks ((new.plot-y-ticks) y-min y-max))
|
|
(define bounds-rect (vector (ivl x-min x-max) (ivl y-min y-max)))
|
|
|
|
(parameterize ([new.plot-title title]
|
|
[new.plot-x-label x-label]
|
|
[new.plot-y-label y-label]
|
|
[new.plot-foreground fgcolor]
|
|
[new.plot-background bgcolor])
|
|
(define bm (make-bitmap (ceiling width) (ceiling height)))
|
|
(define dc (make-object bitmap-dc% bm))
|
|
(define area (make-object 2d-plot-area%
|
|
bounds-rect x-ticks x-ticks y-ticks y-ticks dc 0 0 width height))
|
|
|
|
(define data+axes (mix x-axis-data y-axis-data data))
|
|
|
|
(send area start-plot)
|
|
(send area start-renderer bounds-rect)
|
|
(data+axes area)
|
|
(send area end-renderers)
|
|
(send area end-plot)
|
|
|
|
(when out-file (send bm save-file out-file 'png))
|
|
|
|
(make-object image-snip% bm)))
|
|
|
|
(defproc (plot3d [data ((is-a?/c 3d-plot-area%) . -> . void?)]
|
|
[#:width width real? 400] [#:height height real? 400]
|
|
[#:x-min x-min real? -5] [#:x-max x-max real? 5]
|
|
[#:y-min y-min real? -5] [#:y-max y-max real? 5]
|
|
[#:z-min z-min real? -5] [#:z-max z-max real? 5]
|
|
[#:alt alt real? 30]
|
|
[#:az az real? 45]
|
|
[#:x-label x-label string? "X axis"]
|
|
[#:y-label y-label string? "Y axis"]
|
|
[#:z-label z-label string? "Z axis"]
|
|
[#:title title string? ""]
|
|
[#:fgcolor fgcolor (list/c byte? byte? byte?) '(0 0 0)]
|
|
[#:bgcolor bgcolor (list/c byte? byte? byte?) '(255 255 255)]
|
|
[#:lncolor lncolor (list/c byte? byte? byte?) '(255 0 0)]
|
|
[#:out-file out-file (or/c path-string? output-port? #f) #f]
|
|
) (is-a?/c image-snip%)
|
|
(define x-ticks ((new.plot-x-ticks) x-min x-max))
|
|
(define y-ticks ((new.plot-y-ticks) y-min y-max))
|
|
(define z-ticks ((new.plot-z-ticks) z-min z-max))
|
|
(define bounds-rect (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max)))
|
|
|
|
(parameterize ([new.plot-title title]
|
|
[new.plot-x-label x-label]
|
|
[new.plot-y-label y-label]
|
|
[new.plot-z-label z-label]
|
|
[new.plot-foreground fgcolor]
|
|
[new.plot-background bgcolor]
|
|
[new.plot3d-angle az]
|
|
[new.plot3d-altitude alt])
|
|
(define bm (make-bitmap (ceiling width) (ceiling height)))
|
|
(define dc (make-object bitmap-dc% bm))
|
|
(define area (make-object 3d-plot-area%
|
|
bounds-rect x-ticks x-ticks y-ticks y-ticks z-ticks z-ticks dc 0 0 width height))
|
|
|
|
(send area start-plot)
|
|
(send area start-renderer bounds-rect)
|
|
(data area)
|
|
(send area end-renderers)
|
|
(send area end-plot)
|
|
|
|
(when out-file (send bm save-file out-file 'png))
|
|
|
|
(make-object image-snip% bm)))
|
|
|
|
;; ===================================================================================================
|
|
;; Functions that generate "plot data"
|
|
|
|
(defproc (points [vecs (listof (vectorof real?))]
|
|
[#:sym sym (or/c char? string? exact-integer? symbol?) 'square]
|
|
[#:color color plot-color? 'black]
|
|
) ((is-a?/c 2d-plot-area%) . -> . void?)
|
|
(renderer2d->plot-data (new.points (map (λ (v) (vector-take v 2)) vecs)
|
|
#:sym sym #:size 6 #:color color)))
|
|
|
|
(defproc (vector-field [f ((vector/c real? real?) . -> . (vector/c real? real?))]
|
|
[#:samples samples (and/c exact-integer? (>=/c 2)) 20]
|
|
[#:width width exact-positive-integer? 1]
|
|
[#:color color plot-color? 'red]
|
|
[#:style style (one-of/c 'scaled 'normalized 'real) 'scaled]
|
|
) ((is-a?/c 2d-plot-area%) . -> . void?)
|
|
(define scale (case style
|
|
[(scaled) 'auto]
|
|
[(normalized) 'normalized]
|
|
[(real) 1.0]))
|
|
(renderer2d->plot-data
|
|
(new.vector-field f #:samples samples #:line-width width #:color color #:scale scale)))
|
|
|
|
(defproc (error-bars [vecs (listof (vector/c real? real? real?))]
|
|
[#:color color plot-color? 'black]
|
|
) ((is-a?/c 2d-plot-area%) . -> . void?)
|
|
(renderer2d->plot-data (new.error-bars vecs #:color color #:alpha 1 #:width 4)))
|
|
|
|
(defproc (line [f (real? . -> . (or/c real? (vector/c real? real?)))]
|
|
[#:samples samples (and/c exact-integer? (>=/c 2)) 150]
|
|
[#:width width (>=/c 0) 1]
|
|
[#:color color plot-color/c 'red]
|
|
[#:mode mode (one-of/c 'standard 'parametric) 'standard]
|
|
[#:mapping mapping (one-of/c 'cartesian 'polar) 'cartesian]
|
|
[#:t-min t-min real? -5] [#:t-max t-max real? 5]
|
|
) ((is-a?/c 2d-plot-area%) . -> . void?)
|
|
(renderer2d->plot-data (line-renderer f samples width color mode mapping t-min t-max)))
|
|
|
|
(defproc (contour [f (real? real? . -> . real?)]
|
|
[#:samples samples exact-nonnegative-integer? 50]
|
|
[#:width width (>=/c 0) 1]
|
|
[#:color color plot-color/c 'black]
|
|
[#:levels levels (or/c (and/c exact-integer? (>=/c 2)) (listof real?)) 10]
|
|
) ((is-a?/c 2d-plot-area%) . -> . void?)
|
|
(renderer2d->plot-data (contour-renderer f samples width color levels)))
|
|
|
|
(defproc (shade [f (real? real? . -> . real?)]
|
|
[#:samples samples (and/c exact-integer? (>=/c 2)) 50]
|
|
[#:levels levels (or/c (and/c exact-integer? (>=/c 2)) (listof real?)) 10]
|
|
) ((is-a?/c 2d-plot-area%) . -> . void?)
|
|
(renderer2d->plot-data (shade-renderer f samples levels)))
|
|
|
|
(defproc (surface [f (real? real? . -> . real?)]
|
|
[#:samples samples (and/c exact-integer? (>=/c 2)) 50]
|
|
[#:width width (>=/c 0) 1]
|
|
[#:color color plot-color/c 'black]
|
|
) ((is-a?/c 3d-plot-area%) . -> . void?)
|
|
(renderer3d->plot-data (surface-renderer f samples width color)))
|