3 ;;; Time-stamp: <2009-04-23 17:23:56 tony>
4 ;;; Creation: <2009-03-10 16:59:37 tony>
6 ;;; Author: AJ Rossini <blindglobe@gmail.com>
7 ;;; Copyright: (c)2009--, AJ Rossini. BSD, LLGPL, or GPLv2, depending
9 ;;; Purpose: visualization and plotting generics and methods.
11 ;;; What is this talk of 'release'? Klingons do not make software
12 ;;; 'releases'. Our software 'escapes', leaving a bloody trail of
13 ;;; designers and quality assurance people in its wake.
15 ;;; This organization and structure is new to the 21st Century
19 ;;;; CL-PLPLOT experiments using the lispy interface.
22 ;;; To solve - need to figure out how to keep the damn'd thing from
23 ;;; mem-fault'ing. otherwise, have most of what we need to make it
24 ;;; all work for 2-d graphics.
27 (asdf:oos
'asdf
:load-op
'cl-plplot
)
29 (defpackage :plplot-expt
33 (in-package :plplot-expt
)
38 (defun my-make-vector (dim init-fn
)
39 (let ((vec (make-array dim
:initial-element
0.0 :element-type
'float
)))
41 (setf (aref vec i
) (funcall init-fn i
)))
44 (defun my-make-matrix (dim1 dim2 init-fn
)
45 (let ((mat (make-array (list dim1 dim2
) :initial-element
0.0 :element-type
'float
)))
48 (setf (aref mat x y
) (funcall init-fn x y
))))
51 (defun my-make-bar-graph-data (rows cols
)
52 (let ((data (make-array (list rows cols
) :initial-element
0.0 :element-type
'float
)))
55 (setf (aref data i j
) (+ i j
))))
58 (defun my-contour-plot-fn (x y
)
59 (let ((tx (- (* 0.02 x
) 0.5))
60 (ty (- (* 0.02 y
) 0.5)))
61 (- (* tx tx
) (* ty ty
)
62 (* (sin (* 7 tx
)) (* (cos (* 7 ty
)))))))
65 ;; You may need to change these to reflect the plplot drivers available on your system
66 ;; If the Slime REPL hangs when you run one of these examples, it may be because the device
67 ;; was not available. When this happens you should be able to specify a different device
68 ;; in the inferior lisp buffer.
70 (defparameter g-dev
"xwin")
71 (defparameter g-dev
"xcairo")
77 (defun basic-plot-1 ()
78 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
79 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
80 (p (new-x-y-plot x y
))
82 (add-plot-to-window w p
)
86 (defparameter *g-dev
* "xwin")
87 (defparameter *x
* (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
88 (defparameter *y
* (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
89 (defparameter *p
* (new-x-y-plot *x
* *y
*))
90 (defparameter *w
* (basic-window))
91 (add-plot-to-window *w
* *p
*)
92 (defparameter *g-dev
* "xcairo")
99 ;; The same plot with a user defined y-axis range
101 (defun basic-plot-1.1
()
102 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
103 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
104 (p (new-x-y-plot x y
))
105 (w (basic-window :y-axis-min -
5.0 :y-axis-max
50.0)))
106 (add-plot-to-window w p
)
109 ;; Here we add our own labels to the plot, change the size & add another piece of data with
110 ;; a heavier red line.
112 (defun basic-plot-2 ()
113 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
114 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
115 (p1 (new-x-y-plot x y
))
116 (p2 (new-x-y-plot x x
:color
:red
:line-width
2))
117 (w (basic-window :x-label
"x" :y-label
"y" :title
"my graph")))
118 (add-plot-to-window w p1
)
119 (add-plot-to-window w p2
)
120 (render w g-dev
:size-x
400 :size-y
300)))
121 ; (render w "png" :filename "/Users/hbabcock/test.png" :size-x 400 :size-y 300)))
124 ;; Here we change the background and foreground colors & the x axis ticks & the
125 ;; y axis format and the x axis font size.
127 (defun basic-plot-3 ()
128 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
129 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
130 (p1 (new-x-y-plot x y
:color
:blue
))
131 (w (basic-window :title
"" :foreground-color
:red
:background-color
:black
)))
132 (edit-window-axis w
:x
:major-tick-interval
0.5 :minor-tick-number
10
133 :properties
'(:draw-bottom
/left
:major-tick-grid
:invert-ticks
:major-tick-labels-above
/right
:major-ticks
:minor-ticks
))
134 (add-plot-to-window w p1
)
138 ;; Here we demonstrate some of the text capabilities.
140 (defun basic-plot-4 ()
141 (let ((w (basic-window))
142 (l1 (new-text-label (new-text-item (roman-font "x" (superscript "2") "!") :font-size
2.0 :text-color
:blue
) 0.5 0.2))
143 (l2 (new-text-label (new-text-item (roman-font "test1 " (italic-font "test2 ") "test3") :font-size
2.0 :text-color
:red
) 0.5 0.4))
144 (l3 (new-text-label (new-text-item (roman-font (unicode-char "967") (unicode-char "968")) :font-size
2.0 :text-color
:green
) 0.5 0.6)))
145 (add-text-label-to-window w l1
)
146 (add-text-label-to-window w l2
)
147 (add-text-label-to-window w l3
)
151 ;; Here we plot one set of data as points & the other as a dashed blue line.
153 (defun basic-plot-5 ()
154 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
155 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
156 (p1 (new-x-y-plot x y
:line-width
0 :symbol-size
6.0 :symbol-type
1))
157 (p2 (new-x-y-plot x x
:color
:blue
:line-style
2))
159 (add-plot-to-window w p1
)
160 (add-plot-to-window w p2
)
164 ;; Here we make a simple plot & then get the x-y coordinates of the next mouse
165 ;; click (on the plot). Note that the coordinate scale for the mouse click location
166 ;; is the same as those on the axises of the graph. Once we have the mouse
167 ;; location we generate a new graph with the line going through this point
168 ;; by taking advantage of the fact that by setting copy to :nil we have told
169 ;; x-y-plot to store a reference to the vectors x & y rather then copying x & y.
171 (defun basic-plot-6 ()
172 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
173 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
174 (p (new-x-y-plot x y
:copy nil
))
176 (add-plot-to-window w p
)
177 (multiple-value-bind (mx my
) (get-cursor w g-dev
)
178 (format t
"You clicked : <~,2f, ~,2f>~%" mx my
)
179 (setf (aref x
20) mx
)
180 (setf (aref y
20) my
))
184 ;; Here we make a plot with some error bars in x & y
185 ;; Note that error bar is drawn with the total length given by the error bar
186 ;; vector & centered on the data point.
188 (defun basic-plot-7 ()
189 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
190 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
191 (x-err (my-make-vector 40 #'(lambda(x) (declare (ignore x
)) 0.06)))
192 (y-err (my-make-vector 40 #'(lambda(x) (declare (ignore x
)) 1.0)))
193 (p (new-x-y-plot x y
:x-error x-err
:y-error y-err
))
195 (add-plot-to-window w p
)
199 ;; Here we make our own color table with 2-3 colors, set window to use our new
200 ;; color table instead of the default & then change the foreground color in
203 ;; See also: src/window/color-table.lisp for a brief introduction of color handling.
205 (defun basic-plot-8 ()
206 (let* ((c (new-color-table (vector 0 0 0 :color1
)))
207 (x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
208 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
209 (p (new-x-y-plot x y
))
211 (add-plot-to-window w p
)
212 (add-color-to-color-table c
(vector 255 0 0 :color2
))
213 (set-color-table w c
)
215 (add-color-to-color-table c
(vector 255 255 255 :color3
))
216 (edit-x-y-plot p
:color
:color3
)
217 (edit-window w
:foreground-color
:color1
:background-color
:color2
)
219 (remove-color-from-color-table c
:color2
)
225 ;; Here we make a simple bar graph
227 (defun bar-graph-1 ()
228 (let* ((y (my-make-vector 10 #'(lambda(x) (* (* 0.2 x
) (* 0.2 x
)))))
229 (b (new-bar-graph nil y
:fill-colors
(vector :grey
)))
231 (add-plot-to-window w b
)
237 (defun bar-graph-2 ()
238 (let* ((y (my-make-bar-graph-data 10 3))
239 (b (new-bar-graph nil y
:line-colors
(vector :black
:black
:black
)))
241 (add-plot-to-window w b
)
245 ;; A Side by side bar graph
247 (defun bar-graph-3 ()
248 (let* ((y (my-make-bar-graph-data 10 3))
249 (b (new-bar-graph nil y
:side-by-side t
:line-colors
(vector :black
:black
:black
)))
251 (add-plot-to-window w b
)
255 ;; Bar graph with custom spacing & widths
257 (defun bar-graph-4 ()
258 (let* ((x (my-make-vector 10 #'(lambda(x) (* 0.1 x
))))
259 (y (my-make-vector 10 #'(lambda(x) (- (* (* 0.2 x
) (* 0.2 x
)) 1))))
260 (s (my-make-vector 10 #'(lambda(x) (+ 0.05 (* 0.005 x
)))))
261 (b (new-bar-graph x y
:bar-widths s
:fill-colors
(vector :grey
)))
263 (add-plot-to-window w b
)
267 ;; A side by side bar graph with custom widths
269 (defun bar-graph-5 ()
270 (let* ((y (my-make-bar-graph-data 10 3))
271 (s (my-make-vector 10 #'(lambda(x) (+ 0.1 (* 0.05 (sqrt x
))))))
272 (b (new-bar-graph nil y
:bar-widths s
:side-by-side t
:line-colors
(vector :black
:black
:black
)))
274 (add-plot-to-window w b
)
281 ;; A simple contour plot
283 (defun contour-plot-1 ()
284 (let ((c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
285 :line-color
:blue
:line-width
2))
287 (add-plot-to-window w c
)
291 ;; The same plot rescaled with filled contours
293 (defun contour-plot-2 ()
294 (let ((c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
295 :x-min
0.0 :x-max
1.0 :y-min
0.0 :y-max
1.0 :fill-type
:block
296 :fill-colors
(vector :red
:grey
:blue
:yellow
:green
)))
298 (add-plot-to-window w c
)
302 ;; Plotted on a user defined simple grid with smooth shading between contours
304 (defun contour-plot-3 ()
305 (let* ((xp (my-make-vector 50 #'(lambda(x) (+ (* 0.1 x
) (* 0.01 x x
)))))
306 (yp (my-make-vector 50 #'(lambda(y) (+ (* 0.1 y
) (* 0.001 y y
)))))
307 (c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
308 :x-mapping xp
:y-mapping yp
:fill-type
:smooth
))
310 (add-plot-to-window w c
)
314 ;; Plotted on a more complex user defined grid
316 (defun contour-plot-4 ()
317 (let* ((xp (my-make-matrix 51 51 #'(lambda(x y
)
318 (+ (* 0.02 (- x
25) (* 0.01 (+ y
50)))))))
319 (yp (my-make-matrix 51 51 #'(lambda(x y
)
322 (cl (my-make-vector 20 #'(lambda(x) (- (* 0.12 x
) 1.0))))
323 (c (new-contour-plot (my-make-matrix 51 51 #'(lambda (x y
) (my-contour-plot-fn x y
)))
324 :x-mapping xp
:y-mapping yp
:contour-levels cl
))
326 (add-plot-to-window w c
)
330 ;; The same as contour-plot-3, but with a gray scale color table.
332 (defun contour-plot-5 ()
333 (let* ((ct (new-extended-color-table :control-points
(vector #(0.0
0 0 0) #(1.0
255 255 255))))
334 (xp (my-make-vector 50 #'(lambda(x) (+ (* 0.1 x
) (* 0.01 x x
)))))
335 (yp (my-make-vector 50 #'(lambda(y) (+ (* 0.1 y
) (* 0.001 y y
)))))
336 (c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
337 :x-mapping xp
:y-mapping yp
:fill-type
:smooth
))
339 (add-plot-to-window w c
)
340 (set-color-table w ct
)
344 ;; Use PLplot's ability to grid data to convert your (x,y,z) data into a
345 ;; plottable 2D grid.
347 (defun contour-plot-6 ()
348 (let* ((x (my-make-vector 1000 #'(lambda(x)
350 (- (random 4.0) 2.0))))
351 (y (my-make-vector 1000 #'(lambda(y)
353 (- (random 4.0) 2.0))))
354 (z (make-array 1000 :initial-element
0.0 :element-type
'float
))
355 (xgrid (my-make-vector 21 #'(lambda(x) (- (* 0.2 x
) 2.0))))
356 (ygrid (my-make-vector 21 #'(lambda(x) (- (* 0.2 x
) 2.0))))
357 (p (new-x-y-plot x y
:line-width
0 :symbol-type
2 :symbol-size
0.75))
359 (dotimes (i (length z
))
360 (let ((tx (aref x i
))
362 (setf (aref z i
) (- (* tx tx
) (* ty ty
) (* (sin tx
) (* (cos ty
)))))))
363 (let* ((d (x-y-z-data-to-grid (list x y z
) xgrid ygrid
:algorithm
:grid-nnli
))
364 (c (new-contour-plot d
:x-mapping xgrid
:y-mapping ygrid
:fill-type
:block
)))
365 (add-plot-to-window w c
)
366 (add-plot-to-window w p
)
370 ;; Mixing different plot types is also possible, though care must be taken
371 ;; to draw them in the right order.
373 (defun mixed-plot-1 ()
374 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
375 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
376 (p (new-x-y-plot x y
:line-width
2))
377 (c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
378 :x-min
0.0 :x-max
4.0 :y-min
0.0 :y-max
15.0 :fill-type
:block
379 :fill-colors
(vector :red
:grey
:blue
:yellow
:green
)))
380 (title (new-text-item "..." :font-size
1.5)) ; create a text object for the title
381 (l (new-axis-label title
:top
1.5)) ; create an axis label containing the title object
383 (add-plot-to-window w p
)
384 (add-plot-to-window w c
)
385 (edit-window w
:title l
) ; replace the default title object with our own title object
386 (edit-text-item title
:the-text
"Wrong Order?") ; change the text in the title object
389 (edit-text-item title
:the-text
"Right Order?")
393 ;; Roll your own custom plot type & have it get drawn like any other plot type
395 (defun custom-plot-type-1 ()
396 (let ((cp (new-custom-plot-object
398 (vector 0.0 4.0 0.0 4.0))
399 #'(lambda (plot-number)
400 (declare (ignore plot-number
))
401 (set-foreground-color :red
)
402 (cl-plplot-system:plfill
(vector 1.0 1.2 2.8 3.0)
403 (vector 1.0 3.0 3.0 1.0)))))
405 (add-plot-to-window w cp
)
411 ;; A simple 3D mesh plot
414 (let ((c (new-3d-mesh nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
416 (w (basic-3d-window :altitude
30 :azimuth
60)))
417 (add-plot-to-window w c
)
420 ;; The same plot with a custom z axis range
422 (defun 3d-plot-1.1
()
423 (let ((c (new-3d-mesh nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
425 (w (basic-3d-window :z-axis-min -
2.0 :z-axis-max
2.0 :altitude
30 :azimuth
60)))
426 (add-plot-to-window w c
)
429 ;; The same plot with (default) cantours drawn in the x-y plane
432 (let ((c (new-3d-mesh nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
433 :line-color
:blue
:contour-options
:base-contour
))
434 (w (basic-3d-window :altitude
30 :azimuth
60)))
435 (add-plot-to-window w c
)
439 ;; The same plot with (default) cantours drawn in the x-y plane and magnitude
440 ;; coloring on the plot. Additionally, only draw lines in between points in
444 (let ((c (new-3d-mesh nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
445 :grid-type
:grid-x
:contour-options
:both
))
446 (w (basic-3d-window :altitude
30 :azimuth
60)))
447 (add-plot-to-window w c
)
451 ;; The same plot with magnitude coloring on the plot. Additionally a "curtain"
452 ;; is drawn around the plot.
455 (let ((c (new-3d-mesh nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
456 :contour-options
:magnitude-contour
:curtain t
))
457 (w (basic-3d-window :altitude
30 :azimuth
60)))
458 (add-plot-to-window w c
)
462 ;; A simple demonstration 3D text labels.
465 (let ((l1 (new-3D-text-label (new-text-item (roman-font "Label1") :font-size
2.0 :text-color
:blue
) 0.5 1.0 0.1
467 (l2 (new-3D-text-label (new-text-item (roman-font "Label2") :font-size
2.0 :text-color
:red
) 1.5 1.0 0.1
470 (w (basic-3d-window :altitude
30 :azimuth
60
471 :x-axis-min
0 :x-axis-max
2.0
472 :y-axis-min
0 :y-axis-max
2.0
473 :z-axis-min
0 :z-axis-max
2.0)))
474 (add-text-label-to-window w l1
)
475 (add-text-label-to-window w l2
)
481 ;; A simple surface plot
483 (defun surface-plot-1 ()
484 (let ((c (new-surface-plot nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
486 (w (basic-3d-window :altitude
30 :azimuth
60)))
487 (add-plot-to-window w c
)
490 ;; The same plot with a curtain and coloring according to the magnitude in z
492 (defun surface-plot-2 ()
493 (let ((c (new-surface-plot nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
494 :surface-options
'(:curtain
:magnitude-coloring
)))
495 (w (basic-3d-window :altitude
30 :azimuth
60)))
496 (add-plot-to-window w c
)
501 ;;;; Copyright (c) 2006 Hazen P. Babcock
503 ;;;; Permission is hereby granted, free of charge, to any person obtaining a copy
504 ;;;; of this software and associated documentation files (the "Software"), to
505 ;;;; deal in the Software without restriction, including without limitation the
506 ;;;; rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
507 ;;;; sell copies of the Software, and to permit persons to whom the Software is
508 ;;;; furnished to do so, subject to the following conditions:
510 ;;;; The above copyright notice and this permission notice shall be included in
511 ;;;; all copies or substantial portions of the Software.
513 ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
514 ;;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
515 ;;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
516 ;;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
517 ;;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
518 ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
519 ;;;; IN THE SOFTWARE.
523 ;;;; Copyright (c) 2006 Hazen P. Babcock
525 ;;;; Permission is hereby granted, free of charge, to any person obtaining a copy
526 ;;;; of this software and associated documentation files (the "Software"), to
527 ;;;; deal in the Software without restriction, including without limitation the
528 ;;;; rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
529 ;;;; sell copies of the Software, and to permit persons to whom the Software is
530 ;;;; furnished to do so, subject to the following conditions:
532 ;;;; The above copyright notice and this permission notice shall be included in
533 ;;;; all copies or substantial portions of the Software.
535 ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
536 ;;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
537 ;;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
538 ;;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
539 ;;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
540 ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
541 ;;;; IN THE SOFTWARE.