[CM] plot.cl (from dlocsig)
andersvi@extern.uio.no
andersvi@extern.uio.no
Mon, 05 Jun 2006 13:41:34 +0200
--=-=-=
There are various plotting packages for cm lying around.
Heres my favorite - a very simple, but effective gnuplot-based
one. I find i use it all the time, needing nothing but gnuplot
set up. The code below is set up to run with sbcl as well as the
others.
I havent set up with any schemes here. Maybe someone has some
time to spare. Its a matter of redefining #'open-plot and
#'close-plot to whatever calls are used to manage
processes/shells by the implementation.
> (plot-data (loop repeat 100 collect (random 1.0)))
> (plot-2d-curve '(0 0 1 1 8 0.7 10 0))
> (plot-2d-curves (list '(0 0 .1 1 .8 0.7 1 0) '(0 1 1 0)))
> (plot-3d-curve (loop repeat 7
for x = (between -1.0 1.0)
for y = (between -1.0 1.0)
for z = (between -1.0 1.0)
append (list x y z))
:style "lp")
--=-=-=
Content-Type: application/octet-stream
Content-Disposition: attachment; filename=plot.cl
Content-Description: plot-functions from dlocsig.lisp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; GnuPlot based plotting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :cm)
(defvar plot-stream nil)
(defvar plot-error nil)
(defvar plot-pid nil)
;;; Open a connection to a gnuplot process
#+excl (defun open-plot ()
(multiple-value-bind (input error pid)
(excl:run-shell-command "gnuplot"
:wait nil
:input :stream
:error-output :output)
(setf plot-stream input
plot-error error
plot-pid pid)))
;;; Close and terminate gnuplot
#+excl (defun close-plot ()
(when plot-stream
(format plot-stream "quit~%")
(close plot-stream)
(setf plot-stream nil)
(multiple-value-bind (status pid)
(sys:os-wait)
(declare (ignore status pid)))))
#+cmu (defun open-plot ()
(let ((*process* (ext:run-program "gnuplot" nil
:wait nil
:input :stream
:error :output)))
(setf *plot-process* *process*
plot-stream (ext:process-input *process*)
plot-error (ext:process-error *process*)
plot-pid (ext:process-pid *process*))))
#+cmu (defun close-plot ()
(when plot-stream
(format plot-stream "quit~%")
(ext:process-close *plot-process*)
(ext:process-wait *plot-process*)))
#+sbcl (defun open-plot ()
(let ((*process* (sb-ext:run-program "/usr/bin/gnuplot" nil
:wait nil
:input :stream
:error :output)))
(setf *plot-process* *process*
plot-stream (sb-ext:process-input *process*)
plot-error (sb-ext:process-error *process*)
plot-pid (sb-ext:process-pid *process*))))
#+sbcl (defun close-plot ()
(when plot-stream
(format plot-stream "quit~%")
(close plot-stream)
(setf plot-stream nil)))
#+mcl (defun open-plot ()
(let ((*process*
(ccl:run-program "gnuplot" (list "-noraise")
:wait nil
:input :stream
:error :output)))
(setf *plot-process* *process*
plot-stream (ccl:external-process-input-stream *process*)
plot-error (ccl:external-process-error-stream *process*)
plot-pid (ccl:external-process-id *process*))))
#+mcl (defun close-plot ()
(when plot-stream
(format plot-stream "quit~%")
(close plot-stream)
(setf plot-stream nil)))
;;; Send an arbitrary command to gnuplot
(defun plot-command (&optional (command ""))
(if (not plot-stream)
(open-plot))
(format plot-stream command)
(format plot-stream "~%")
(finish-output plot-stream))
;;; Reset all 'set' options to the default values
(defun plot-reset ()
(plot-command "reset"))
;;; Set autoscale for selected axes
(defun plot-set-autoscale ()
(if (not plot-stream)
(open-plot))
(format plot-stream "set autoscale~%")
(finish-output plot-stream))
;;; Set x range
(defun plot-set-x-range (range)
(if (not plot-stream)
(open-plot))
(when range
(format plot-stream "set xrange [~f:~f]~%"
(first range)(second range))
(finish-output plot-stream)))
;;; Set y range
(defun plot-set-y-range (range)
(if (not plot-stream)
(open-plot))
(when range
(format plot-stream "set yrange [~f:~f]~%"
(first range)(second range))
(finish-output plot-stream)))
;;; Set z range
(defun plot-set-z-range (range)
(if (not plot-stream)
(open-plot))
(when range
(format plot-stream "set zrange [~f:~f]~%"
(first range)(second range))
(finish-output plot-stream)))
;;; Set grid
(defun plot-set-grid ()
(if (not plot-stream)
(open-plot))
(format plot-stream "set grid xtics; set grid ytics; set grid ztics~%")
(finish-output plot-stream))
;;; Set surface
(defun plot-set-surface ()
(if (not plot-stream)
(open-plot))
(format plot-stream "set surface~%")
(finish-output plot-stream))
;;; Set parametric mode
(defun plot-set-parametric ()
(if (not plot-stream)
(open-plot))
(format plot-stream "set parametric~%")
(finish-output plot-stream))
;;; Set ticslevel
(defun plot-set-ticslevel (&optional (level 0))
(if (not plot-stream)
(open-plot))
(format plot-stream "set ticslevel ~s~%" level)
(finish-output plot-stream))
;;; Set title
(defun plot-set-title (&optional
(title nil))
(if (not plot-stream)
(open-plot))
(when title
(format plot-stream "set title ~s~%" title)
(finish-output plot-stream)))
;;; Set the labels for a plot
(defun plot-set-label (&optional
(label nil))
(if (not plot-stream)
(open-plot))
(when label
(format plot-stream "set label ~s~%" label)
(finish-output plot-stream)))
;;; Set the margins of a plot
(defun plot-set-margins (&optional
(margin 1))
(if (not plot-stream)
(open-plot))
(when margin
(format plot-stream "set tmargin ~s~%" margin)
(format plot-stream "set lmargin ~s~%" margin)
(format plot-stream "set rmargin ~s~%" margin)
(format plot-stream "set bmargin ~s~%" margin)
(finish-output plot-stream)))
;;; Set the borders of a plot
(defun plot-set-border (&optional
(border nil))
(if (not plot-stream)
(open-plot))
(when border
(format plot-stream "set border ~s~%" border)
(finish-output plot-stream)))
;;; Start a multiplot
(defun plot-start-multiplot ()
(if (not plot-stream)
(open-plot))
(format plot-stream "set multiplot~%")
(finish-output plot-stream))
;;; End a multiplot
(defun plot-end-multiplot ()
(if (not plot-stream)
(open-plot))
(format plot-stream "set nomultiplot~%")
(finish-output plot-stream))
;;; Set origin and size of plot area
(defun plot-size (xorigin yorigin xsize ysize)
(if (not plot-stream)
(open-plot))
(format plot-stream "set origin ~s,~s~%"
(coerce xorigin 'float)
(coerce yorigin 'float))
(format plot-stream "set size ~s,~s~%"
(coerce xsize 'float)
(coerce ysize 'float))
(finish-output plot-stream))
;;; Simple data plot
(defun plot-data (data
&key
(style "linespoints")
(label ""))
(if (not plot-stream)
(open-plot))
(plot-set-grid)
(format plot-stream "plot '-'")
(if label
(format plot-stream " title ~s" label))
(if style
(format plot-stream " with ~a" style))
(format plot-stream "~%")
(loop
for x from 0
for y in data
do (format plot-stream "~f ~f~%" x y))
(format plot-stream "e~%")
(finish-output plot-stream)
data)
;; plot a list of lists of breakpoints:
(defun plot-breakpoints (curve
&key
(style "linespoints")
(label ""))
(plot-2d-curve (loop for bp in curve append bp)
:style style :label label))
;;; Plot a supplied curve
(defun plot-2d-curve (curve
&key
(style "linespoints")
(label ""))
(if (not plot-stream)
(open-plot))
(plot-set-grid)
(format plot-stream "plot '-'")
(if label
(format plot-stream " title ~s" label))
(if style
(format plot-stream " with ~a" style))
(format plot-stream "~%")
(loop
for x in curve by #'cddr
for y in (cdr curve) by #'cddr
do (format plot-stream "~f ~f~%" x y))
(format plot-stream "e~%")
(finish-output plot-stream)
curve)
;; Plot a list of supplied curves
(defun plot-2d-curves (curves
&key
(styles "linespoints")
(labels ""))
(if (not plot-stream)
(open-plot))
(plot-set-grid)
(if (not (listp styles))
(setf styles (loop repeat (length curves)
collect styles)))
(if (not (listp labels))
(setf labels (loop repeat (length curves)
collect labels)))
(format plot-stream "plot")
(loop
for index from 0
for style in styles
for label in labels do
(format plot-stream " '-' ")
(if label
(format plot-stream " title ~s" label))
(if style
(format plot-stream " with ~a" style))
(if (/= index (- (length curves) 1))
(format plot-stream ", ")))
(format plot-stream "~%")
(loop for curve in curves do
(loop
for x in curve by #'cddr
for y in (cdr curve) by #'cddr
do (format plot-stream "~f ~f~%" x y))
(format plot-stream "e~%"))
(finish-output plot-stream)
curves)
;;; Plot a 3d curve
(defun plot-3d-curve (3d-curve
&key
(style "linespoints")
(label "")
(zstyle "impulses")
(xrot)
(zrot)
(scale)
(zscale))
(if (not plot-stream)
(open-plot))
(plot-set-border (+ 127 256 512))
(plot-set-grid)
(plot-set-surface)
(plot-set-parametric)
(plot-set-ticslevel 0)
(if (or xrot zrot scale zscale)
(format plot-stream "set view ~a,~a,~a,~a~%"
(if xrot xrot "")
(if zrot zrot "")
(if scale scale "")
(if zscale zscale "")))
(format plot-stream "splot '-'")
(if label
(format plot-stream " title ~s" label))
(if style
(format plot-stream " with ~a 1" style))
(if zstyle
(format plot-stream ", '-' notitle with ~a 1" zstyle))
(format plot-stream "~%")
(loop
for x in 3d-curve by #'cdddr
for y in (cdr 3d-curve) by #'cdddr
for z in (cddr 3d-curve) by #'cdddr do
(format plot-stream "~f ~f ~f~%" x y z))
(format plot-stream "e~%")
(if zstyle (loop
for x in 3d-curve by #'cdddr
for y in (cdr 3d-curve) by #'cdddr
for z in (cddr 3d-curve) by #'cdddr do
(format plot-stream "~f ~f ~f~%" x y z)
finally (format plot-stream "e~%")))
(finish-output plot-stream)
3d-curve)
--=-=-=--