3 ;;; Time-stamp: <2009-04-24 17:37:03 tony>
4 ;;; Creation: <2009-03-12 17:14:56 tony>
5 ;;; File: plotting-data.lisp
6 ;;; Author: AJ Rossini <blindglobe@gmail.com>
7 ;;; Copyright: (c)2009--, AJ Rossini. BSD, LLGPL, or GPLv2, depending
9 ;;; Purpose: Example of generating plots.
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 ;;; (with CL-PLPLOT at this point)
18 (defpackage :cls-ex-plotting-data
24 (in-package :cls-ex-plotting-data
)
26 ;;; Original examples from cl-plplot examples, but retweaked for CLS.
29 ;;;; Examples that demonstrate using cl-plplot to make 2D & 3D plots.
34 ;; (asdf:oos 'asdf:load-op 'cl-plplot)
39 (defun my-make-vector (dim init-fn
)
40 (let ((vec (make-array dim
:initial-element
0.0 :element-type
'float
)))
42 (setf (aref vec i
) (funcall init-fn i
)))
45 (defun my-make-matrix (dim1 dim2 init-fn
)
46 (let ((mat (make-array (list dim1 dim2
) :initial-element
0.0 :element-type
'float
)))
49 (setf (aref mat x y
) (funcall init-fn x y
))))
52 (defun my-make-bar-graph-data (rows cols
)
53 (let ((data (make-array (list rows cols
) :initial-element
0.0 :element-type
'float
)))
56 (setf (aref data i j
) (+ i j
))))
59 (defun my-contour-plot-fn (x y
)
60 (let ((tx (- (* 0.02 x
) 0.5))
61 (ty (- (* 0.02 y
) 0.5)))
62 (- (* tx tx
) (* ty ty
)
63 (* (sin (* 7 tx
)) (* (cos (* 7 ty
)))))))
66 ;; You may need to change these to reflect the plplot drivers available on your system
67 ;; If the Slime REPL hangs when you run one of these examples, it may be because the device
68 ;; was not available. When this happens you should be able to specify a different device
69 ;; in the inferior lisp buffer.
71 (defparameter g-dev
"aqt")
73 (defparameter g-dev
"xcairo")
74 (defparameter g-dev
"wxwidgets")
75 (defparameter g-dev
"gnome")
81 (defun basic-plot-1 ()
82 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
83 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
84 (p (new-x-y-plot x y
))
86 (add-plot-to-window w p
)
91 (defun basic-plot-1f (&optional
(outfile "/home/tony/basic-plot-1f.png"))
92 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
93 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
94 (p (new-x-y-plot x y
))
96 (add-plot-to-window w p
)
99 :size-x
400 :size-y
300)
104 ;; (basic-plot-1f "2.png")
105 ;; (basic-plot-1f "3.png")
106 ;; (basic-plot-1f "4.png")
111 ;; The same plot with a user defined y-axis range
113 (defun basic-plot-1.1
()
114 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
115 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
116 (p (new-x-y-plot x y
))
117 (w (basic-window :y-axis-min -
5.0 :y-axis-max
50.0)))
118 (add-plot-to-window w p
)
121 ;; Here we add our own labels to the plot, change the size & add another piece of data with
122 ;; a heavier red line.
124 (defun basic-plot-2 ()
125 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
126 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
127 (p1 (new-x-y-plot x y
))
128 (p2 (new-x-y-plot x x
:color
:red
:line-width
2))
129 (w (basic-window :x-label
"x" :y-label
"y" :title
"my graph")))
130 (add-plot-to-window w p1
)
131 (add-plot-to-window w p2
)
132 (render w g-dev
:size-x
400 :size-y
300)))
133 ; (render w "png" :filename "/Users/hbabcock/test.png" :size-x 400 :size-y 300)))
136 ;; Here we change the background and foreground colors & the x axis ticks & the
137 ;; y axis format and the x axis font size.
139 (defun basic-plot-3 ()
140 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
141 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
142 (p1 (new-x-y-plot x y
:color
:blue
))
143 (w (basic-window :title
"" :foreground-color
:red
:background-color
:black
)))
144 (edit-window-axis w
:x
:major-tick-interval
0.5 :minor-tick-number
10
145 :properties
'(:draw-bottom
/left
:major-tick-grid
:invert-ticks
:major-tick-labels-above
/right
:major-ticks
:minor-ticks
))
146 (add-plot-to-window w p1
)
150 ;; Here we demonstrate some of the text capabilities.
152 (defun basic-plot-4 ()
153 (let ((w (basic-window))
154 (l1 (new-text-label (new-text-item (roman-font "x" (superscript "2") "!") :font-size
2.0 :text-color
:blue
) 0.5 0.2))
155 (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))
156 (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)))
157 (add-text-label-to-window w l1
)
158 (add-text-label-to-window w l2
)
159 (add-text-label-to-window w l3
)
163 ;; Here we plot one set of data as points & the other as a dashed blue line.
165 (defun basic-plot-5 ()
166 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
167 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
168 (p1 (new-x-y-plot x y
:line-width
0 :symbol-size
6.0 :symbol-type
1))
169 (p2 (new-x-y-plot x x
:color
:blue
:line-style
2))
171 (add-plot-to-window w p1
)
172 (add-plot-to-window w p2
)
176 ;; Here we make a simple plot & then get the x-y coordinates of the next mouse
177 ;; click (on the plot). Note that the coordinate scale for the mouse click location
178 ;; is the same as those on the axises of the graph. Once we have the mouse
179 ;; location we generate a new graph with the line going through this point
180 ;; by taking advantage of the fact that by setting copy to :nil we have told
181 ;; x-y-plot to store a reference to the vectors x & y rather then copying x & y.
183 (defun basic-plot-6 ()
184 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
185 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
186 (p (new-x-y-plot x y
:copy nil
))
188 (add-plot-to-window w p
)
189 (multiple-value-bind (mx my
) (get-cursor w g-dev
)
190 (format t
"You clicked : <~,2f, ~,2f>~%" mx my
)
191 (setf (aref x
20) mx
)
192 (setf (aref y
20) my
))
196 ;; Here we make a plot with some error bars in x & y
197 ;; Note that error bar is drawn with the total length given by the error bar
198 ;; vector & centered on the data point.
200 (defun basic-plot-7 ()
201 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
202 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
203 (x-err (my-make-vector 40 #'(lambda(x) (declare (ignore x
)) 0.06)))
204 (y-err (my-make-vector 40 #'(lambda(x) (declare (ignore x
)) 1.0)))
205 (p (new-x-y-plot x y
:x-error x-err
:y-error y-err
))
207 (add-plot-to-window w p
)
211 ;; Here we make our own color table with 2-3 colors, set window to use our new
212 ;; color table instead of the default & then change the foreground color in
215 ;; See also: src/window/color-table.lisp for a brief introduction of color handling.
217 (defun basic-plot-8 ()
218 (let* ((c (new-color-table (vector 0 0 0 :color1
)))
219 (x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
220 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
221 (p (new-x-y-plot x y
))
223 (add-plot-to-window w p
)
224 (add-color-to-color-table c
(vector 255 0 0 :color2
))
225 (set-color-table w c
)
227 (add-color-to-color-table c
(vector 255 255 255 :color3
))
228 (edit-x-y-plot p
:color
:color3
)
229 (edit-window w
:foreground-color
:color1
:background-color
:color2
)
231 (remove-color-from-color-table c
:color2
)
237 ;; Here we make a simple bar graph
239 (defun bar-graph-1 ()
240 (let* ((y (my-make-vector 10 #'(lambda(x) (* (* 0.2 x
) (* 0.2 x
)))))
241 (b (new-bar-graph nil y
:fill-colors
(vector :grey
)))
243 (add-plot-to-window w b
)
249 (defun bar-graph-2 ()
250 (let* ((y (my-make-bar-graph-data 10 3))
251 (b (new-bar-graph nil y
:line-colors
(vector :black
:black
:black
)))
253 (add-plot-to-window w b
)
257 ;; A Side by side bar graph
259 (defun bar-graph-3 ()
260 (let* ((y (my-make-bar-graph-data 10 3))
261 (b (new-bar-graph nil y
:side-by-side t
:line-colors
(vector :black
:black
:black
)))
263 (add-plot-to-window w b
)
267 ;; Bar graph with custom spacing & widths
269 (defun bar-graph-4 ()
270 (let* ((x (my-make-vector 10 #'(lambda(x) (* 0.1 x
))))
271 (y (my-make-vector 10 #'(lambda(x) (- (* (* 0.2 x
) (* 0.2 x
)) 1))))
272 (s (my-make-vector 10 #'(lambda(x) (+ 0.05 (* 0.005 x
)))))
273 (b (new-bar-graph x y
:bar-widths s
:fill-colors
(vector :grey
)))
275 (add-plot-to-window w b
)
279 ;; A side by side bar graph with custom widths
281 (defun bar-graph-5 ()
282 (let* ((y (my-make-bar-graph-data 10 3))
283 (s (my-make-vector 10 #'(lambda(x) (+ 0.1 (* 0.05 (sqrt x
))))))
284 (b (new-bar-graph nil y
:bar-widths s
:side-by-side t
:line-colors
(vector :black
:black
:black
)))
286 (add-plot-to-window w b
)
293 ;; A simple contour plot
295 (defun contour-plot-1 ()
296 (let ((c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
297 :line-color
:blue
:line-width
2))
299 (add-plot-to-window w c
)
303 ;; The same plot rescaled with filled contours
305 (defun contour-plot-2 ()
306 (let ((c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
307 :x-min
0.0 :x-max
1.0 :y-min
0.0 :y-max
1.0 :fill-type
:block
308 :fill-colors
(vector :red
:grey
:blue
:yellow
:green
)))
310 (add-plot-to-window w c
)
314 ;; Plotted on a user defined simple grid with smooth shading between contours
316 (defun contour-plot-3 ()
317 (let* ((xp (my-make-vector 50 #'(lambda(x) (+ (* 0.1 x
) (* 0.01 x x
)))))
318 (yp (my-make-vector 50 #'(lambda(y) (+ (* 0.1 y
) (* 0.001 y y
)))))
319 (c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
320 :x-mapping xp
:y-mapping yp
:fill-type
:smooth
))
322 (add-plot-to-window w c
)
326 ;; Plotted on a more complex user defined grid
328 (defun contour-plot-4 ()
329 (let* ((xp (my-make-matrix 51 51 #'(lambda(x y
)
330 (+ (* 0.02 (- x
25) (* 0.01 (+ y
50)))))))
331 (yp (my-make-matrix 51 51 #'(lambda(x y
)
334 (cl (my-make-vector 20 #'(lambda(x) (- (* 0.12 x
) 1.0))))
335 (c (new-contour-plot (my-make-matrix 51 51 #'(lambda (x y
) (my-contour-plot-fn x y
)))
336 :x-mapping xp
:y-mapping yp
:contour-levels cl
))
338 (add-plot-to-window w c
)
342 ;; The same as contour-plot-3, but with a gray scale color table.
344 (defun contour-plot-5 ()
345 (let* ((ct (new-extended-color-table :control-points
(vector #(0.0
0 0 0) #(1.0
255 255 255))))
346 (xp (my-make-vector 50 #'(lambda(x) (+ (* 0.1 x
) (* 0.01 x x
)))))
347 (yp (my-make-vector 50 #'(lambda(y) (+ (* 0.1 y
) (* 0.001 y y
)))))
348 (c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
349 :x-mapping xp
:y-mapping yp
:fill-type
:smooth
))
351 (add-plot-to-window w c
)
352 (set-color-table w ct
)
356 ;; Use PLplot's ability to grid data to convert your (x,y,z) data into a
357 ;; plottable 2D grid.
359 (defun contour-plot-6 ()
360 (let* ((x (my-make-vector 1000 #'(lambda(x)
362 (- (random 4.0) 2.0))))
363 (y (my-make-vector 1000 #'(lambda(y)
365 (- (random 4.0) 2.0))))
366 (z (make-array 1000 :initial-element
0.0 :element-type
'float
))
367 (xgrid (my-make-vector 21 #'(lambda(x) (- (* 0.2 x
) 2.0))))
368 (ygrid (my-make-vector 21 #'(lambda(x) (- (* 0.2 x
) 2.0))))
369 (p (new-x-y-plot x y
:line-width
0 :symbol-type
2 :symbol-size
0.75))
371 (dotimes (i (length z
))
372 (let ((tx (aref x i
))
374 (setf (aref z i
) (- (* tx tx
) (* ty ty
) (* (sin tx
) (* (cos ty
)))))))
375 (let* ((d (x-y-z-data-to-grid (list x y z
) xgrid ygrid
:algorithm
:grid-nnli
))
376 (c (new-contour-plot d
:x-mapping xgrid
:y-mapping ygrid
:fill-type
:block
)))
377 (add-plot-to-window w c
)
378 (add-plot-to-window w p
)
382 ;; Mixing different plot types is also possible, though care must be taken
383 ;; to draw them in the right order.
385 (defun mixed-plot-1 ()
386 (let* ((x (my-make-vector 40 #'(lambda(x) (* 0.1 x
))))
387 (y (my-make-vector 40 #'(lambda(x) (* (* 0.1 x
) (* 0.1 x
)))))
388 (p (new-x-y-plot x y
:line-width
2))
389 (c (new-contour-plot (my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
390 :x-min
0.0 :x-max
4.0 :y-min
0.0 :y-max
15.0 :fill-type
:block
391 :fill-colors
(vector :red
:grey
:blue
:yellow
:green
)))
392 (title (new-text-item "..." :font-size
1.5)) ; create a text object for the title
393 (l (new-axis-label title
:top
1.5)) ; create an axis label containing the title object
395 (add-plot-to-window w p
)
396 (add-plot-to-window w c
)
397 (edit-window w
:title l
) ; replace the default title object with our own title object
398 (edit-text-item title
:the-text
"Wrong Order?") ; change the text in the title object
401 (edit-text-item title
:the-text
"Right Order?")
405 ;; Roll your own custom plot type & have it get drawn like any other plot type
407 (defun custom-plot-type-1 ()
408 (let ((cp (new-custom-plot-object
410 (vector 0.0 4.0 0.0 4.0))
411 #'(lambda (plot-number)
412 (declare (ignore plot-number
))
413 (set-foreground-color :red
)
414 (cl-plplot-system:plfill
(vector 1.0 1.2 2.8 3.0)
415 (vector 1.0 3.0 3.0 1.0)))))
417 (add-plot-to-window w cp
)
423 ;; A simple 3D mesh plot
426 (let ((c (new-3d-mesh nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
428 (w (basic-3d-window :altitude
30 :azimuth
60)))
429 (add-plot-to-window w c
)
432 ;; The same plot with a custom z axis range
434 (defun 3d-plot-1.1
()
435 (let ((c (new-3d-mesh nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
437 (w (basic-3d-window :z-axis-min -
2.0 :z-axis-max
2.0 :altitude
30 :azimuth
60)))
438 (add-plot-to-window w c
)
441 ;; The same plot with (default) cantours drawn in the x-y plane
444 (let ((c (new-3d-mesh nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
445 :line-color
:blue
:contour-options
:base-contour
))
446 (w (basic-3d-window :altitude
30 :azimuth
60)))
447 (add-plot-to-window w c
)
451 ;; The same plot with (default) cantours drawn in the x-y plane and magnitude
452 ;; coloring on the plot. Additionally, only draw lines in between points in
456 (let ((c (new-3d-mesh nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
457 :grid-type
:grid-x
:contour-options
:both
))
458 (w (basic-3d-window :altitude
30 :azimuth
60)))
459 (add-plot-to-window w c
)
463 ;; The same plot with magnitude coloring on the plot. Additionally a "curtain"
464 ;; is drawn around the plot.
467 (let ((c (new-3d-mesh nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
468 :contour-options
:magnitude-contour
:curtain t
))
469 (w (basic-3d-window :altitude
30 :azimuth
60)))
470 (add-plot-to-window w c
)
474 ;; A simple demonstration 3D text labels.
477 (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
479 (l2 (new-3D-text-label (new-text-item (roman-font "Label2") :font-size
2.0 :text-color
:red
) 1.5 1.0 0.1
482 (w (basic-3d-window :altitude
30 :azimuth
60
483 :x-axis-min
0 :x-axis-max
2.0
484 :y-axis-min
0 :y-axis-max
2.0
485 :z-axis-min
0 :z-axis-max
2.0)))
486 (add-text-label-to-window w l1
)
487 (add-text-label-to-window w l2
)
493 ;; A simple surface plot
495 (defun surface-plot-1 ()
496 (let ((c (new-surface-plot nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
498 (w (basic-3d-window :altitude
30 :azimuth
60)))
499 (add-plot-to-window w c
)
502 ;; The same plot with a curtain and coloring according to the magnitude in z
504 (defun surface-plot-2 ()
505 (let ((c (new-surface-plot nil nil
(my-make-matrix 50 50 #'(lambda (x y
) (my-contour-plot-fn x y
)))
506 :surface-options
'(:curtain
:magnitude-coloring
)))
507 (w (basic-3d-window :altitude
30 :azimuth
60)))
508 (add-plot-to-window w c
)
513 ;;;; Copyright (c) 2006 Hazen P. Babcock
515 ;;;; Permission is hereby granted, free of charge, to any person obtaining a copy
516 ;;;; of this software and associated documentation files (the "Software"), to
517 ;;;; deal in the Software without restriction, including without limitation the
518 ;;;; rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
519 ;;;; sell copies of the Software, and to permit persons to whom the Software is
520 ;;;; furnished to do so, subject to the following conditions:
522 ;;;; The above copyright notice and this permission notice shall be included in
523 ;;;; all copies or substantial portions of the Software.
525 ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
526 ;;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
527 ;;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
528 ;;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
529 ;;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
530 ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
531 ;;;; IN THE SOFTWARE.