lisp/org-plot.el

   1 ;;; org-plot.el --- Support for plotting from Org-mode
   2
   3 ;; Copyright (C) 2008-2015 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 ;;
   9 ;; This file is part of GNU Emacs.
  10 ;;
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; Borrows ideas and a couple of lines of code from org-exp.el.
  27
  28 ;; Thanks to the org-mode mailing list for testing and implementation
  29 ;; and feature suggestions
  30
  31 ;;; Code:
  32 (require 'org)
  33 (require 'org-table)
  34 (eval-when-compile
  35   (require 'cl))
  36
  37 (declare-function gnuplot-delchar-or-maybe-eof "ext:gnuplot" (arg))
  38 (declare-function gnuplot-mode "ext:gnuplot" ())
  39 (declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot" ())
  40
  41 (defvar org-plot/gnuplot-default-options
  42   '((:plot-type . 2d)
  43     (:with . lines)
  44     (:ind . 0))
  45   "Default options to gnuplot used by `org-plot/gnuplot'.")
  46
  47 (defvar org-plot-timestamp-fmt nil)
  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                   ("timeind" . :timeind)
  66                   ("timefmt" . :timefmt)))
  67             (multiples '("set" "line"))
  68             (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)")
  69             (start 0)
  70             o)
  71         (while (setq o (pop op))
  72           (if (member (car o) multiples) ;; keys with multiple values
  73               (while (string-match
  74                       (concat (regexp-quote (car o)) regexp)
  75                       options start)
  76                 (setq start (match-end 0))
  77                 (setq p (plist-put p (cdr o)
  78                                    (cons (car (read-from-string
  79                                                (match-string 1 options)))
  80                                          (plist-get p (cdr o)))))
  81                 p)
  82             (if (string-match (concat (regexp-quote (car o)) regexp)
  83                               options)
  84                 (setq p (plist-put p (cdr o)
  85                                    (car (read-from-string
  86                                          (match-string 1 options)))))))))))
  87   p)
  88
  89 (defun org-plot/goto-nearest-table ()
  90   "Move the point forward to the beginning of nearest table.
  91 Return value is the point at the beginning of the table."
  92   (interactive) (move-beginning-of-line 1)
  93   (while (not (or (org-at-table-p) (< 0 (forward-line 1)))))
  94   (goto-char (org-table-begin)))
  95
  96 (defun org-plot/collect-options (&optional params)
  97   "Collect options from an org-plot '#+Plot:' line.
  98 Accepts an optional property list PARAMS, to which the options
  99 will be added.  Returns the resulting property list."
 100   (interactive)
 101   (let ((line (thing-at-point 'line)))
 102     (if (string-match "#\\+PLOT: +\\(.*\\)$" line)
 103         (org-plot/add-options-to-plist params (match-string 1 line))
 104       params)))
 105
 106 (defun org-plot-quote-timestamp-field (s)
 107   "Convert field S from timestamp to Unix time and export to gnuplot."
 108   (format-time-string org-plot-timestamp-fmt (org-time-string-to-time s)))
 109
 110 (defun org-plot-quote-tsv-field (s)
 111   "Quote field S for export to gnuplot."
 112   (if (string-match org-table-number-regexp s) s
 113     (if (string-match org-ts-regexp3 s)
 114         (org-plot-quote-timestamp-field s)
 115       (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\""))))
 116
 117 (defun org-plot/gnuplot-to-data (table data-file params)
 118   "Export TABLE to DATA-FILE in a format readable by gnuplot.
 119 Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
 120   (with-temp-file
 121       data-file
 122     (make-local-variable 'org-plot-timestamp-fmt)
 123     (setq org-plot-timestamp-fmt (or
 124                                   (plist-get params :timefmt)
 125                                   "%Y-%m-%d-%H:%M:%S"))
 126     (insert (orgtbl-to-generic
 127              table
 128              (org-combine-plists
 129               '(:sep "\t" :fmt org-plot-quote-tsv-field)
 130               params))))
 131   nil)
 132
 133 (defun org-plot/gnuplot-to-grid-data (table data-file params)
 134   "Export the data in TABLE to DATA-FILE for gnuplot.
 135 This means in a format appropriate for grid plotting by gnuplot.
 136 PARAMS specifies which columns of TABLE should be plotted as independent
 137 and dependant variables."
 138   (interactive)
 139   (let* ((ind (- (plist-get params :ind) 1))
 140          (deps (if (plist-member params :deps)
 141                    (mapcar (lambda (val) (- val 1)) (plist-get params :deps))
 142                  (let (collector)
 143                    (dotimes (col (length (first table)))
 144                      (setf collector (cons col collector)))
 145                    collector)))
 146          (counter 0)
 147          row-vals)
 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             (gnuplot-row (lambda (col row value)
 163                            (setf col (+ 1 col)) (setf row (+ 1 row))
 164                            (format "%f  %f  %f\n%f  %f  %f\n"
 165                                    col (- row 0.5) value ;; lower edge
 166                                    col (+ row 0.5) value))) ;; upper edge
 167             front-edge back-edge)
 168         (dotimes (col num-cols)
 169           (dotimes (row num-rows)
 170             (setf back-edge
 171                   (concat back-edge
 172                           (funcall gnuplot-row (- col 1) row
 173                                    (string-to-number (nth col (nth row table))))))
 174             (setf front-edge
 175                   (concat front-edge
 176                           (funcall gnuplot-row col row
 177                                    (string-to-number (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 &optional preface)
 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 Optional argument PREFACE returns only option parameters in a
 188 manner suitable for prepending to a user-specified script."
 189   (let* ((type (plist-get params :plot-type))
 190          (with (if (eq type 'grid) 'pm3d (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")
 210          ;; ats = add-to-script
 211          (ats (lambda (line) (setf script (concat script "\n" line))))
 212          plot-lines)
 213     (when file                          ; output file
 214       (funcall ats (format "set term %s" (file-name-extension file)))
 215       (funcall ats (format "set output '%s'" file)))
 216     (case type                          ; type
 217       (2d ())
 218       (3d (when map (funcall ats "set map")))
 219       (grid (if map (funcall ats "set pm3d map") (funcall ats "set pm3d"))))
 220     (when title (funcall ats (format "set title '%s'" title))) ; title
 221     (mapc ats lines)                                           ; line
 222     (dolist (el sets) (funcall ats (format "set %s" el)))      ; set
 223     ;; Unless specified otherwise, values are TAB separated.
 224     (unless (org-string-match-p "^set datafile separator" script)
 225       (funcall ats "set datafile separator \"\\t\""))
 226     (when x-labels                      ; x labels (xtics)
 227       (funcall ats
 228                (format "set xtics (%s)"
 229                        (mapconcat (lambda (pair)
 230                                     (format "\"%s\" %d" (cdr pair) (car pair)))
 231                                   x-labels ", "))))
 232     (when y-labels                      ; y labels (ytics)
 233       (funcall ats
 234                (format "set ytics (%s)"
 235                        (mapconcat (lambda (pair)
 236                                     (format "\"%s\" %d" (cdr pair) (car pair)))
 237                                   y-labels ", "))))
 238     (when time-ind                      ; timestamp index
 239       (funcall ats "set xdata time")
 240       (funcall ats (concat "set timefmt \""
 241                            (or timefmt  ; timefmt passed to gnuplot
 242                                "%Y-%m-%d-%H:%M:%S") "\"")))
 243     (unless preface
 244       (case type                        ; plot command
 245         (2d (dotimes (col num-cols)
 246               (unless (and (eq type '2d)
 247                            (or (and ind (equal (1+ col) ind))
 248                                (and deps (not (member (1+ col) deps)))))
 249                 (setf plot-lines
 250                       (cons
 251                        (format plot-str data-file
 252                                (or (and ind (> ind 0)
 253                                         (not text-ind)
 254                                         (format "%d:" ind)) "")
 255                                (1+ col)
 256                                (if text-ind (format ":xticlabel(%d)" ind) "")
 257                                with
 258                                (or (nth col col-labels) (format "%d" (1+ col))))
 259                        plot-lines)))))
 260         (3d
 261          (setq plot-lines (list (format "'%s' matrix with %s title ''"
 262                                         data-file with))))
 263         (grid
 264          (setq plot-lines (list (format "'%s' with %s title ''"
 265                                         data-file with)))))
 266       (funcall ats
 267                (concat plot-cmd " " (mapconcat #'identity
 268                                                (reverse plot-lines)
 269                                                ",\\\n    "))))
 270     script))
 271
 272 ;;-----------------------------------------------------------------------------
 273 ;; facade functions
 274 ;;;###autoload
 275 (defun org-plot/gnuplot (&optional params)
 276   "Plot table using gnuplot.  Gnuplot options can be specified with PARAMS.
 277 If not given options will be taken from the +PLOT
 278 line directly before or after the table."
 279   (interactive)
 280   (require 'gnuplot)
 281   (save-window-excursion
 282     (delete-other-windows)
 283     (when (get-buffer "*gnuplot*") ; reset *gnuplot* if it already running
 284       (with-current-buffer "*gnuplot*"
 285         (goto-char (point-max))))
 286     (org-plot/goto-nearest-table)
 287     ;; Set default options.
 288     (dolist (pair org-plot/gnuplot-default-options)
 289       (unless (plist-member params (car pair))
 290         (setf params (plist-put params (car pair) (cdr pair)))))
 291     ;; collect table and table information
 292     (let* ((data-file (make-temp-file "org-plot"))
 293            (table (org-table-to-lisp))
 294            (num-cols (length (if (eq (first table) 'hline) (second table)
 295                                (first table)))))
 296       (run-with-idle-timer 0.1 nil #'delete-file data-file)
 297       (while (eq 'hline (car table)) (setf table (cdr table)))
 298       (when (eq (cadr table) 'hline)
 299         (setf params (plist-put params :labels (first table))) ; headers to labels
 300         (setf table (delq 'hline (cdr table)))) ; clean non-data from table
 301       ;; Collect options.
 302       (save-excursion (while (and (equal 0 (forward-line -1))
 303                                   (looking-at "[[:space:]]*#\\+"))
 304                         (setf params (org-plot/collect-options params))))
 305       ;; Dump table to datafile (very different for grid).
 306       (case (plist-get params :plot-type)
 307         (2d   (org-plot/gnuplot-to-data table data-file params))
 308         (3d   (org-plot/gnuplot-to-data table data-file params))
 309         (grid (let ((y-labels (org-plot/gnuplot-to-grid-data
 310                                table data-file params)))
 311                 (when y-labels (plist-put params :ylabels y-labels)))))
 312       ;; Check for timestamp ind column.
 313       (let ((ind (1- (plist-get params :ind))))
 314         (when (and (>= ind 0) (eq '2d (plist-get params :plot-type)))
 315           (if (= (length
 316                   (delq 0 (mapcar
 317                            (lambda (el)
 318                              (if (string-match org-ts-regexp3 el) 0 1))
 319                            (mapcar (lambda (row) (nth ind row)) table))))
 320                  0)
 321               (plist-put params :timeind t)
 322             ;; Check for text ind column.
 323             (if (or (string= (plist-get params :with) "hist")
 324                     (> (length
 325                         (delq 0 (mapcar
 326                                  (lambda (el)
 327                                    (if (string-match org-table-number-regexp el)
 328                                        0 1))
 329                                  (mapcar (lambda (row) (nth ind row)) table))))
 330                        0))
 331                 (plist-put params :textind t)))))
 332       ;; Write script.
 333       (with-temp-buffer
 334         (if (plist-get params :script)  ; user script
 335             (progn (insert
 336                     (org-plot/gnuplot-script data-file num-cols params t))
 337                    (insert "\n")
 338                    (insert-file-contents (plist-get params :script))
 339                    (goto-char (point-min))
 340                    (while (re-search-forward "$datafile" nil t)
 341                      (replace-match data-file nil nil)))
 342           (insert (org-plot/gnuplot-script data-file num-cols params)))
 343         ;; Graph table.
 344         (gnuplot-mode)
 345         (gnuplot-send-buffer-to-gnuplot))
 346       ;; Cleanup.
 347       (bury-buffer (get-buffer "*gnuplot*")))))
 348
 349 (provide 'org-plot)
 350
 351 ;; Local variables:
 352 ;; generated-autoload-file: "org-loaddefs.el"
 353 ;; End:
 354
 355 ;;; org-plot.el ends here