src/visualize/plot.lisp

   1 ;;; -*- mode: lisp -*-
   2
   3 ;;; Time-stamp: <2009-04-17 18:22:13 tony>
   4 ;;; Creation:   <2009-03-10 16:59:37 tony>
   5 ;;; File:       plot.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:    visualization and plotting generics and methods.
  10
  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.
  14
  15 ;;; This organization and structure is new to the 21st Century
  16 ;;; version.
  17
  18 (in-package :cls-visualize)
  19
  20 ;;;; CL-PLPLOT experiments
  21
  22
  23 ;;; To solve - need to figure out how to keep the damn'd thing from
  24 ;;; mem-fault'ing.  otherwise, have most of what we need to make it
  25 ;;; all work for 2-d graphics.
  26
  27 (asdf:oos 'asdf:load-op 'cl-plplot)
  28
  29 (in-package :cls-visualize-plplot)
  30
  31 ;; set this to the appropriate plplot device for your system
  32 #|
  33  < 1> xwin       X-Window (Xlib)
  34  < 2> gcw        Gnome Canvas Widget
  35  < 3> ps         PostScript File (monochrome)
  36  < 4> psc        PostScript File (color)
  37  < 5> xfig       Fig file
  38  < 6> hp7470     HP 7470 Plotter File (HPGL Cartridge, Small Plotter)
  39  < 7> hp7580     HP 7580 Plotter File (Large Plotter)
  40  < 8> lj_hpgl    HP Laserjet III, HPGL emulation mode
  41  < 9> pbm        PDB (PPM) Driver
  42  <10> null       Null device
  43  <11> mem        User-supplied memory device
  44  <12> wxwidgets  wxWidgets Driver
  45  <13> svg        Scalable Vector Graphics (SVG 1.1)
  46  <14> xcairo     Cairo X Windows Driver
  47  <15> pdfcairo   Cairo PDF Driver
  48  <16> pscairo    Cairo PS Driver
  49  <17> svgcairo   Cairo SVG Driver
  50  <18> pngcairo   Cairo PNG Driver
  51 |#
  52
  53
  54 ;;(defparameter *gdev* "aqt")
  55 (defparameter *gdev* "xcairo")
  56 ;;(defparameter *gdev* "xwin")
  57 ;;(defparameter *gdev* "gnome")
  58 ;;(defparameter *gdev* "wxwidgets")
  59 (plsdev *gdev*)
  60
  61
  62 ;;; Helper functions
  63
  64 (defun my-make-array (dims)
  65   (make-array dims :initial-element 0.0 :element-type 'float))
  66
  67 (defun example-func-1 (x y)
  68   (- (* x x) (* y y) (* (sin (* 7 x)) (* (cos (* 7 y))))))
  69
  70 (defun example-func-2 (x y)
  71   (let ((z (+ (expt (1- x) 2) (* 100 (expt (- y (expt x 2)) 2)))))
  72     (if (> z 0)
  73         (log z)
  74         0.0)))
  75
  76 (defun example-matrix (sx sy fn)
  77   (let ((mat (my-make-array (list sx sy)))
  78         (dx (/ 2 sx))
  79         (dy (/ 2 sy)))
  80     (dotimes (x sx)
  81       (dotimes (y sy)
  82         (setf (aref mat x y) (funcall fn (1- (* dx x)) (1- (* dy y))))))
  83     mat))
  84
  85 (defun make-levels (levels min max)
  86   (let ((clevels (my-make-array levels)))
  87     (dotimes (i levels)
  88       (setf (aref clevels i) (+ min (/ (* (- max min) (+ 0.5 i)) levels))))
  89     clevels))
  90
  91 ;;; Examples
  92
  93 ;; A 2D plot
  94
  95 (defun plot-ex ()
  96   (plsdev *gdev*)
  97   (plinit)
  98   (plcol0 1)
  99   (plwid 2)
 100   (plenv 0 6 0 36 0 0)
 101   (plcol0 2)
 102   (pllab "(x)" "(y)" "y = x#u2")
 103   (let ((xs (my-make-array 6))
 104         (ys (my-make-array 6))
 105         (x (my-make-array 60))
 106         (y (my-make-array 60)))
 107     (dotimes (i 6)
 108       (setf (aref xs i) i)
 109       (setf (aref ys i) (* i i)))
 110     (plcol0 4)
 111     (plpoin xs ys 9)
 112     (dotimes (i 60)
 113       (let ((tmp (* 0.1 i)))
 114         (setf (aref x i) tmp)
 115         (setf (aref y i) (* tmp tmp))))
 116     (plcol0 3)
 117     (plline x y))
 118   (plend))
 119
 120 ;; (plot-ex)
 121
 122 ;; Contour plot of data
 123
 124 (defun contour-plot-ex ()
 125   (plsdev *gdev*)
 126   (plinit)
 127   (plenv 0 34 0 44 0 0)
 128   (plcont (example-matrix 35 45 #'example-func-1) 1 35 1 45 (make-levels 20 -1.0 1.0))
 129   (plcol0 1)
 130   (plbox "bcnst" 0 0 "bcnstv" 0 0)
 131   (plcol0 2)
 132   (pllab "x" "y" "Contour Plot (Data)")
 133   (plend))
 134
 135 #+nil
 136 (progn
 137   (contour-plot-ex))
 138
 139 ;; Contour plot of a function
 140
 141 (defun fn-contour-plot-ex ()
 142   (plsdev *gdev*)
 143   (plinit)
 144   (plenv 0 34 0 44 0 0)
 145   (pl-set-feval-fn
 146    #'(lambda (x y p)
 147        (declare (ignore p))
 148        (coerce (example-func-1 (1- (/ x 17))
 149                                (1- (/ y 22)))
 150                'double-float)))
 151   (plfcont (pl-null-pointer) 35 45 1 35 1 45 (make-levels 20 -1.0 1.0))
 152   (pl-reset-feval-fn)
 153   (plcol0 1)
 154   (plbox "bcnst" 0 0 "bcnstv" 0 0)
 155   (plcol0 2)
 156   (pllab "x" "y" "Contour Plot (Function)")
 157   (plend))
 158
 159 #+nil(fn-contour-plot-ex)
 160 ;; Shade plot
 161
 162 (defun shade-plot-ex ()
 163   (plsdev *gdev*)
 164   (plinit)
 165   (plenv -1 1 -1 1 0 0)
 166   (plshades (example-matrix 35 45 #'example-func-1) -1 1 -1 1 (make-levels 20 -1.0 1.0) 2 1 1 nil)
 167   (plcol0 1)
 168   (plbox "bcnst" 0 0 "bcnstv" 0 0)
 169   (plcol0 2)
 170   (pllab "x" "y" "Shade Plot")
 171   (plend))
 172
 173 #+nil(shade-plot-ex)
 174
 175
 176 ;; 3D surface plot. Also demonstrates 3D text labeling.
 177
 178 (defun 3D-plot-ex ()
 179   (plsdev *gdev*)
 180   (plinit)
 181   (pladv 0)
 182   (plvpor 0 1 0 0.9)
 183   (plwind -1 1 -0.9 1.1)
 184   (plscmap1n 256)
 185   (plscmap1l 1 (vector 0.0 1.0) (vector 0.2 1) (vector 0.2 1) (vector 0.2 1) (vector nil nil))
 186   (plw3d 1 1 1 -1.5 1.5 -0.5 1.5 -5 6.5 60 30)
 187   (plmtex "t" 1 0.5 0.5 "3D plot example")
 188   (plbox3 "bnstu" "x axis" 0 0 "bnstu" "y axis" 0 0 "bcdmnst" "" 0 0)
 189   (plmtex3 "zpv" 3.0 0.5 0.5 "z axis")
 190   (plptex3 0.0 -0.4 -0.5 1.0 0.0 0.0 0.0 0.0 1.0 0.5 "Surface")
 191   (plsurf3d (make-levels 40 -1.5 1.5) (make-levels 40 -1.5 1.5) (example-matrix 40 40 #'example-func-2) 0 (make-levels 2 -1 1))
 192   (plend))
 193
 194 #+nil(3d-plot-ex)
 195
 196 ;; Unicode labels, a nice feature of plplot.
 197 ;;
 198 ;; The escape sequence #[..] tells plplot to expect a unicode character
 199 ;; code point. You can also pass in a utf-8 encoded string, but depending
 200 ;; on how your lisp deals with the arrays of type 'character this may
 201 ;; or may not work.
 202 ;;
 203 ;; YMMV depending on the capabilities of the driver itself and of the
 204 ;; fonts that are available to the driver.
 205
 206 (defun unicode ()
 207   (plsdev *gdev*)
 208   (plinit)
 209   (pladv 0)
 210   (plvpor 0 1 0 1)
 211   (plwind 0 1 0 1)
 212   (plschr 0 4)
 213   (plptex 0.5 0.5 1.0 0.0 0.5 "Has#[238]t#[238]")
 214   (plend))
 215
 216 #+nil(unicode)
 217
 218
 219 ;;;;
 220 ;;;; Copyright (c) 2006 Hazen P. Babcock
 221 ;;;;
 222 ;;;; Permission is hereby granted, free of charge, to any person obtaining a copy
 223 ;;;; of this software and associated documentation files (the "Software"), to
 224 ;;;; deal in the Software without restriction, including without limitation the
 225 ;;;; rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
 226 ;;;; sell copies of the Software, and to permit persons to whom the Software is
 227 ;;;; furnished to do so, subject to the following conditions:
 228 ;;;;
 229 ;;;; The above copyright notice and this permission notice shall be included in
 230 ;;;; all copies or substantial portions of the Software.
 231 ;;;;
 232 ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 233 ;;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 234 ;;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 235 ;;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 236 ;;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
 237 ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
 238 ;;;; IN THE SOFTWARE.
 239 ;;;;
 240
 241