code.delx.au - gnu-emacs/blob - lisp/org/org-plot.el

   1 ;;; org-plot.el --- Support for plotting from Org-mode
   2
   3 ;; Copyright (C) 2008 Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Eric Schulte <schulte dot eric at gmail dot com>
   6 ;; Keywords: tables, plotting
   7 ;; Homepage: http://orgmode.org
   8 ;; Version: 6.06b
   9 ;;
  10 ;; This file is part of GNU Emacs.
  11 ;;
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; Borrows ideas and a couple of lines of code from org-exp.el.
  28
  29 ;; Thanks to the org-mode mailing list for testing and implementation
  30 ;; and feature suggestions
  31
  32 ;;; Code:
  33 (require 'org)
  34 (require 'org-exp)
  35 (require 'org-table)
  36 (eval-and-compile
  37   (require 'cl))
  38
  39 (declare-function gnuplot-delchar-or-maybe-eof "ext:gnuplot" (arg))
  40 (declare-function gnuplot-mode "ext:gnuplot" ())
  41 (declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot" ())
  42
  43 (defvar org-plot/gnuplot-default-options
  44   '((:plot-type . 2d)
  45     (:with . lines)
  46     (:ind . 0))
  47   "Default options to gnuplot used by `org-plot/gnuplot'")
  48
  49 (defun org-plot/add-options-to-plist (p options)
  50   "Parse an OPTIONS line and set values in the property list P.
  51 Returns the resulting property list."
  52   (let (o)
  53     (when options
  54       (let ((op '(("type"   . :plot-type)
  55                   ("script" . :script)
  56                   ("line"   . :line)
  57                   ("set"    . :set)
  58                   ("title"  . :title)
  59                   ("ind"    . :ind)
  60                   ("deps"   . :deps)
  61                   ("with"   . :with)
  62                   ("file"   . :file)
  63                   ("labels" . :labels)
  64                   ("map"    . :map)))
  65             (multiples '("set" "line"))
  66             (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)")
  67             (start 0)
  68             o)
  69         (while (setq o (pop op))
  70           (if (member (car o) multiples) ;; keys with multiple values
  71               (while (string-match
  72                       (concat (regexp-quote (car o)) regexp)
  73                       options start)
  74                 (setq start (match-end 0))
  75                 (setq p (plist-put p (cdr o)
  76                                    (cons (car (read-from-string
  77                                                (match-string 1 options)))
  78                                          (plist-get p (cdr o)))))
  79                 p)
  80             (if (string-match (concat (regexp-quote (car o)) regexp)
  81                               options)
  82                 (setq p (plist-put p (cdr o)
  83                                    (car (read-from-string
  84                                          (match-string 1 options)))))))))))
  85   p)
  86
  87 (defun org-plot/goto-nearest-table ()
  88   "Move the point forward to the beginning of nearest table.
  89 Return value is the point at the beginning of the table."
  90   (interactive) (move-beginning-of-line 1)
  91   (while (not (or (org-at-table-p) (< 0 (forward-line 1)))))
  92   (goto-char (org-table-begin)))
  93
  94 (defun org-plot/collect-options (&optional params)
  95   "Collect options from an org-plot '#+Plot:' line.
  96 Accepts an optional property list PARAMS, to which the options
  97 will be added.  Returns the resulting property list."
  98   (interactive)
  99   (let ((line (thing-at-point 'line)))
 100     (if (string-match "#\\+PLOT: +\\(.*\\)$" line)
 101         (org-plot/add-options-to-plist params (match-string 1 line))
 102       params)))
 103
 104 (defun org-plot-quote-tsv-field (s)
 105   "Quote field S for export to gnuplot."
 106   (if (string-match org-table-number-regexp s) s
 107     (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")))
 108
 109 (defun org-plot/gnuplot-to-data (table data-file params)
 110   "Export TABLE to DATA-FILE in a format readable by gnuplot.
 111 Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
 112   (with-temp-file
 113       data-file (insert (orgtbl-to-generic
 114                          table
 115                          (org-combine-plists
 116                           '(:sep "\t" :fmt org-plot-quote-tsv-field)
 117                           params))))
 118   nil)
 119
 120 (defun org-plot/gnuplot-to-grid-data (table data-file params)
 121   "Export the data in TABLE to DATA-FILE for gnuplot.
 122 This means, in a format appropriate for grid plotting by gnuplot.
 123 PARAMS specifies which columns of TABLE should be plotted as independant
 124 and dependant variables."
 125   (interactive)
 126   (let* ((ind (- (plist-get params :ind) 1))
 127          (deps (if (plist-member params :deps)
 128                    (mapcar (lambda (val) (- val 1)) (plist-get params :deps))
 129                  (let (collector)
 130                    (dotimes (col (length (first table)))
 131                      (setf collector (cons col collector)))
 132                    collector)))
 133          row-vals (counter 0))
 134     (when (>= ind 0) ;; collect values of ind col
 135       (setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter))
 136                                (cons counter (nth ind row))) table)))
 137     (when (or deps (>= ind 0)) ;; remove non-plotting columns
 138       (setf deps (delq ind deps))
 139       (setf table (mapcar (lambda (row)
 140                             (dotimes (col (length row))
 141                               (unless (memq col deps)
 142                                 (setf (nth col row) nil)))
 143                             (delq nil row))
 144                           table)))
 145     ;; write table to gnuplot grid datafile format
 146     (with-temp-file data-file
 147       (let ((num-rows (length table)) (num-cols (length (first table)))
 148             front-edge back-edge)
 149         (flet ((gnuplot-row (col row value)
 150                             (setf col (+ 1 col)) (setf row (+ 1 row))
 151                             (format "%f  %f  %f\n%f  %f  %f\n"
 152                                     col (- row 0.5) value ;; lower edge
 153                                     col (+ row 0.5) value))) ;; upper edge
 154           (dotimes (col num-cols)
 155             (dotimes (row num-rows)
 156               (setf back-edge
 157                     (concat back-edge
 158                             (gnuplot-row (- col 1) row (string-to-number
 159                                                         (nth col (nth row table))))))
 160               (setf front-edge
 161                     (concat front-edge
 162                             (gnuplot-row col row (string-to-number
 163                                                   (nth col (nth row table)))))))
 164             ;; only insert once per row
 165             (insert back-edge) (insert "\n") ;; back edge
 166             (insert front-edge) (insert "\n") ;; front edge
 167             (setf back-edge "") (setf front-edge "")))))
 168     row-vals))
 169
 170 (defun org-plot/gnuplot-script (data-file num-cols params)
 171   "Write a gnuplot script to DATA-FILE respecting the options set in PARAMS.
 172 NUM-COLS controls the number of columns plotted in a 2-d plot."
 173   (let* ((type (plist-get params :plot-type))
 174          (with (if (equal type 'grid)
 175                    'pm3d
 176                  (plist-get params :with)))
 177          (sets (plist-get params :set))
 178          (lines (plist-get params :line))
 179          (map (plist-get params :map))
 180          (title (plist-get params :title))
 181          (file (plist-get params :file))
 182          (ind (plist-get params :ind))
 183          (text-ind (plist-get params :textind))
 184          (deps (if (plist-member params :deps) (plist-get params :deps)))
 185          (col-labels (plist-get params :labels))
 186          (x-labels (plist-get params :xlabels))
 187          (y-labels (plist-get params :ylabels))
 188          (plot-str "'%s' using %s%d%s with %s title '%s'")
 189          (plot-cmd (case type
 190                      ('2d "plot")
 191                      ('3d "splot")
 192                      ('grid "splot")))
 193          (script "reset") plot-lines)
 194     (flet ((add-to-script (line) (setf script (format "%s\n%s" script line))))
 195       (when file ;; output file
 196         (add-to-script (format "set term %s" (file-name-extension file)))
 197         (add-to-script (format "set output '%s'" file)))
 198       (case type ;; type
 199         ('2d ())
 200         ('3d (if map (add-to-script "set map")))
 201         ('grid (if map
 202                    (add-to-script "set pm3d map")
 203                  (add-to-script "set pm3d"))))
 204       (when title (add-to-script (format "set title '%s'" title))) ;; title
 205       (when lines (mapc (lambda (el) (add-to-script el)) lines)) ;; line
 206       (when sets ;; set
 207         (mapc (lambda (el) (add-to-script (format "set %s" el))) sets))
 208       (when x-labels ;; x labels (xtics)
 209         (add-to-script
 210          (format "set xtics (%s)"
 211                  (mapconcat (lambda (pair)
 212                               (format "\"%s\" %d" (cdr pair) (car pair)))
 213                             x-labels ", "))))
 214       (when y-labels ;; y labels (ytics)
 215         (add-to-script
 216          (format "set ytics (%s)"
 217                  (mapconcat (lambda (pair)
 218                               (format "\"%s\" %d" (cdr pair) (car pair)))
 219                             y-labels ", "))))
 220       (case type ;; plot command
 221         ('2d (dotimes (col num-cols)
 222                (unless (and (equal type '2d)
 223                             (or (and ind (equal (+ 1 col) ind))
 224                                 (and deps (not (member (+ 1 col) deps)))))
 225                  (setf plot-lines
 226                        (cons
 227                         (format plot-str data-file
 228                                 (or (and (not text-ind) ind
 229                                          (> ind 0) (format "%d:" ind)) "")
 230                                 (+ 1 col)
 231                                 (if text-ind (format ":xticlabel(%d)" ind) "")
 232                                 with
 233                                 (or (nth col col-labels) (format "%d" (+ 1 col))))
 234                         plot-lines)))))
 235         ('3d
 236          (setq plot-lines (list (format "'%s' matrix with %s title ''"
 237                                         data-file with))))
 238         ('grid
 239          (setq plot-lines (list (format "'%s' with %s title ''"
 240                                         data-file with)))))
 241       (add-to-script
 242        (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n    ")))
 243       script)))
 244
 245 ;;-----------------------------------------------------------------------------
 246 ;; facade functions
 247 ;;;###autoload
 248 (defun org-plot/gnuplot (&optional params)
 249   "Plot table using gnuplot. Gnuplot options can be specified with PARAMS.
 250 If not given options will be taken from the +PLOT
 251 line directly before or after the table."
 252   (interactive)
 253   (require 'gnuplot)
 254   (save-window-excursion
 255     (delete-other-windows)
 256     (when (get-buffer "*gnuplot*") ;; reset *gnuplot* if it already running
 257       (save-excursion
 258         (set-buffer "*gnuplot*") (goto-char (point-max))
 259         (gnuplot-delchar-or-maybe-eof nil)))
 260     (org-plot/goto-nearest-table)
 261     ;; set default options
 262     (mapc
 263      (lambda (pair)
 264        (unless (plist-member params (car pair))
 265          (setf params (plist-put params (car pair) (cdr pair)))))
 266      org-plot/gnuplot-default-options)
 267     ;; collect table and table information
 268     (let* ((data-file (make-temp-file "org-plot"))
 269            (table (org-table-to-lisp))
 270            (num-cols (length (if (eq (first table) 'hline) (second table)
 271                                (first table)))))
 272       (while (equal 'hline (first table)) (setf table (cdr table)))
 273       (when (equal (second table) 'hline)
 274         (setf params (plist-put params :labels (first table))) ;; headers to labels
 275         (setf table (delq 'hline (cdr table)))) ;; clean non-data from table
 276       ;; collect options
 277       (save-excursion (while (and (equal 0 (forward-line -1))
 278                                   (looking-at "#\\+"))
 279                         (setf params (org-plot/collect-options params))))
 280       ;; dump table to datafile (very different for grid)
 281       (case (plist-get params :plot-type)
 282         ('2d   (org-plot/gnuplot-to-data table data-file params))
 283         ('3d   (org-plot/gnuplot-to-data table data-file params))
 284         ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data
 285                                 table data-file params)))
 286                  (when y-labels (plist-put params :ylabels y-labels)))))
 287       ;; check for text ind column
 288       (let ((ind (- (plist-get params :ind) 1)))
 289         (when (and (>= ind 0) (equal '2d (plist-get params :plot-type)))
 290           (if (> (length
 291                   (delq 0 (mapcar
 292                            (lambda (el)
 293                              (if (string-match org-table-number-regexp el)
 294                                  0 1))
 295                            (mapcar (lambda (row) (nth ind row)) table)))) 0)
 296               (plist-put params :textind t))))
 297       ;; write script
 298       (with-temp-buffer
 299         (if (plist-get params :script) ;; user script
 300             (progn (insert-file-contents (plist-get params :script))
 301                    (goto-char (point-min))
 302                    (while (re-search-forward "$datafile" nil t)
 303                      (replace-match data-file nil nil)))
 304           (insert
 305            (org-plot/gnuplot-script data-file num-cols params)))
 306         ;; graph table
 307         (gnuplot-mode)
 308         (gnuplot-send-buffer-to-gnuplot))
 309       ;; cleanup
 310       (bury-buffer (get-buffer "*gnuplot*"))(delete-file data-file))))
 311
 312 (provide 'org-plot)
 313
 314 ;;; org-plot.el ends here