1#lang racket/base 2 3;; A compatibility module for the old 'plot'. 4 5(require racket/contract racket/class racket/snip racket/draw racket/vector 6 ;; Plotting 7 plot/private/common/math 8 plot/private/common/contract 9 plot/private/common/ticks 10 plot/private/plot2d/plot-area 11 plot/private/plot2d/renderer 12 plot/private/plot3d/plot-area 13 plot/private/plot3d/renderer 14 (prefix-in new. (only-in plot 15 x-axis y-axis 16 plot-x-ticks plot-y-ticks plot-z-ticks 17 points error-bars vector-field 18 plot-title plot-x-label plot-y-label plot-z-label 19 plot-foreground plot-background 20 plot3d-angle plot3d-altitude)) 21 plot/private/deprecated/renderers 22 ;; Miscellaneous 23 plot/private/deprecated/math) 24 25(provide 26 mix 27 (contract-out 28 [plot-color? (-> any/c boolean?)] 29 [plot 30 (->* [((is-a?/c 2d-plot-area%) . -> . void?)] 31 [#:width real? 32 #:height real? 33 #:x-min real? 34 #:x-max real? 35 #:y-min real? 36 #:y-max real? 37 #:x-label string? 38 #:y-label string? 39 #:title string? 40 #:fgcolor (list/c byte? byte? byte?) 41 #:bgcolor (list/c byte? byte? byte?) 42 #:lncolor (list/c byte? byte? byte?) 43 #:out-file (or/c path-string? output-port? #f)] 44 (is-a?/c image-snip%))] 45 [plot3d 46 (->* [((is-a?/c 3d-plot-area%) . -> . void?)] 47 [#:width real? 48 #:height real? 49 #:x-min real? 50 #:x-max real? 51 #:y-min real? 52 #:y-max real? 53 #:z-min real? 54 #:z-max real? 55 #:alt real? 56 #:az real? 57 #:x-label string? 58 #:y-label string? 59 #:z-label string? 60 #:title string? 61 #:fgcolor (list/c byte? byte? byte?) 62 #:bgcolor (list/c byte? byte? byte?) 63 #:lncolor (list/c byte? byte? byte?) 64 #:out-file (or/c path-string? output-port? #f)] 65 (is-a?/c image-snip%))] 66 [points 67 (->* [(listof (vectorof real?))] 68 [#:sym (or/c char? string? exact-integer? symbol?) 69 #:color plot-color?] 70 ((is-a?/c 2d-plot-area%) . -> . void?))] 71 [vector-field 72 (->* [((vector/c real? real?) . -> . (vector/c real? real?))] 73 [#:samples (and/c exact-integer? (>=/c 2)) 74 #:width exact-positive-integer? 75 #:color plot-color? 76 #:style (one-of/c 'scaled 'normalized 'real)] 77 ((is-a?/c 2d-plot-area%) . -> . void?))] 78 [error-bars 79 (->* [(listof (vector/c real? real? real?))] 80 [#:color plot-color?] 81 ((is-a?/c 2d-plot-area%) . -> . void?))] 82 [line 83 (->* [(real? . -> . (or/c real? (vector/c real? real?)))] 84 [#:samples (and/c exact-integer? (>=/c 2)) 85 #:width (>=/c 0) 86 #:color plot-color/c 87 #:mode (one-of/c 'standard 'parametric) 88 #:mapping (one-of/c 'cartesian 'polar) 89 #:t-min real? 90 #:t-max real?] 91 ((is-a?/c 2d-plot-area%) . -> . void?))] 92 [contour 93 (->* [(real? real? . -> . real?)] 94 [#:samples exact-nonnegative-integer? 95 #:width (>=/c 0) 96 #:color plot-color/c 97 #:levels (or/c (and/c exact-integer? (>=/c 2)) (listof real?))] 98 ((is-a?/c 2d-plot-area%) . -> . void?))] 99 [shade 100 (->* [(real? real? . -> . real?)] 101 [#:samples (and/c exact-integer? (>=/c 2)) 102 #:levels (or/c (and/c exact-integer? (>=/c 2)) (listof real?))] 103 ((is-a?/c 2d-plot-area%) . -> . void?))] 104 [surface 105 (->* [(real? real? . -> . real?)] 106 [#:samples (and/c exact-integer? (>=/c 2)) 107 #:width (>=/c 0) 108 #:color plot-color/c] 109 ((is-a?/c 3d-plot-area%) . -> . void?))] 110 ) 111 ;; Miscellaneous 112 make-vec 113 derivative 114 gradient) 115 116(define (mix . data) 117 (for/fold ([f (λ (area) (void))]) ([d (in-list data)]) 118 (λ (area) 119 (f area) 120 (d area) 121 (void)))) 122 123(define (plot-color? v) 124 (and (member v '(white black yellow green aqua pink wheat gray brown blue violet cyan 125 turquoise magenta salmon red)) 126 #t)) 127 128(define ((renderer2d->plot-data r) area) 129 ((renderer2d-render-proc r) area) 130 (void)) 131 132(define ((renderer3d->plot-data r) area) 133 ((renderer3d-render-proc r) area) 134 (void)) 135 136;; =================================================================================================== 137;; Plotting 138 139(define x-axis-data (renderer2d->plot-data (new.x-axis))) 140(define y-axis-data (renderer2d->plot-data (new.y-axis))) 141 142(define (plot data 143 #:width [width 400] 144 #:height [height 400] 145 #:x-min [x-min -5] 146 #:x-max [x-max 5] 147 #:y-min [y-min -5] 148 #:y-max [y-max 5] 149 #:x-label [x-label "X axis"] 150 #:y-label [y-label "Y axis"] 151 #:title [title ""] 152 #:fgcolor [fgcolor '(0 0 0)] 153 #:bgcolor [bgcolor '(255 255 255)] 154 #:lncolor [lncolor '(255 0 0)] 155 #:out-file [out-file #f]) 156 (define x-ticks (ticks-generate (new.plot-x-ticks) x-min x-max)) 157 (define y-ticks (ticks-generate (new.plot-y-ticks) y-min y-max)) 158 (define bounds-rect (vector (ivl x-min x-max) (ivl y-min y-max))) 159 160 (parameterize ([new.plot-title title] 161 [new.plot-x-label x-label] 162 [new.plot-y-label y-label] 163 [new.plot-foreground fgcolor] 164 [new.plot-background bgcolor]) 165 (define bm (make-bitmap (ceiling width) (ceiling height))) 166 (define dc (make-object bitmap-dc% bm)) 167 (define area (make-object 2d-plot-area% 168 bounds-rect x-ticks x-ticks y-ticks y-ticks '() dc 0 0 width height #f)) 169 170 (define data+axes (mix x-axis-data y-axis-data data)) 171 172 (send area start-plot) 173 (send area start-renderer bounds-rect) 174 (data+axes area) 175 (send area end-renderers) 176 (send area end-plot) 177 178 (when out-file (send bm save-file out-file 'png)) 179 180 (make-object image-snip% bm))) 181 182(define (plot3d data 183 #:width [width 400] 184 #:height [height 400] 185 #:x-min [x-min -5] 186 #:x-max [x-max 5] 187 #:y-min [y-min -5] 188 #:y-max [y-max 5] 189 #:z-min [z-min -5] 190 #:z-max [z-max 5] 191 #:alt [alt 30] 192 #:az [az 45] 193 #:x-label [x-label "X axis"] 194 #:y-label [y-label "Y axis"] 195 #:z-label [z-label "Z axis"] 196 #:title [title ""] 197 #:fgcolor [fgcolor '(0 0 0)] 198 #:bgcolor [bgcolor '(255 255 255)] 199 #:lncolor [lncolor '(255 0 0)] 200 #:out-file [out-file #f]) 201 (define x-ticks (ticks-generate (new.plot-x-ticks) x-min x-max)) 202 (define y-ticks (ticks-generate (new.plot-y-ticks) y-min y-max)) 203 (define z-ticks (ticks-generate (new.plot-z-ticks) z-min z-max)) 204 (define bounds-rect (vector (ivl x-min x-max) (ivl y-min y-max) (ivl z-min z-max))) 205 206 (parameterize ([new.plot-title title] 207 [new.plot-x-label x-label] 208 [new.plot-y-label y-label] 209 [new.plot-z-label z-label] 210 [new.plot-foreground fgcolor] 211 [new.plot-background bgcolor] 212 [new.plot3d-angle az] 213 [new.plot3d-altitude alt]) 214 (define bm (make-bitmap (ceiling width) (ceiling height))) 215 (define dc (make-object bitmap-dc% bm)) 216 (define area (make-object 3d-plot-area% 217 bounds-rect x-ticks x-ticks y-ticks y-ticks z-ticks z-ticks '() dc 0 0 width height #f)) 218 219 (send area start-plot) 220 (send area start-renderer bounds-rect) 221 (data area) 222 (send area end-renderers) 223 (send area end-plot) 224 225 (when out-file (send bm save-file out-file 'png)) 226 227 (make-object image-snip% bm))) 228 229;; =================================================================================================== 230;; Functions that generate "plot data" 231 232(define (points vecs #:sym [sym 'square] #:color [color 'black]) 233 (renderer2d->plot-data (new.points (map (λ (v) (vector-take v 2)) vecs) 234 #:sym sym #:size 6 #:color color))) 235 236(define (vector-field f 237 #:samples [samples 20] 238 #:width [width 1] 239 #:color [color 'red] 240 #:style [style 'scaled]) 241 (define scale (case style 242 [(scaled) 'auto] 243 [(normalized) 'normalized] 244 [(real) 1.0])) 245 (renderer2d->plot-data 246 (new.vector-field f #:samples samples #:line-width width #:color color #:scale scale))) 247 248(define (error-bars vecs #:color [color 'black]) 249 (renderer2d->plot-data (new.error-bars vecs #:color color #:alpha 1 #:width 4))) 250 251(define (line f 252 #:samples [samples 150] 253 #:width [width 1] 254 #:color [color 'red] 255 #:mode [mode 'standard] 256 #:mapping [mapping 'cartesian] 257 #:t-min [t-min -5] 258 #:t-max [t-max 5]) 259 (renderer2d->plot-data (line-renderer f samples width color mode mapping t-min t-max))) 260 261(define (contour f 262 #:samples [samples 50] 263 #:width [width 1] 264 #:color [color 'black] 265 #:levels [levels 10]) 266 (renderer2d->plot-data (contour-renderer f samples width color levels))) 267 268(define (shade f #:samples [samples 50] #:levels [levels 10]) 269 (renderer2d->plot-data (shade-renderer f samples levels))) 270 271(define (surface f #:samples [samples 50] #:width [width 1] #:color [color 'black]) 272 (renderer3d->plot-data (surface-renderer f samples width color))) 273