lisp/org-plot.el

   1 ;;; org-plot.el --- Support for plotting from Org-mode
   2
   3 ;; Copyright (C) 2008, 2009 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.17trans
   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 (defvar org-plot-timestamp-fmt nil)
  50
  51 (defun org-plot/add-options-to-plist (p options)
  52   "Parse an OPTIONS line and set values in the property list P.
  53 Returns the resulting property list."
  54   (let (o)
  55     (when options
  56       (let ((op '(("type"    . :plot-type)
  57                   ("script"  . :script)
  58                   ("line"    . :line)
  59                   ("set"     . :set)
  60                   ("title"   . :title)
  61                   ("ind"     . :ind)
  62                   ("deps"    . :deps)
  63                   ("with"    . :with)
  64                   ("file"    . :file)
  65                   ("labels"  . :labels)
  66                   ("map"     . :map)
  67                   ("timefmt" . :timefmt)))
  68             (multiples '("set" "line"))
  69             (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)")
  70             (start 0)
  71             o)
  72         (while (setq o (pop op))
  73           (if (member (car o) multiples) ;; keys with multiple values
  74               (while (string-match
  75                       (concat (regexp-quote (car o)) regexp)
  76                       options start)
  77                 (setq start (match-end 0))
  78                 (setq p (plist-put p (cdr o)
  79                                    (cons (car (read-from-string
  80                                                (match-string 1 options)))
  81                                          (plist-get p (cdr o)))))
  82                 p)
  83             (if (string-match (concat (regexp-quote (car o)) regexp)
  84                               options)
  85                 (setq p (plist-put p (cdr o)
  86                                    (car (read-from-string
  87                                          (match-string 1 options)))))))))))
  88   p)
  89
  90 (defun org-plot/goto-nearest-table ()
  91   "Move the point forward to the beginning of nearest table.
  92 Return value is the point at the beginning of the table."
  93   (interactive) (move-beginning-of-line 1)
  94   (while (not (or (org-at-table-p) (< 0 (forward-line 1)))))
  95   (goto-char (org-table-begin)))
  96
  97 (defun org-plot/collect-options (&optional params)
  98   "Collect options from an org-plot '#+Plot:' line.
  99 Accepts an optional property list PARAMS, to which the options
 100 will be added.  Returns the resulting property list."
 101   (interactive)
 102   (let ((line (thing-at-point 'line)))
 103     (if (string-match "#\\+PLOT: +\\(.*\\)$" line)
 104         (org-plot/add-options-to-plist params (match-string 1 line))
 105       params)))
 106
 107 (defun org-plot-quote-timestamp-field (s)
 108   "Convert field S from timestamp to Unix time and export to gnuplot."
 109   (format-time-string org-plot-timestamp-fmt (org-time-string-to-time s)))
 110
 111 (defun org-plot-quote-tsv-field (s)
 112   "Quote field S for export to gnuplot."
 113   (if (string-match org-table-number-regexp s) s
 114     (if (string-match org-ts-regexp3 s)
 115         (org-plot-quote-timestamp-field s)
 116       (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\""))))
 117
 118 (defun org-plot/gnuplot-to-data (table data-file params)
 119   "Export TABLE to DATA-FILE in a format readable by gnuplot.
 120 Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
 121   (with-temp-file
 122       data-file
 123     (make-local-variable 'org-plot-timestamp-fmt)
 124     (setq org-plot-timestamp-fmt (or
 125                                   (plist-get params :timefmt)
 126                                   "%Y-%m-%d-%H:%M:%S"))
 127     (insert (orgtbl-to-generic
 128              table
 129              (org-combine-plists
 130               '(:sep "\t" :fmt org-plot-quote-tsv-field)
 131               params))))
 132   nil)
 133
 134 (defun org-plot/gnuplot-to-grid-data (table data-file params)
 135   "Export the data in TABLE to DATA-FILE for gnuplot.
 136 This means, in a format appropriate for grid plotting by gnuplot.
 137 PARAMS specifies which columns of TABLE should be plotted as independent
 138 and dependant variables."
 139   (interactive)
 140   (let* ((ind (- (plist-get params :ind) 1))
 141          (deps (if (plist-member params :deps)
 142                    (mapcar (lambda (val) (- val 1)) (plist-get params :deps))
 143                  (let (collector)
 144                    (dotimes (col (length (first table)))
 145                      (setf collector (cons col collector)))
 146                    collector)))
 147          row-vals (counter 0))
 148     (when (>= ind 0) ;; collect values of ind col
 149       (setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter))
 150                                (cons counter (nth ind row))) table)))
 151     (when (or deps (>= ind 0)) ;; remove non-plotting columns
 152       (setf deps (delq ind deps))
 153       (setf table (mapcar (lambda (row)
 154                             (dotimes (col (length row))
 155                               (unless (memq col deps)
 156                                 (setf (nth col row) nil)))
 157                             (delq nil row))
 158                           table)))
 159     ;; write table to gnuplot grid datafile format
 160     (with-temp-file data-file
 161       (let ((num-rows (length table)) (num-cols (length (first table)))
 162             front-edge back-edge)
 163         (flet ((gnuplot-row (col row value)
 164                             (setf col (+ 1 col)) (setf row (+ 1 row))
 165                             (format "%f  %f  %f\n%f  %f  %f\n"
 166                                     col (- row 0.5) value ;; lower edge
 167                                     col (+ row 0.5) value))) ;; upper edge
 168           (dotimes (col num-cols)
 169             (dotimes (row num-rows)
 170               (setf back-edge
 171                     (concat back-edge
 172                             (gnuplot-row (- col 1) row (string-to-number
 173                                                         (nth col (nth row table))))))
 174               (setf front-edge
 175                     (concat front-edge
 176                             (gnuplot-row col row (string-to-number
 177                                                   (nth col (nth row table)))))))
 178             ;; only insert once per row
 179             (insert back-edge) (insert "\n") ;; back edge
 180             (insert front-edge) (insert "\n") ;; front edge
 181             (setf back-edge "") (setf front-edge "")))))
 182     row-vals))
 183
 184 (defun org-plot/gnuplot-script (data-file num-cols params)
 185   "Write a gnuplot script to DATA-FILE respecting the options set in PARAMS.
 186 NUM-COLS controls the number of columns plotted in a 2-d plot."
 187   (let* ((type (plist-get params :plot-type))
 188          (with (if (equal type 'grid)
 189                    'pm3d
 190                  (plist-get params :with)))
 191          (sets (plist-get params :set))
 192          (lines (plist-get params :line))
 193          (map (plist-get params :map))
 194          (title (plist-get params :title))
 195          (file (plist-get params :file))
 196          (ind (plist-get params :ind))
 197          (time-ind (plist-get params :timeind))
 198          (timefmt (plist-get params :timefmt))
 199          (text-ind (plist-get params :textind))
 200          (deps (if (plist-member params :deps) (plist-get params :deps)))
 201          (col-labels (plist-get params :labels))
 202          (x-labels (plist-get params :xlabels))
 203          (y-labels (plist-get params :ylabels))
 204          (plot-str "'%s' using %s%d%s with %s title '%s'")
 205          (plot-cmd (case type
 206                      ('2d "plot")
 207                      ('3d "splot")
 208                      ('grid "splot")))
 209          (script "reset") plot-lines)
 210     (flet ((add-to-script (line) (setf script (format "%s\n%s" script line))))
 211       (when file ;; output file
 212         (add-to-script (format "set term %s" (file-name-extension file)))
 213         (add-to-script (format "set output '%s'" file)))
 214       (case type ;; type
 215         ('2d ())
 216         ('3d (if map (add-to-script "set map")))
 217         ('grid (if map
 218                    (add-to-script "set pm3d map")
 219                  (add-to-script "set pm3d"))))
 220       (when title (add-to-script (format "set title '%s'" title))) ;; title
 221       (when lines (mapc (lambda (el) (add-to-script el)) lines)) ;; line
 222       (when sets ;; set
 223         (mapc (lambda (el) (add-to-script (format "set %s" el))) sets))
 224       (when x-labels ;; x labels (xtics)
 225         (add-to-script
 226          (format "set xtics (%s)"
 227                  (mapconcat (lambda (pair)
 228                               (format "\"%s\" %d" (cdr pair) (car pair)))
 229                             x-labels ", "))))
 230       (when y-labels ;; y labels (ytics)
 231         (add-to-script
 232          (format "set ytics (%s)"
 233                  (mapconcat (lambda (pair)
 234                               (format "\"%s\" %d" (cdr pair) (car pair)))
 235                             y-labels ", "))))
 236       (when time-ind ;; timestamp index
 237         (add-to-script "set xdata time")
 238         (add-to-script (concat "set timefmt \""
 239                                (or timefmt ;; timefmt passed to gnuplot
 240                                    "%Y-%m-%d-%H:%M:%S") "\"")))
 241       (case type ;; plot command
 242         ('2d (dotimes (col num-cols)
 243                (unless (and (equal type '2d)
 244                             (or (and ind (equal (+ 1 col) ind))
 245                                 (and deps (not (member (+ 1 col) deps)))))
 246                  (setf plot-lines
 247                        (cons
 248                         (format plot-str data-file
 249                                 (or (and (not text-ind) ind
 250                                          (> ind 0) (format "%d:" ind)) "")
 251                                 (+ 1 col)
 252                                 (if text-ind (format ":xticlabel(%d)" ind) "")
 253                                 with
 254                                 (or (nth col col-labels) (format "%d" (+ 1 col))))
 255                         plot-lines)))))
 256         ('3d
 257          (setq plot-lines (list (format "'%s' matrix with %s title ''"
 258                                         data-file with))))
 259         ('grid
 260          (setq plot-lines (list (format "'%s' with %s title ''"
 261                                         data-file with)))))
 262       (add-to-script
 263        (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n    ")))
 264       script)))
 265
 266 ;;-----------------------------------------------------------------------------
 267 ;; facade functions
 268 ;;;###autoload
 269 (defun org-plot/gnuplot (&optional params)
 270   "Plot table using gnuplot. Gnuplot options can be specified with PARAMS.
 271 If not given options will be taken from the +PLOT
 272 line directly before or after the table."
 273   (interactive)
 274   (require 'gnuplot)
 275   (save-window-excursion
 276     (delete-other-windows)
 277     (when (get-buffer "*gnuplot*") ;; reset *gnuplot* if it already running
 278       (save-excursion
 279         (set-buffer "*gnuplot*") (goto-char (point-max))
 280         (gnuplot-delchar-or-maybe-eof nil)))
 281     (org-plot/goto-nearest-table)
 282     ;; set default options
 283     (mapc
 284      (lambda (pair)
 285        (unless (plist-member params (car pair))
 286          (setf params (plist-put params (car pair) (cdr pair)))))
 287      org-plot/gnuplot-default-options)
 288     ;; collect table and table information
 289     (let* ((data-file (make-temp-file "org-plot"))
 290            (table (org-table-to-lisp))
 291            (num-cols (length (if (eq (first table) 'hline) (second table)
 292                                (first table)))))
 293       (while (equal 'hline (first table)) (setf table (cdr table)))
 294       (when (equal (second table) 'hline)
 295         (setf params (plist-put params :labels (first table))) ;; headers to labels
 296         (setf table (delq 'hline (cdr table)))) ;; clean non-data from table
 297       ;; collect options
 298       (save-excursion (while (and (equal 0 (forward-line -1))
 299                                   (looking-at "#\\+"))
 300                         (setf params (org-plot/collect-options params))))
 301       ;; dump table to datafile (very different for grid)
 302       (case (plist-get params :plot-type)
 303         ('2d   (org-plot/gnuplot-to-data table data-file params))
 304         ('3d   (org-plot/gnuplot-to-data table data-file params))
 305         ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data
 306                                 table data-file params)))
 307                  (when y-labels (plist-put params :ylabels y-labels)))))
 308       ;; check for timestamp ind column
 309       (let ((ind (- (plist-get params :ind) 1)))
 310         (when (and (>= ind 0) (equal '2d (plist-get params :plot-type)))
 311           (if (= (length
 312                   (delq 0 (mapcar
 313                            (lambda (el)
 314                              (if (string-match org-ts-regexp3 el)
 315                                  0 1))
 316                            (mapcar (lambda (row) (nth ind row)) table)))) 0)
 317               (plist-put params :timeind t)
 318             ;; check for text ind column
 319             (if (> (length
 320                     (delq 0 (mapcar
 321                              (lambda (el)
 322                                (if (string-match org-table-number-regexp el)
 323                                    0 1))
 324                              (mapcar (lambda (row) (nth ind row)) table)))) 0)
 325                 (plist-put params :textind t)))))
 326       ;; write script
 327       (with-temp-buffer
 328         (if (plist-get params :script) ;; user script
 329             (progn (insert-file-contents (plist-get params :script))
 330                    (goto-char (point-min))
 331                    (while (re-search-forward "$datafile" nil t)
 332                      (replace-match data-file nil nil)))
 333           (insert
 334            (org-plot/gnuplot-script data-file num-cols params)))
 335         ;; graph table
 336         (gnuplot-mode)
 337         (gnuplot-send-buffer-to-gnuplot))
 338       ;; cleanup
 339       (bury-buffer (get-buffer "*gnuplot*"))
 340       (delete-file data-file))))
 341
 342 (provide 'org-plot)
 343
 344 ;; arch-tag: 5763f7c6-0c75-416d-b070-398ee4ec0eca
 345 ;;; org-plot.el ends here