clean up CLSv2 demo to sketch through how one might do data analysis.
[CommonLispStat.git] / examples / plotting-data.lisp
blobc317d164fbbb0ede46e6a2fec9b48db5b4c9f1a7
1 ;;; -*- mode: lisp -*-
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
8 ;;; on how it arrives.
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)
16 ;;;
18 (defpackage :cls-ex-plotting-data
19 (:use :common-lisp
20 :lisp-matrix
21 :lisp-stat
22 :cl-plplot))
24 (in-package :cls-ex-plotting-data)
26 ;;; Original examples from cl-plplot examples, but retweaked for CLS.
28 ;;;;
29 ;;;; Examples that demonstrate using cl-plplot to make 2D & 3D plots.
30 ;;;;
31 ;;;; hazen 12/06
32 ;;;;
34 ;; (asdf:oos 'asdf:load-op 'cl-plplot)
37 ;;; Helper functions
39 (defun my-make-vector (dim init-fn)
40 (let ((vec (make-array dim :initial-element 0.0 :element-type 'float)))
41 (dotimes (i dim)
42 (setf (aref vec i) (funcall init-fn i)))
43 vec))
45 (defun my-make-matrix (dim1 dim2 init-fn)
46 (let ((mat (make-array (list dim1 dim2) :initial-element 0.0 :element-type 'float)))
47 (dotimes (x dim1)
48 (dotimes (y dim2)
49 (setf (aref mat x y) (funcall init-fn x y))))
50 mat))
52 (defun my-make-bar-graph-data (rows cols)
53 (let ((data (make-array (list rows cols) :initial-element 0.0 :element-type 'float)))
54 (dotimes (i rows)
55 (dotimes (j cols)
56 (setf (aref data i j) (+ i j))))
57 data))
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")
77 ;;; X-Y-Plots
79 ;; The simplest plot
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))
85 (w (basic-window)))
86 (add-plot-to-window w p)
87 (render w g-dev)))
89 ;; (basic-plot-1)
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))
95 (w (basic-window)))
96 (add-plot-to-window w p)
97 (render w "png"
98 :filename outfile
99 :size-x 400 :size-y 300)
100 ;; (plend w)
103 ;; (basic-plot-1f)
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)
119 (render w g-dev)))
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)
147 (render w g-dev)))
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)
160 (render w g-dev)))
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))
170 (w (basic-window)))
171 (add-plot-to-window w p1)
172 (add-plot-to-window w p2)
173 (render w g-dev)))
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))
187 (w (basic-window)))
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))
193 (render w g-dev)))
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))
206 (w (basic-window)))
207 (add-plot-to-window w p)
208 (render w g-dev)))
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
213 ;; the color table.
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))
222 (w (basic-window)))
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)
226 (render w g-dev)
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)
230 (render w g-dev)
231 (remove-color-from-color-table c :color2)
232 nil))
235 ;;; Bar graphs
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)))
242 (w (basic-window)))
243 (add-plot-to-window w b)
244 (render w g-dev)))
247 ;; Stacked bar graph
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)))
252 (w (basic-window)))
253 (add-plot-to-window w b)
254 (render w g-dev)))
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)))
262 (w (basic-window)))
263 (add-plot-to-window w b)
264 (render w g-dev)))
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)))
274 (w (basic-window)))
275 (add-plot-to-window w b)
276 (render w g-dev)))
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)))
285 (w (basic-window)))
286 (add-plot-to-window w b)
287 (render w g-dev)))
290 ;;; Contour Plots
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))
298 (w (basic-window)))
299 (add-plot-to-window w c)
300 (render w g-dev)))
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)))
309 (w (basic-window)))
310 (add-plot-to-window w c)
311 (render w g-dev)))
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))
321 (w (basic-window)))
322 (add-plot-to-window w c)
323 (render w g-dev)))
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)
332 (declare (ignore x))
333 (* 0.02 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))
337 (w (basic-window)))
338 (add-plot-to-window w c)
339 (render w g-dev)))
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))
350 (w (basic-window)))
351 (add-plot-to-window w c)
352 (set-color-table w ct)
353 (render w g-dev)))
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)
361 (declare (ignore x))
362 (- (random 4.0) 2.0))))
363 (y (my-make-vector 1000 #'(lambda(y)
364 (declare (ignore 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))
370 (w (basic-window)))
371 (dotimes (i (length z))
372 (let ((tx (aref x i))
373 (ty (aref y 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)
379 (render w g-dev))))
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
394 (w (basic-window)))
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
399 (render w g-dev)
400 (bring-to-front w p)
401 (edit-text-item title :the-text "Right Order?")
402 (render w g-dev)))
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
409 #'(lambda ()
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)))))
416 (w (basic-window)))
417 (add-plot-to-window w cp)
418 (render w g-dev)))
421 ;;; 3D mesh plots
423 ;; A simple 3D mesh plot
425 (defun 3d-plot-1 ()
426 (let ((c (new-3d-mesh nil nil (my-make-matrix 50 50 #'(lambda (x y) (my-contour-plot-fn x y)))
427 :line-color :blue))
428 (w (basic-3d-window :altitude 30 :azimuth 60)))
429 (add-plot-to-window w c)
430 (render w g-dev)))
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)))
436 :line-color :blue))
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)
439 (render w g-dev)))
441 ;; The same plot with (default) cantours drawn in the x-y plane
443 (defun 3d-plot-2 ()
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)
448 (render w g-dev)))
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
453 ;; the x direction.
455 (defun 3d-plot-3 ()
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)
460 (render w g-dev)))
463 ;; The same plot with magnitude coloring on the plot. Additionally a "curtain"
464 ;; is drawn around the plot.
466 (defun 3d-plot-4 ()
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)
471 (render w g-dev)))
474 ;; A simple demonstration 3D text labels.
476 (defun 3d-plot-5 ()
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
478 :text-dy -1.0))
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
480 :text-dx 1.0
481 :text-sz 1.0))
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)
488 (render w g-dev)))
491 ;;; Surface plots
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)))
497 :line-color :blue))
498 (w (basic-3d-window :altitude 30 :azimuth 60)))
499 (add-plot-to-window w c)
500 (render w g-dev)))
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)
509 (render w g-dev)))
512 ;;;;
513 ;;;; Copyright (c) 2006 Hazen P. Babcock
514 ;;;;
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:
521 ;;;;
522 ;;;; The above copyright notice and this permission notice shall be included in
523 ;;;; all copies or substantial portions of the Software.
524 ;;;;
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.
532 ;;;;