├── docs └── img │ ├── clgp01.png │ ├── clgp02-2.png │ ├── clgp02.png │ ├── clgp03.png │ ├── clgp04.png │ ├── clgp05.png │ ├── clgp06.png │ ├── clgp09.png │ ├── multiplot.png │ ├── clgp-output2.png │ └── clgp-splot1.png ├── .gitignore ├── t └── clgplot.lisp ├── clgplot-test.asd ├── clgplot.asd ├── LICENCE.txt ├── README.org ├── example.lisp └── src └── clgplot.lisp /docs/img/clgp01.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/masatoi/clgplot/HEAD/docs/img/clgp01.png -------------------------------------------------------------------------------- /docs/img/clgp02-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/masatoi/clgplot/HEAD/docs/img/clgp02-2.png -------------------------------------------------------------------------------- /docs/img/clgp02.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/masatoi/clgplot/HEAD/docs/img/clgp02.png -------------------------------------------------------------------------------- /docs/img/clgp03.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/masatoi/clgplot/HEAD/docs/img/clgp03.png -------------------------------------------------------------------------------- /docs/img/clgp04.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/masatoi/clgplot/HEAD/docs/img/clgp04.png -------------------------------------------------------------------------------- /docs/img/clgp05.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/masatoi/clgplot/HEAD/docs/img/clgp05.png -------------------------------------------------------------------------------- /docs/img/clgp06.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/masatoi/clgplot/HEAD/docs/img/clgp06.png -------------------------------------------------------------------------------- /docs/img/clgp09.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/masatoi/clgplot/HEAD/docs/img/clgp09.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* -------------------------------------------------------------------------------- /docs/img/multiplot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/masatoi/clgplot/HEAD/docs/img/multiplot.png -------------------------------------------------------------------------------- /docs/img/clgp-output2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/masatoi/clgplot/HEAD/docs/img/clgp-output2.png -------------------------------------------------------------------------------- /docs/img/clgp-splot1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/masatoi/clgplot/HEAD/docs/img/clgp-splot1.png -------------------------------------------------------------------------------- /t/clgplot.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage clgplot-test 3 | (:use :cl 4 | :clgplot 5 | :prove)) 6 | (in-package :clgplot-test) 7 | 8 | ;; NOTE: To run this test file, execute `(asdf:test-system :clgplot)' in your Lisp. 9 | 10 | (plan nil) 11 | 12 | ;; blah blah blah. 13 | 14 | (finalize) 15 | -------------------------------------------------------------------------------- /clgplot-test.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of clgplot project. 3 | |# 4 | 5 | (in-package :cl-user) 6 | (defpackage clgplot-test-asd 7 | (:use :cl :asdf)) 8 | (in-package :clgplot-test-asd) 9 | 10 | (defsystem clgplot-test 11 | :author "" 12 | :license "" 13 | :depends-on (:clgplot 14 | :prove) 15 | :components ((:module "t" 16 | :components 17 | ((:test-file "clgplot")))) 18 | :description "Test system for clgplot" 19 | 20 | :defsystem-depends-on (:prove-asdf) 21 | :perform (test-op :after (op c) 22 | (funcall (intern #.(string :run-test-system) :prove-asdf) c) 23 | (asdf:clear-system c))) 24 | -------------------------------------------------------------------------------- /clgplot.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of clgplot project. 3 | |# 4 | 5 | (in-package :cl-user) 6 | (defpackage clgplot-asd 7 | (:use :cl :asdf)) 8 | (in-package :clgplot-asd) 9 | 10 | (defsystem clgplot 11 | :version "0.2" 12 | :author "Satoshi Imai" 13 | :license "MIT Licence" 14 | :depends-on (:uiop :iterate) 15 | :components ((:module "src" 16 | :components 17 | ((:file "clgplot")))) 18 | :description "A Gnuplot front-end for Common lisp" 19 | :long-description 20 | #.(with-open-file (stream (merge-pathnames 21 | #p"README.org" 22 | (or *load-pathname* *compile-file-pathname*)) 23 | :if-does-not-exist nil 24 | :direction :input) 25 | (when stream 26 | (let ((seq (make-array (file-length stream) 27 | :element-type 'character 28 | :fill-pointer t))) 29 | (setf (fill-pointer seq) (read-sequence seq stream)) 30 | seq))) 31 | :in-order-to ((test-op (test-op clgplot-test)))) 32 | -------------------------------------------------------------------------------- /LICENCE.txt: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Satoshi Imai 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in 13 | all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 21 | THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | * clgplot 2 | clgplot is a Gnuplot front-end on Common Lisp. 3 | 4 | ** Dependencies 5 | Gnuplot (>4) 6 | 7 | ** Installation 8 | #+BEGIN_SRC sh 9 | cd ~/quicklisp/local-projects 10 | git clone https://github.com/masatoi/clgplot.git 11 | #+END_SRC 12 | 13 | In case of using Roswell, simply 14 | #+BEGIN_SRC sh 15 | ros install masatoi/clgplot 16 | #+END_SRC 17 | 18 | #+BEGIN_SRC lisp 19 | (ql:quickload :clgplot) 20 | #+END_SRC 21 | 22 | ** Usage 23 | clgplot generates a data file and a setting file of Gnuplot to tmp directory and execute Gnuplot with -persist option. 24 | Paths to these files or command can be changed as below. 25 | #+BEGIN_SRC lisp 26 | (defparameter clgp:*gnuplot-path* "gnuplot") 27 | (defparameter clgp:*tmp-dat-file* "/tmp/clgplot-tmp.dat") 28 | (defparameter clgp:*tmp-gp-file* "/tmp/clgplot-tmp.gp") 29 | #+END_SRC 30 | 31 | *** Plot of single function 32 | #+BEGIN_SRC lisp 33 | (defparameter *x-list* (loop for i from (- pi) to pi by 0.1 collect i)) 34 | 35 | (clgp:plot (mapcar #'sin *x-list*)) 36 | #+END_SRC 37 | 38 | [[./docs/img/clgp01.png]] 39 | 40 | Plots can be output to a file as follows. 41 | 42 | #+begin_src lisp 43 | (clgp:plot (mapcar #'sin *x-list*) :output "/path/to/file.png") 44 | (clgp:plot (mapcar #'sin *x-list*) :output "/path/to/file.png" :output-format :png) 45 | (clgp:plot (mapcar #'sin *x-list*) :output "/path/to/file.pdf" :output-format :pdf) 46 | (clgp:plot (mapcar #'sin *x-list*) :output "/path/to/file.eps" :output-format :eps) 47 | #+end_src 48 | 49 | *** Plot of multiple functions with annotations 50 | #+BEGIN_SRC lisp 51 | (clgp:plots (list (mapcar #'sin *x-list*) 52 | (mapcar #'cos *x-list*) 53 | (mapcar #'tan *x-list*)) 54 | :x-seqs (list *x-list* *x-list* *x-list*) 55 | :x-range (list (- pi) pi) 56 | :y-range '(-1 1) 57 | :title-list '("sin" "cos" "tan") 58 | :x-label "x" 59 | :y-label "f(x)") 60 | #+END_SRC 61 | 62 | [[./docs/img/clgp02.png]] 63 | 64 | #+begin_src lisp 65 | (let* ((rand-x-list (loop repeat 100 collect (- (random (* 2 pi)) pi))) 66 | (rand-y-list (mapcar (lambda (x) (+ (sin x) (random-normal :sd 0.1d0))) rand-x-list))) 67 | (clgp:plots (list (mapcar #'sin *x-list*) 68 | rand-y-list) 69 | :x-seqs (list *x-list* rand-x-list) 70 | :style '(line point))) 71 | #+end_src 72 | 73 | [[./docs/img/clgp02-2.png]] 74 | 75 | *** 3D plot examples 76 | #+BEGIN_SRC lisp 77 | (clgp:splot (lambda (x y) (+ (sin x) (cos y))) 78 | *x-list* ; x 79 | *x-list* ; y 80 | :view-point '(20 45) :z-scale 1.5) 81 | #+END_SRC 82 | 83 | [[./docs/img/clgp03.png]] 84 | 85 | #+BEGIN_SRC lisp 86 | (clgp:splot (lambda (x y) (+ (sin x) (cos y))) 87 | *x-list* ; x 88 | *x-list* ; y 89 | :map t) 90 | #+END_SRC 91 | 92 | [[./docs/img/clgp04.png]] 93 | 94 | *** Plot matrix (2-dimensional array) 95 | 96 | #+begin_src lisp 97 | (defparameter mat 98 | (make-array '(20 20) 99 | :initial-contents 100 | (loop for i from (- pi) to (- pi 0.1) by (/ pi 10) collect 101 | (loop for j from (- pi) to (- pi 0.1) by (/ pi 10) collect 102 | (+ (sin i) (cos j)))))) 103 | 104 | (clgp:splot-matrix mat) 105 | #+end_src 106 | 107 | [[./docs/img/clgp05.png]] 108 | 109 | *** Histogram 110 | 111 | #+begin_src lisp 112 | (defun random-normal (&key (mean 0d0) (sd 1d0)) 113 | (let ((alpha (random 1.0d0)) 114 | (beta (random 1.0d0))) 115 | (+ (* sd 116 | (sqrt (* -2 (log alpha))) 117 | (sin (* 2 pi beta))) 118 | mean))) 119 | 120 | (clgp:plot-histogram (loop repeat 3000 collect (random-normal)) ; samples 121 | 30 ; number of bin 122 | ) 123 | #+end_src 124 | 125 | [[./docs/img/clgp06.png]] 126 | 127 | *** Multiplot 128 | 129 | #+begin_src lisp 130 | (clgp:multiplot (:layout (2 2) :output "/tmp/multiplot.png" :output-format :png) 131 | (clgp:plot (mapcar #'sin *x-list*) :style 'lines :key nil) 132 | (clgp:plot (mapcar #'sin *x-list*) :style 'points :key nil) 133 | (clgp:plot (mapcar #'sin *x-list*) :style 'impulses :key nil) 134 | (clgp:plots (list (mapcar #'sin *x-list*) 135 | (mapcar #'cos *x-list*) 136 | (mapcar #'tan *x-list*)) 137 | :x-seqs (list *x-list* *x-list* *x-list*) 138 | :x-range (list (- pi) pi) 139 | :y-range '(-1 1) 140 | :key nil)) 141 | #+end_src 142 | 143 | [[./docs/img/multiplot.png]] 144 | 145 | ** Author 146 | Satoshi Imai (satoshi.imai@gmail.com) 147 | 148 | ** License 149 | The MIT license 150 | -------------------------------------------------------------------------------- /example.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- coding:utf-8; mode:lisp -*- 2 | 3 | (ql:quickload :clgplot) 4 | 5 | ;; Plot line 6 | (clgp:plot '(1 2 3)) 7 | 8 | ;; Plot sin function 9 | (defparameter *x-list* (loop for i from (- pi) to pi by 0.1 collect i)) 10 | 11 | (clgp:plot (mapcar #'sin *x-list*)) 12 | 13 | ;; Specify x values 14 | (clgp:plot (mapcar #'sin *x-list*) :x-seq *x-list*) 15 | 16 | ;; Plot multiple functions 17 | (clgp:plots (list (mapcar #'sin *x-list*) 18 | (mapcar #'cos *x-list*)) 19 | :x-seqs (list *x-list* *x-list*)) 20 | 21 | ;; Add tan 22 | (clgp:plots (list (mapcar #'sin *x-list*) 23 | (mapcar #'cos *x-list*) 24 | (mapcar #'tan *x-list*)) 25 | :x-seqs (list *x-list* *x-list* *x-list*)) 26 | 27 | ;; Add domain 28 | (clgp:plots (list (mapcar #'sin *x-list*) 29 | (mapcar #'cos *x-list*) 30 | (mapcar #'tan *x-list*)) 31 | :x-seqs (list *x-list* *x-list* *x-list*) 32 | :x-range (list (- pi) pi) 33 | :y-range '(-1 1)) 34 | 35 | ;; Add caption of axis 36 | (clgp:plots (list (mapcar #'sin *x-list*) 37 | (mapcar #'cos *x-list*) 38 | (mapcar #'tan *x-list*)) 39 | :x-seqs (list *x-list* *x-list* *x-list*) 40 | :x-range (list (- pi) pi) 41 | :y-range '(-1 1) 42 | :title-list '("sin" "cos" "tan") 43 | :x-label "x" 44 | :y-label "f(x)") 45 | 46 | ;; Output to PNG file 47 | (clgp:plots (list (mapcar #'sin *x-list*) 48 | (mapcar #'cos *x-list*) 49 | (mapcar #'tan *x-list*)) 50 | :x-seqs (list *x-list* *x-list* *x-list*) 51 | :x-range (list (- pi) pi) 52 | :y-range '(-1 1) 53 | :title-list '("sin" "cos" "tan") 54 | :x-label "x" 55 | :y-label "f(x)" 56 | :output #P"/home/wiz/tmp/clgp-output2.png") 57 | 58 | ;; Other format 59 | (clgp:plots (list (mapcar #'sin *x-list*) 60 | (mapcar #'cos *x-list*) 61 | (mapcar #'tan *x-list*)) 62 | :x-seqs (list *x-list* *x-list* *x-list*) 63 | :x-range (list (- pi) pi) 64 | :y-range '(-1 1) 65 | :title-list '("sin" "cos" "tan") 66 | :x-label "x" 67 | :y-label "f(x)" 68 | ;; :PDF :EPS :EPS-MONOCHROME :PNG :PNG-1280X1024 :PNG-2560X1024 :PNG-MONOCHROME 69 | :output-format :eps-monochrome 70 | :output "/home/wiz/tmp/clgp-output.eps") 71 | 72 | ;; splot 73 | (clgp:splot (lambda (x y) (+ (sin x) (cos y))) 74 | *x-list* ; x 75 | *x-list* ; y 76 | ) 77 | 78 | ;; splot from another view point 79 | (clgp:splot (lambda (x y) (+ (sin x) (cos y))) 80 | *x-list* ; x 81 | *x-list* ; y 82 | :view-point '(20 45) :z-scale 1.5) 83 | 84 | ;; splot map 85 | (clgp:splot (lambda (x y) (+ (sin x) (cos y))) 86 | *x-list* ; x 87 | *x-list* ; y 88 | :map t) 89 | 90 | ;; splot-matrix 91 | (defparameter mat 92 | (make-array '(20 20) 93 | :initial-contents 94 | (loop for i from (- pi) to (- pi 0.1) by (/ pi 10) collect 95 | (loop for j from (- pi) to (- pi 0.1) by (/ pi 10) collect 96 | (+ (sin i) (cos j)))))) 97 | 98 | (clgp:splot-matrix mat) 99 | 100 | ;; Histogram 101 | 102 | ;; Random sampling by Box-Muller method 103 | (defun random-normal (&key (mean 0d0) (sd 1d0)) 104 | (let ((alpha (random 1.0d0)) 105 | (beta (random 1.0d0))) 106 | (+ (* sd 107 | (sqrt (* -2 (log alpha))) 108 | (sin (* 2 pi beta))) 109 | mean))) 110 | 111 | (clgp:plot-histogram (loop repeat 3000 collect (random-normal)) ; samples 112 | 30 ; number of bin 113 | ) 114 | 115 | ;; Plot samples with probability density function 116 | (defun pdf-normal (x &key (mu 0) (sd 1)) 117 | (flet ((square (x) (* x x))) 118 | (/ (exp (- (/ (square (/ (- x mu) sd)) 2))) 119 | (* (sqrt (* 2 pi)) sd)))) 120 | 121 | (clgp:plot-histogram-with-pdf (loop repeat 3000 collect (random-normal)) ; samples 122 | 30 ; number of bin 123 | #'pdf-normal) 124 | 125 | ;; Style 126 | (clgp:plot (mapcar #'sin *x-list*) :style 'lines) 127 | (clgp:plot (mapcar #'sin *x-list*) :style 'points) 128 | (clgp:plot (mapcar #'sin *x-list*) :style 'impulses) 129 | 130 | ;; Multiple styles 131 | (let* ((rand-x-list (loop repeat 100 collect (- (random (* 2 pi)) pi))) 132 | (rand-y-list (mapcar (lambda (x) (+ (sin x) (random-normal :sd 0.1d0))) rand-x-list))) 133 | (clgp:plots (list (mapcar #'sin *x-list*) 134 | rand-y-list) 135 | :x-seqs (list *x-list* rand-x-list) 136 | :style '(line point))) 137 | 138 | ;; Multiplot 139 | (clgp:multiplot () 140 | (clgp:plot (mapcar #'sin *x-list*) :style 'lines) 141 | (clgp:plot (mapcar #'sin *x-list*) :style 'points) 142 | (clgp:plot (mapcar #'sin *x-list*) :style 'impulses)) 143 | 144 | (clgp:multiplot (:layout (2 2) :output "/tmp/multiplot.png" :output-format :png) 145 | (clgp:plot (mapcar #'sin *x-list*) :style 'lines :key nil) 146 | (clgp:plot (mapcar #'sin *x-list*) :style 'points :key nil) 147 | (clgp:plot (mapcar #'sin *x-list*) :style 'impulses :key nil) 148 | (clgp:plots (list (mapcar #'sin *x-list*) 149 | (mapcar #'cos *x-list*) 150 | (mapcar #'tan *x-list*)) 151 | :x-seqs (list *x-list* *x-list* *x-list*) 152 | :x-range (list (- pi) pi) 153 | :y-range '(-1 1) 154 | :key nil)) 155 | -------------------------------------------------------------------------------- /src/clgplot.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Coding: utf-8; Mode: Lisp -*- 2 | 3 | (in-package :cl-user) 4 | (defpackage :clgplot 5 | (:use #:cl 6 | #:iter) 7 | (:nicknames :clgp) 8 | (:export #:*gnuplot-path* 9 | #:*tmp-dat-file* 10 | #:*tmp-gp-file* 11 | #:*default-terminal* 12 | #:seq 13 | #:plot 14 | #:plots 15 | #:plot-histogram 16 | #:plot-histogram-with-pdf 17 | #:splot-list 18 | #:splot 19 | #:splot-matrix 20 | #:multiplot)) 21 | 22 | (in-package :clgplot) 23 | 24 | (defparameter *gnuplot-path* "gnuplot") 25 | (defparameter *tmp-dat-file* "/tmp/clgplot-tmp.dat") 26 | (defparameter *tmp-gp-file* "/tmp/clgplot-tmp.gp") 27 | (defparameter *default-terminal* 28 | (cond ((member :linux cl:*features*) "x11") 29 | ((member :darwin cl:*features*) "qt") 30 | ((member :windows cl:*features*) "windows") 31 | (t "x11"))) 32 | 33 | ;;; Utilities 34 | 35 | ;; named-let 36 | (defmacro nlet (tag var-vals &body body) 37 | `(labels ((,tag ,(mapcar #'car var-vals) ,@body)) 38 | (,tag ,@(mapcar #'cadr var-vals)))) 39 | 40 | (defun last1 (lst) 41 | (car (last lst))) 42 | 43 | (defun seq (start end &optional (by 1)) 44 | (loop for x from start to end by by collect x)) 45 | 46 | ;;; 47 | 48 | (defun run () 49 | (uiop:run-program `(,*gnuplot-path* "-persist" ,*tmp-gp-file*))) 50 | 51 | (defun dump-gp-stream (stream plot-arg-format 52 | &key (x-label nil) (y-label nil) 53 | (main nil) 54 | (aspect-ratio 1.0) 55 | (output nil) (output-format :png) 56 | (x-logscale nil) (y-logscale nil) 57 | (x-range nil) (y-range nil) 58 | (x-range-reverse nil) (y-range-reverse nil) (key t)) 59 | ;; Setting for Output to file 60 | (cond (output 61 | (ecase output-format 62 | (:pdf (format stream "set term pdf~%")) 63 | (:eps (format stream "set term postscript eps enhanced color~%")) 64 | (:eps-monochrome (format stream "set term postscript eps enhanced monochrome~%")) 65 | (:png-400x320 (format stream "set term png size 400,320~%")) 66 | (:png (format stream "set term png~%")) 67 | (:png-640x480 (format stream "set term png~%")) 68 | (:png-1280x1024 (format stream "set term png size 1280,1024~%")) 69 | (:png-2560x1024 (format stream "set term png size 2560,1024~%")) 70 | (:png-monochrome (format stream "set term png monochrome~%"))) 71 | (format stream "set output \"~A\"~%" output)) 72 | (t (format stream "set term ~A~%" *default-terminal*))) 73 | ;; Main title 74 | (when main (format stream "set title \"~A\"~%" main)) 75 | ;; Axis label 76 | (if x-label (format stream "set xlabel \"~A\"~%" x-label)) 77 | (if y-label (format stream "set ylabel \"~A\"~%" y-label)) 78 | ;; Input range, Increase direction of X 79 | (if x-range 80 | (format stream "set xrange [~f:~f] " (car x-range) (cadr x-range)) 81 | (format stream "set xrange [] ")) 82 | (if x-range-reverse 83 | (format stream "reverse")) 84 | (format stream "~%") 85 | (if y-range 86 | (format stream "set yrange [~f:~f] " (car y-range) (cadr y-range)) 87 | (format stream "set yrange [] ")) 88 | (if y-range-reverse 89 | (format stream "reverse")) 90 | (format stream "~%") 91 | ;; Use of logscale 92 | (if x-logscale 93 | (if (and (integerp x-logscale) (> x-logscale 0)) 94 | (format stream "set logscale x ~A~%" x-logscale) 95 | (format stream "set logscale x~%"))) 96 | (if y-logscale 97 | (if (and (integerp y-logscale) (> y-logscale 0)) 98 | (format stream "set logscale y ~A~%" y-logscale) 99 | (format stream "set logscale y~%"))) 100 | ;; Aspect ratio 101 | (if aspect-ratio (format stream "set size ratio ~f~%" aspect-ratio)) 102 | ;; Graph legend enable/disable, or its position 103 | (if key 104 | (format stream "set key~%") 105 | (format stream "set nokey~%")) 106 | 107 | (format stream (concatenate 'string "plot " plot-arg-format))) 108 | 109 | (defun dump-gp-file (plot-arg-format 110 | &key (x-label nil) (y-label nil) 111 | (main nil) 112 | (aspect-ratio 1.0) 113 | (output nil) (output-format :png) 114 | (x-logscale nil) (y-logscale nil) 115 | (x-range nil) (y-range nil) 116 | (x-range-reverse nil) (y-range-reverse nil) (key t)) 117 | (with-open-file (gp-file *tmp-gp-file* :direction :output :if-exists :supersede) 118 | (dump-gp-stream gp-file plot-arg-format 119 | :x-label x-label :y-label y-label 120 | :main main 121 | :aspect-ratio aspect-ratio 122 | :output output :output-format output-format 123 | :x-logscale x-logscale :y-logscale y-logscale 124 | :x-range x-range :y-range y-range 125 | :x-range-reverse x-range-reverse :y-range-reverse y-range-reverse :key key))) 126 | 127 | (defun appropriate-style-p (style) 128 | (and (symbolp style) 129 | (member (symbol-name style) 130 | '(lines line points point impulses impulse) 131 | :key #'symbol-name :test #'equal))) 132 | 133 | (defun plot (y-seq 134 | &key (x-seq nil) (title " ") (style 'lines) 135 | (x-label nil) (y-label nil) 136 | (main nil) (aspect-ratio 1.0) 137 | (output nil) (output-format :png) 138 | (x-logscale nil) (y-logscale nil) 139 | (x-range nil) (y-range nil) 140 | (x-range-reverse nil) (y-range-reverse nil) (key t) 141 | (stream nil)) 142 | (assert (appropriate-style-p style)) 143 | (when (null x-seq) 144 | (setf x-seq (loop for i from 0 below (length y-seq) collect i))) 145 | (unless (= (length x-seq) (length y-seq)) 146 | (error "sequence length mismatch detected between y-seq and x-seq.")) 147 | ;; Output to DAT file 148 | (with-open-file (dat-file *tmp-dat-file* :direction :output :if-exists :supersede) 149 | (iter (for x in-sequence x-seq) 150 | (for y in-sequence y-seq) 151 | (format dat-file "~f ~f~%" x y))) 152 | 153 | (let ((plot-arg-string (format nil "\"~A\" using 1:2 with ~A title \"~A\"" 154 | *tmp-dat-file* (string-downcase (string style)) title))) 155 | (if stream 156 | (progn 157 | (dump-gp-stream stream 158 | plot-arg-string 159 | :x-label x-label :y-label y-label :aspect-ratio aspect-ratio 160 | :main main :output output :output-format output-format 161 | :x-logscale x-logscale :y-logscale y-logscale 162 | :x-range x-range :y-range y-range 163 | :x-range-reverse x-range-reverse :y-range-reverse y-range-reverse 164 | :key key) 165 | (finish-output stream)) 166 | ;; Output to GP file 167 | (progn 168 | (dump-gp-file plot-arg-string 169 | :x-label x-label :y-label y-label :aspect-ratio aspect-ratio 170 | :main main :output output :output-format output-format 171 | :x-logscale x-logscale :y-logscale y-logscale 172 | :x-range x-range :y-range y-range 173 | :x-range-reverse x-range-reverse :y-range-reverse y-range-reverse 174 | :key key) 175 | ;; Call Gnuplot 176 | (run))))) 177 | 178 | (defun comma-separated-concatenate (string-list) 179 | (assert (every #'stringp string-list)) 180 | (reduce (lambda (s1 s2) (concatenate 'string s1 "," s2)) 181 | string-list)) 182 | 183 | (defun plots (y-seqs 184 | &key (x-seqs nil) (title-list nil) (style 'lines) ; style accepts symbol string and list of symbols and strings 185 | (x-label nil) (y-label nil) 186 | (main nil) (aspect-ratio 1.0) 187 | (output nil) (output-format :png) 188 | (x-logscale nil) (y-logscale nil) 189 | (x-range nil) (y-range nil) 190 | (x-range-reverse nil) (y-range-reverse nil) (key t) 191 | ;; When axis-list is nil, use x1y1 axis for all plots. 192 | ;; To use two axis: (plots (list list1 list2) :axis-list '(x1y1 x1y2)) 193 | (axis-list nil) 194 | (stream nil)) 195 | 196 | (assert (or (appropriate-style-p style) (every #'appropriate-style-p style))) 197 | 198 | (when (null x-seqs) 199 | (setf x-seqs (make-list (length y-seqs)))) 200 | 201 | (iter (for i from 0) (for y-seq in-sequence y-seqs) (for x-seq in-sequence x-seqs) 202 | (when (null x-seq) 203 | (setf x-seq (loop for i from 0 below (length y-seq) collect i))) 204 | (unless (= (length x-seq) (length y-seq)) 205 | (error "sequence length mismatch detected between y-seq and x-seq.")) 206 | 207 | ;; Output to DAT file 208 | (with-open-file (dat-file (format nil "~A.~A" *tmp-dat-file* i) 209 | :direction :output :if-exists :supersede) 210 | (iter (for x in-sequence x-seq) (for y in-sequence y-seq) 211 | (format dat-file "~f ~f~%" x y)))) 212 | 213 | (when (and (not (null axis-list)) 214 | (not (= (length y-seqs) (length axis-list)))) 215 | (error "sequence length mismatch detected between y-seqs and axis-list.")) 216 | 217 | (when (and (listp style) (not (= (length y-seqs) (length style)))) 218 | (error "list length mismatch detected between y-lists and style.")) 219 | 220 | ;; Output to GP file 221 | (let ((plot-arg-string 222 | (comma-separated-concatenate 223 | (iter (for i from 0 below (length y-seqs)) 224 | (collect 225 | (format nil "\"~A.~A\" using 1:2 with ~A title \"~A\" axis ~A" 226 | *tmp-dat-file* 227 | i 228 | (if (listp style) 229 | (string-downcase (string (nth i style))) 230 | (string-downcase (string style))) 231 | (if (null title-list) " " (nth i title-list)) 232 | (if (null axis-list) "x1y1" (string-downcase (string (nth i axis-list)))))))))) 233 | (if stream 234 | (progn (dump-gp-stream stream 235 | plot-arg-string 236 | :x-label x-label :y-label y-label :aspect-ratio aspect-ratio 237 | :main main :output output :output-format output-format 238 | :x-logscale x-logscale :y-logscale y-logscale 239 | :x-range x-range :y-range y-range 240 | :x-range-reverse x-range-reverse :y-range-reverse y-range-reverse 241 | :key key) 242 | (finish-output stream)) 243 | (progn (dump-gp-file plot-arg-string 244 | :x-label x-label :y-label y-label :aspect-ratio aspect-ratio 245 | :main main :output output :output-format output-format 246 | :x-logscale x-logscale :y-logscale y-logscale 247 | :x-range x-range :y-range y-range 248 | :x-range-reverse x-range-reverse :y-range-reverse y-range-reverse 249 | :key key) 250 | ;; Call Gnuplot 251 | (run))))) 252 | 253 | ;;; normalize list between [0,1] 254 | #+(or) 255 | (defun normalize-list (list) 256 | (let ((max-elem (loop for x in list maximize x)) 257 | (min-elem (loop for x in list minimize x))) 258 | (if (> min-elem 0) 259 | (mapcar (lambda (elem) 260 | (/ (- elem min-elem) 261 | (abs (- max-elem min-elem)))) 262 | list) 263 | (mapcar (lambda (elem) 264 | (/ (+ elem min-elem) 265 | (abs (- max-elem min-elem)))) 266 | list)))) 267 | 268 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 269 | ;;; histogram ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 270 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 271 | 272 | (defun histogram-lem1 (x a b n) 273 | "Separate interval (a,b) equally to n bins, then return index of the bin which x belongs to." 274 | (if (or (< x a) (< b x)) 275 | nil 276 | (if (= x b) 277 | (1- n) 278 | (let ((span (/ (- b a) n))) 279 | (nlet itr ((i 1)) 280 | (if (<= x (+ a (* i span))) 281 | (1- i) 282 | (itr (1+ i)))))))) 283 | 284 | (defun search-min-max (list &key (min nil) (max nil)) 285 | (cond ((null list) (values min max)) 286 | ((null min) (search-min-max (cdr list) :min (car list) :max (car list))) 287 | ((< (car list) min) (search-min-max (cdr list) :min (car list) :max max)) 288 | ((> (car list) max) (search-min-max (cdr list) :min min :max (car list))) 289 | (t (search-min-max (cdr list) :min min :max max)))) 290 | 291 | (defun plot-histogram (samples n-of-bin &key (output nil) 292 | (x-range nil) (y-range nil) 293 | (x-logscale nil) (y-logscale nil)) 294 | "Divide samples by the range width equally and count the number of samples appear in each bins." 295 | (multiple-value-bind (a b) 296 | (search-min-max samples) 297 | (let ((counter (make-list n-of-bin :initial-element 0)) 298 | (span (/ (- b a) n-of-bin))) 299 | ;; Counting 300 | (dolist (x samples) 301 | (let ((bin (histogram-lem1 x a b n-of-bin))) 302 | (if bin (incf (nth bin counter))))) 303 | ;; Output to DAT file 304 | (with-open-file (dat-file *tmp-dat-file* :direction :output :if-exists :supersede) 305 | (loop for i from 0 to (1- n-of-bin) do 306 | (format dat-file "~f ~A~%" 307 | (/ (+ (+ a (* i span)) (+ a (* (1+ i) span))) 2.0) 308 | (nth i counter)))) 309 | ;; Output to GP file 310 | (dump-gp-file (format nil "\"~A\" using 1:2:(~f) with boxes fs solid 0.2 title \" \"" *tmp-dat-file* span) 311 | :output output :x-range x-range :y-range y-range :x-logscale x-logscale :y-logscale y-logscale) 312 | ;; Call Gnuplot 313 | (run)))) 314 | 315 | (defun plot-histogram-with-pdf (samples n-of-bin pdf &key (output nil) 316 | (x-range nil) (y-range nil) 317 | (x-logscale nil) (y-logscale nil)) 318 | (let ((n-of-samples (length samples))) 319 | (multiple-value-bind (a b) 320 | (search-min-max samples) 321 | (let ((counter (make-list n-of-bin :initial-element 0)) 322 | (span (/ (- b a) n-of-bin))) 323 | ;; Counting 324 | (dolist (x samples) 325 | (let ((bin (histogram-lem1 x a b n-of-bin))) 326 | (if bin (incf (nth bin counter))))) 327 | ;; Output to DAT file 328 | (with-open-file (dat-file *tmp-dat-file* :direction :output :if-exists :supersede) 329 | (loop for i from 0 to (1- n-of-bin) do 330 | (format dat-file "~f ~f~%" 331 | (/ (+ (+ a (* i span)) (+ a (* (1+ i) span))) 2.0) 332 | ;;(nth i counter) 333 | (/ (nth i counter) (* span n-of-samples)) 334 | ))) 335 | (with-open-file (dat-file (concatenate 'string *tmp-dat-file* ".pdfdat") 336 | :direction :output :if-exists :supersede) 337 | (loop for i from a to b by (/ (- b a) 100) do 338 | (format dat-file "~f ~f~%" 339 | i 340 | (funcall pdf i)))) 341 | ;; Output to GP file 342 | (dump-gp-file (format nil "\"~A\" using 1:2:(~f) with boxes fs solid 0.2 title \" \", \"~A\" using 1:2 with lines title \" \"" 343 | *tmp-dat-file* span (concatenate 'string *tmp-dat-file* ".pdfdat")) 344 | :output output :x-range x-range :y-range y-range :x-logscale x-logscale :y-logscale y-logscale) 345 | ;; Call Gnuplot 346 | (run))))) 347 | 348 | ;;; functions for multiplot 349 | 350 | (defun dump-gp-file-append (plot-arg-format 351 | &key (x-label nil) (y-label nil) 352 | (main nil) (aspect-ratio 1.0) 353 | (output nil) (output-format :png) 354 | (x-logscale nil) (y-logscale nil) 355 | (x-range nil) (y-range nil) 356 | (x-range-reverse nil) (y-range-reverse nil) (key t)) 357 | (declare (ignore output output-format)) 358 | (with-open-file (gp-file *tmp-gp-file* :direction :output 359 | :if-exists :append :if-does-not-exist :create) 360 | 361 | (when main (format gp-file "set title \"~A\"~%" main)) 362 | (if x-label (format gp-file "set xlabel \"~A\"~%" x-label)) 363 | (if y-label (format gp-file "set ylabel \"~A\"~%" y-label)) 364 | 365 | (if x-range 366 | (format gp-file "set xrange [~f:~f] " (car x-range) (cadr x-range)) 367 | (format gp-file "set xrange [] ")) 368 | (if x-range-reverse 369 | (format gp-file "reverse")) 370 | (format gp-file "~%") 371 | 372 | (if y-range 373 | (format gp-file "set yrange [~f:~f] " (car y-range) (cadr y-range)) 374 | (format gp-file "set yrange [] ")) 375 | (if y-range-reverse 376 | (format gp-file "reverse")) 377 | (format gp-file "~%") 378 | 379 | (if x-logscale (format gp-file "set logscale x~%")) 380 | (if y-logscale (format gp-file "set logscale y~%")) 381 | 382 | (if aspect-ratio (format gp-file "set size ratio ~f~%" aspect-ratio)) 383 | 384 | (if key 385 | (format gp-file "set key~%") 386 | (format gp-file "set nokey~%")) 387 | 388 | (format gp-file (concatenate 'string "plot " plot-arg-format "~%")))) 389 | 390 | (defun plot-for-multiplot (plot-id y-seq 391 | &key (x-seq nil) (title " ") (style 'lines) 392 | (x-label nil) (y-label nil) 393 | (main nil) (aspect-ratio 1.0) 394 | (output nil) (output-format :png) 395 | (x-logscale nil) (y-logscale nil) 396 | (x-range nil) (y-range nil) 397 | (x-range-reverse nil) (y-range-reverse nil) (key t)) 398 | (assert (appropriate-style-p style)) 399 | (when (null x-seq) 400 | (setf x-seq (loop for i from 0 below (length y-seq) collect i))) 401 | (unless (= (length x-seq) (length y-seq)) 402 | (error "sequence length mismatch detected between y-seq and x-seq.")) 403 | 404 | ;; Output to DAT file 405 | (with-open-file (dat-file (format nil "~A.plot-id~A" *tmp-dat-file* plot-id) 406 | :direction :output :if-exists :supersede) 407 | (iter (for x in-sequence x-seq) 408 | (for y in-sequence y-seq) 409 | (format dat-file "~f ~f~%" x y))) 410 | 411 | ;; Output to GP file 412 | (dump-gp-file-append (format nil "\"~A.plot-id~A\" using 1:2 with ~A title \"~A\"" 413 | *tmp-dat-file* plot-id (string-downcase (symbol-name style)) title) 414 | :x-label x-label :y-label y-label :aspect-ratio aspect-ratio 415 | :main main :output output :output-format output-format 416 | :x-logscale x-logscale :y-logscale y-logscale 417 | :x-range x-range :y-range y-range 418 | :x-range-reverse x-range-reverse :y-range-reverse y-range-reverse 419 | :key key)) 420 | 421 | (defun plots-for-multiplot (plot-id y-seqs 422 | &key (x-seqs nil) (title-list nil) (style 'lines) 423 | (x-label nil) (y-label nil) 424 | (main nil) (aspect-ratio 1.0) 425 | (output nil) (output-format :png) 426 | (x-logscale nil) (y-logscale nil) 427 | (x-range nil) (y-range nil) 428 | (x-range-reverse nil) (y-range-reverse nil) (key t) 429 | ;; When axis-list is nil, use x1y1 axis for all plots. 430 | ;; To use two axis: (plots (list list1 list2) :axis-list '(x1y1 x1y2)) 431 | (axis-list nil)) 432 | (iter (for i from 0) (for y-seq in-sequence y-seqs) (for x-seq in-sequence x-seqs) 433 | (when (null x-seq) 434 | (setf x-seq (loop for i from 0 below (length y-seq) collect i))) 435 | (unless (= (length x-seq) (length y-seq)) 436 | (error "sequence length mismatch detected between y-seq and x-seq.")) 437 | ;; Output to DAT file 438 | (with-open-file (dat-file (format nil "~A.plot-id~A.~A" *tmp-dat-file* plot-id i) 439 | :direction :output :if-exists :supersede) 440 | (iter (for x in-sequence x-seq) (for y in-sequence y-seq) 441 | (format dat-file "~f ~f~%" x y)))) 442 | 443 | (when (and (not (null axis-list)) 444 | (not (= (length y-seqs) (length axis-list)))) 445 | (error "sequence length mismatch detected between y-seqs and axis-list.")) 446 | 447 | (when (and (listp style) (not (= (length y-seqs) (length style)))) 448 | (error "list length mismatch detected between y-lists and style.")) 449 | 450 | ;; Output to GP file 451 | (dump-gp-file-append 452 | (comma-separated-concatenate 453 | (loop for i from 0 below (length y-seqs) 454 | collect (format nil "\"~A.plot-id~A.~A\" using 1:2 with ~A title \"~A\" axis ~A" 455 | *tmp-dat-file* plot-id i (string-downcase (symbol-name style)) 456 | (if (null title-list) " " (nth i title-list)) 457 | (if (null axis-list) "x1y1" (string-downcase (string (nth i axis-list))))))) 458 | :x-label x-label :y-label y-label :aspect-ratio aspect-ratio 459 | :main main :output output :output-format output-format 460 | :x-logscale x-logscale :y-logscale y-logscale 461 | :x-range x-range :y-range y-range 462 | :x-range-reverse x-range-reverse :y-range-reverse y-range-reverse 463 | :key key)) 464 | 465 | (defmacro multiplot ((&key layout output (output-format :png)) &body body) 466 | (assert (or (null layout) 467 | (and (listp layout) 468 | (= (length layout) 2) 469 | (every #'integerp layout)))) 470 | (let ((gp-file (gensym))) 471 | `(progn 472 | (with-open-file (,gp-file *tmp-gp-file* :direction :output :if-exists :supersede) 473 | (cond (,output 474 | (ecase ,output-format 475 | (:pdf (format ,gp-file "set term pdf~%")) 476 | (:eps (format ,gp-file "set term postscript eps enhanced color~%")) 477 | (:eps-monochrome (format ,gp-file "set term postscript eps enhanced monochrome~%")) 478 | (:png-400x320 (format ,gp-file "set term png size 400,320~%")) 479 | (:png (format ,gp-file "set term png~%")) 480 | (:png-640x480 (format ,gp-file "set term png~%")) 481 | (:png-1280x1024 (format ,gp-file "set term png size 1280,1024~%")) 482 | (:png-2560x1024 (format ,gp-file "set term png size 2560,1024~%")) 483 | (:png-monochrome (format ,gp-file "set term png monochrome~%"))) 484 | (format ,gp-file "set output \"~A\"~%" ,output)) 485 | (t (format ,gp-file "set term ~A~%" *default-terminal*))) 486 | (format ,gp-file "set multiplot layout ~A,~A~%set format y \"%.3f\"~%" 487 | ,(if layout (first layout) 1) 488 | ,(if layout (second layout) (length body)))) 489 | (loop for plot-id from 0 to ,(1- (length body)) do 490 | (cond ((eq (car (nth plot-id ',body)) 'plot) 491 | (apply #'plot-for-multiplot (cons plot-id (mapcar #'eval (cdr (nth plot-id ',body)))))) 492 | ((eq (car (nth plot-id ',body)) 'plots) 493 | (apply #'plots-for-multiplot (cons plot-id (mapcar #'eval (cdr (nth plot-id ',body)))))))) 494 | (with-open-file (,gp-file *tmp-gp-file* :direction :output :if-exists :append) 495 | (format ,gp-file "unset multiplot~%")) 496 | (run)))) 497 | 498 | ;;; 3-dimension plot 499 | (defun dump-gp-file-3d 500 | (plot-arg-format 501 | &key 502 | (x-label nil) (y-label nil) (z-label nil) 503 | (main nil) (aspect-ratio 1.0) 504 | (output nil) (output-format :png) 505 | (x-logscale nil) (y-logscale nil) (z-logscale nil) 506 | (x-range nil) (y-range nil) (z-range nil) 507 | (x-range-reverse nil) (y-range-reverse nil) (z-range-reverse nil) 508 | (view-point '(60 30)) (magnification 1) (z-scale 1) 509 | (palette 'jet) 510 | (key t) (map nil)) 511 | (declare (ignore key)) 512 | (with-open-file (gp-file *tmp-gp-file* :direction :output :if-exists :supersede) 513 | ;; Output file format settings 514 | (cond (output 515 | (ecase output-format 516 | (:pdf (format gp-file "set term pdf~%")) 517 | (:eps (format gp-file "set term postscript eps enhanced color~%")) 518 | (:eps-monochrome (format gp-file "set term postscript eps enhanced monochrome~%")) 519 | (:png-400x320 (format gp-file "set term png size 400,320~%")) 520 | (:png (format gp-file "set term png~%")) 521 | (:png-640x480 (format gp-file "set term png~%")) 522 | (:png-1280x1024 (format gp-file "set term png size 1280,1024~%")) 523 | (:png-2560x1024 (format gp-file "set term png size 2560,1024~%")) 524 | (:png-monochrome (format gp-file "set term png monochrome~%"))) 525 | (format gp-file "set output \"~A\"~%" output)) 526 | (t (format gp-file "set term ~A~%" *default-terminal*))) 527 | 528 | (when main (format gp-file "set title \"~A\"~%" main)) 529 | ;; Label of axis 530 | (if x-label (format gp-file "set xlabel \"~A\"~%" x-label)) 531 | (if y-label (format gp-file "set ylabel \"~A\"~%" y-label)) 532 | (if z-label (format gp-file "set zlabel \"~A\"~%" z-label)) 533 | 534 | ;; Specify range and axis orientation 535 | (if x-range 536 | (format gp-file "set xrange [~f:~f] " (car x-range) (cadr x-range)) 537 | (format gp-file "set xrange [] ")) 538 | (if x-range-reverse 539 | (format gp-file "reverse")) 540 | (format gp-file "~%") 541 | 542 | (if y-range 543 | (format gp-file "set yrange [~f:~f] " (car y-range) (cadr y-range)) 544 | (format gp-file "set yrange [] ")) 545 | (if y-range-reverse 546 | (format gp-file "reverse")) 547 | (format gp-file "~%") 548 | 549 | (if z-range 550 | (format gp-file "set zrange [~f:~f] " (car z-range) (cadr z-range)) 551 | (format gp-file "set zrange [] ")) 552 | (if z-range-reverse 553 | (format gp-file "reverse")) 554 | (format gp-file "~%") 555 | 556 | ;; Log scale 557 | (if x-logscale (format gp-file "set logscale x~%")) 558 | (if y-logscale (format gp-file "set logscale y~%")) 559 | (if z-logscale (format gp-file "set logscale z~%")) 560 | 561 | ;; Aspect ratio 562 | (if aspect-ratio (format gp-file "set size ratio ~f~%" aspect-ratio)) 563 | 564 | ;; View point 565 | (format gp-file "set view ~A, ~A, ~A, ~A~%" 566 | (car view-point) (cadr view-point) magnification z-scale) 567 | 568 | ;; Color scheme 569 | (ecase palette 570 | (:greys (format gp-file "set palette defined ( 0 0 0 0, 1 1 1 1 )~%")) 571 | (:greys-invert (format gp-file "set palette defined ( 1 1 1 1, 0 0 0 0 )~%")) 572 | (:jet (format gp-file "set palette defined ( 0 '#000090',1 '#000fff',2 '#0090ff',3 '#0fffee',4 '#90ff70',5 '#ffee00',6 '#ff7000',7 '#ee0000',8 '#7f0000')~%"))) 573 | 574 | (if map 575 | (progn 576 | (format gp-file "set size square~%") 577 | (format gp-file "set pm3d map~%")) 578 | (progn 579 | (format gp-file "set ticslevel 0~%") 580 | (format gp-file "set pm3d~%"))) 581 | 582 | (format gp-file (concatenate 'string "splot " plot-arg-format)) 583 | 584 | (when (and (null output) 585 | (member *default-terminal* '("x11" "qt") :test #'equal)) 586 | (format gp-file "~%pause mouse close~%")))) 587 | 588 | (defun splot-list (z-func x-list y-list 589 | &key (title " ") (style 'lines) 590 | (x-label nil) (y-label nil) (z-label nil) 591 | (main nil) (aspect-ratio 1.0) 592 | (output nil) (output-format :png) 593 | (x-logscale nil) (y-logscale nil) (z-logscale nil) 594 | (x-range nil) (y-range nil) (z-range nil) 595 | (x-range-reverse nil) (y-range-reverse nil) (z-range-reverse nil) 596 | (view-point '(60 30)) (magnification 1) (z-scale 1) 597 | (palette :jet) (key t) (map nil)) 598 | 599 | ;; Output to DAT file 600 | (with-open-file (dat-file *tmp-dat-file* :direction :output :if-exists :supersede) 601 | (mapc #'(lambda (x) 602 | (mapc #'(lambda (y) 603 | (format dat-file "~f ~f ~f~%" x y (funcall z-func x y))) 604 | y-list) 605 | (format dat-file "~%")) ; Put a new line every time the value of x changes, so that gnuplot recognizes it as grid data. 606 | x-list)) 607 | ;; Output to DAT file 608 | (dump-gp-file-3d 609 | (if map 610 | (format nil "\"~A\" using 1:2:3 title \"~A\"" 611 | *tmp-dat-file* title) 612 | (format nil "\"~A\" using 1:2:3 with ~A title \"~A\"" 613 | *tmp-dat-file* (string-downcase (symbol-name style)) title)) 614 | :x-label x-label :y-label y-label :z-label z-label 615 | :main main :aspect-ratio aspect-ratio 616 | :output output :output-format output-format 617 | :x-logscale x-logscale :y-logscale y-logscale :z-logscale z-logscale 618 | :x-range (if map 619 | (list (car x-list) (last1 x-list)) 620 | x-range) 621 | :y-range (if map 622 | (list (car y-list) (last1 y-list)) 623 | y-range) 624 | :z-range z-range 625 | :x-range-reverse x-range-reverse :y-range-reverse y-range-reverse :z-range-reverse z-range-reverse 626 | :view-point view-point :magnification magnification :z-scale z-scale 627 | :palette palette :key key :map map) 628 | (run)) 629 | 630 | (defun splot (z-func x-seq y-seq 631 | &key (title " ") (style 'lines) 632 | (x-label nil) (y-label nil) (z-label nil) 633 | (aspect-ratio 1.0) 634 | (output nil) (output-format :png) 635 | (x-logscale nil) (y-logscale nil) (z-logscale nil) 636 | (x-range nil) (y-range nil) (z-range nil) 637 | (x-range-reverse nil) (y-range-reverse nil) (z-range-reverse nil) 638 | (view-point '(60 30)) (magnification 1) (z-scale 1) 639 | (palette :jet) (key t) (map nil)) 640 | 641 | (assert (appropriate-style-p style)) 642 | 643 | (splot-list z-func (coerce x-seq 'list) (coerce y-seq 'list) 644 | :title title :style style 645 | :x-label x-label :y-label y-label :z-label z-label 646 | :aspect-ratio aspect-ratio 647 | :output output :output-format output-format 648 | :x-logscale x-logscale :y-logscale y-logscale :z-logscale z-logscale 649 | :x-range x-range :y-range y-range :z-range z-range 650 | :x-range-reverse x-range-reverse :y-range-reverse y-range-reverse :z-range-reverse z-range-reverse 651 | :view-point view-point :magnification magnification :z-scale z-scale 652 | :palette palette :key key :map map)) 653 | 654 | (defun splot-matrix (matrix &key (title " ") (style 'lines) 655 | (x-label nil) (y-label nil) (z-label nil) 656 | (output nil) (output-format :png) 657 | (x-range-reverse nil) (y-range-reverse nil) (z-range-reverse nil) 658 | (palette :jet) (key t)) 659 | 660 | (assert (appropriate-style-p style)) 661 | 662 | (flet ((seq-row (start end) 663 | (nlet iteration ((i start) (product nil)) 664 | (if (> i end) 665 | (reverse product) 666 | (iteration (1+ i) (cons (+ i 0.999) (cons (+ i 0.999) (cons i (cons i product)))))))) 667 | (seq-col (start end) 668 | (nlet iteration ((i start) (product nil)) 669 | (if (> i end) 670 | (reverse product) 671 | (iteration (1+ i) (cons (+ i 0.999) (cons i (cons (+ i 0.999) (cons i product))))))))) 672 | (splot-list (lambda (x y) 673 | (aref matrix (truncate x) (truncate y))) 674 | (seq-row 0 (1- (array-dimension matrix 0))) 675 | (seq-col 0 (1- (array-dimension matrix 1))) 676 | :title title :style style 677 | :x-label x-label :y-label y-label :z-label z-label 678 | :output output :output-format output-format 679 | :x-range-reverse x-range-reverse :y-range-reverse y-range-reverse :z-range-reverse z-range-reverse 680 | :aspect-ratio 1.0 :palette palette :map t :key key))) 681 | --------------------------------------------------------------------------------