lisp/org-plot.el

   1 ;;; org-plot.el --- Support for Plotting from Org -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2008-2019 Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Eric Schulte <schulte dot eric at gmail dot com>
   6 ;; Keywords: tables, plotting
   7 ;; Homepage: https://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 <https://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 mailing list for testing and implementation and
  29 ;; feature suggestions
  30
  31 ;;; Code:
  32
  33 (require 'cl-lib)
  34 (require 'org)
  35 (require 'org-table)
  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   (when options
  53     (let ((op '(("type"    . :plot-type)
  54                 ("script"  . :script)
  55                 ("line"    . :line)
  56                 ("set"     . :set)
  57                 ("title"   . :title)
  58                 ("ind"     . :ind)
  59                 ("deps"    . :deps)
  60                 ("with"    . :with)
  61                 ("file"    . :file)
  62                 ("labels"  . :labels)
  63                 ("map"     . :map)
  64                 ("timeind" . :timeind)
  65                 ("timefmt" . :timefmt)))
  66           (multiples '("set" "line"))
  67           (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)")
  68           (start 0))
  69       (dolist (o 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-timestamp-field (s)
 105   "Convert field S from timestamp to Unix time and export to gnuplot."
 106   (format-time-string org-plot-timestamp-fmt (org-time-string-to-time s)))
 107
 108 (defun org-plot-quote-tsv-field (s)
 109   "Quote field S for export to gnuplot."
 110   (if (string-match org-table-number-regexp s) s
 111     (if (string-match org-ts-regexp3 s)
 112         (org-plot-quote-timestamp-field s)
 113       (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\""))))
 114
 115 (defun org-plot/gnuplot-to-data (table data-file params)
 116   "Export TABLE to DATA-FILE in a format readable by gnuplot.
 117 Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
 118   (with-temp-file
 119       data-file
 120     (setq-local org-plot-timestamp-fmt (or
 121                                         (plist-get params :timefmt)
 122                                         "%Y-%m-%d-%H:%M:%S"))
 123     (insert (orgtbl-to-generic
 124              table
 125              (org-combine-plists
 126               '(:sep "\t" :fmt org-plot-quote-tsv-field)
 127               params))))
 128   nil)
 129
 130 (defun org-plot/gnuplot-to-grid-data (table data-file params)
 131   "Export the data in TABLE to DATA-FILE for gnuplot.
 132 This means in a format appropriate for grid plotting by gnuplot.
 133 PARAMS specifies which columns of TABLE should be plotted as independent
 134 and dependant variables."
 135   (interactive)
 136   (let* ((ind (- (plist-get params :ind) 1))
 137          (deps (if (plist-member params :deps)
 138                    (mapcar (lambda (val) (- val 1)) (plist-get params :deps))
 139                  (let (collector)
 140                    (dotimes (col (length (nth 0 table)))
 141                      (setf collector (cons col collector)))
 142                    collector)))
 143          (counter 0)
 144          row-vals)
 145     (when (>= ind 0) ;; collect values of ind col
 146       (setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter))
 147                                (cons counter (nth ind row))) table)))
 148     (when (or deps (>= ind 0)) ;; remove non-plotting columns
 149       (setf deps (delq ind deps))
 150       (setf table (mapcar (lambda (row)
 151                             (dotimes (col (length row))
 152                               (unless (memq col deps)
 153                                 (setf (nth col row) nil)))
 154                             (delq nil row))
 155                           table)))
 156     ;; write table to gnuplot grid datafile format
 157     (with-temp-file data-file
 158       (let ((num-rows (length table)) (num-cols (length (nth 0 table)))
 159             (gnuplot-row (lambda (col row value)
 160                            (setf col (+ 1 col)) (setf row (+ 1 row))
 161                            (format "%f  %f  %f\n%f  %f  %f\n"
 162                                    col (- row 0.5) value ;; lower edge
 163                                    col (+ row 0.5) value))) ;; upper edge
 164             front-edge back-edge)
 165         (dotimes (col num-cols)
 166           (dotimes (row num-rows)
 167             (setf back-edge
 168                   (concat back-edge
 169                           (funcall gnuplot-row (- col 1) row
 170                                    (string-to-number (nth col (nth row table))))))
 171             (setf front-edge
 172                   (concat front-edge
 173                           (funcall gnuplot-row col row
 174                                    (string-to-number (nth col (nth row table)))))))
 175           ;; only insert once per row
 176           (insert back-edge) (insert "\n") ;; back edge
 177           (insert front-edge) (insert "\n") ;; front edge
 178           (setf back-edge "") (setf front-edge ""))))
 179     row-vals))
 180
 181 (defun org-plot/gnuplot-script (data-file num-cols params &optional preface)
 182   "Write a gnuplot script to DATA-FILE respecting the options set in PARAMS.
 183 NUM-COLS controls the number of columns plotted in a 2-d plot.
 184 Optional argument PREFACE returns only option parameters in a
 185 manner suitable for prepending to a user-specified script."
 186   (let* ((type (plist-get params :plot-type))
 187          (with (if (eq type 'grid) 'pm3d (plist-get params :with)))
 188          (sets (plist-get params :set))
 189          (lines (plist-get params :line))
 190          (map (plist-get params :map))
 191          (title (plist-get params :title))
 192          (file (plist-get params :file))
 193          (ind (plist-get params :ind))
 194          (time-ind (plist-get params :timeind))
 195          (timefmt (plist-get params :timefmt))
 196          (text-ind (plist-get params :textind))
 197          (deps (if (plist-member params :deps) (plist-get params :deps)))
 198          (col-labels (plist-get params :labels))
 199          (x-labels (plist-get params :xlabels))
 200          (y-labels (plist-get params :ylabels))
 201          (plot-str "'%s' using %s%d%s with %s title '%s'")
 202          (plot-cmd (pcase type
 203                      (`2d "plot")
 204                      (`3d "splot")
 205                      (`grid "splot")))
 206          (script "reset")
 207          ;; ats = add-to-script
 208          (ats (lambda (line) (setf script (concat script "\n" line))))
 209          plot-lines)
 210     (when file                          ; output file
 211       (funcall ats (format "set term %s" (file-name-extension file)))
 212       (funcall ats (format "set output '%s'" file)))
 213     (pcase type                         ; type
 214       (`2d ())
 215       (`3d (when map (funcall ats "set map")))
 216       (`grid (funcall ats (if map "set pm3d map" "set pm3d"))))
 217     (when title (funcall ats (format "set title '%s'" title))) ; title
 218     (mapc ats lines)                                           ; line
 219     (dolist (el sets) (funcall ats (format "set %s" el)))      ; set
 220     ;; Unless specified otherwise, values are TAB separated.
 221     (unless (string-match-p "^set datafile separator" script)
 222       (funcall ats "set datafile separator \"\\t\""))
 223     (when x-labels                      ; x labels (xtics)
 224       (funcall ats
 225                (format "set xtics (%s)"
 226                        (mapconcat (lambda (pair)
 227                                     (format "\"%s\" %d" (cdr pair) (car pair)))
 228                                   x-labels ", "))))
 229     (when y-labels                      ; y labels (ytics)
 230       (funcall ats
 231                (format "set ytics (%s)"
 232                        (mapconcat (lambda (pair)
 233                                     (format "\"%s\" %d" (cdr pair) (car pair)))
 234                                   y-labels ", "))))
 235     (when time-ind                      ; timestamp index
 236       (funcall ats "set xdata time")
 237       (funcall ats (concat "set timefmt \""
 238                            (or timefmt  ; timefmt passed to gnuplot
 239                                "%Y-%m-%d-%H:%M:%S") "\"")))
 240     (unless preface
 241       (pcase type                       ; plot command
 242         (`2d (dotimes (col num-cols)
 243                (unless (and (eq 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 ind (> ind 0)
 250                                          (not text-ind)
 251                                          (format "%d:" ind)) "")
 252                                 (1+ col)
 253                                 (if text-ind (format ":xticlabel(%d)" ind) "")
 254                                 with
 255                                 (or (nth col col-labels)
 256                                     (format "%d" (1+ col))))
 257                         plot-lines)))))
 258         (`3d
 259          (setq plot-lines (list (format "'%s' matrix with %s title ''"
 260                                         data-file with))))
 261         (`grid
 262          (setq plot-lines (list (format "'%s' with %s title ''"
 263                                         data-file with)))))
 264       (funcall ats
 265                (concat plot-cmd " " (mapconcat #'identity
 266                                                (reverse plot-lines)
 267                                                ",\\\n    "))))
 268     script))
 269
 270 ;;-----------------------------------------------------------------------------
 271 ;; facade functions
 272 ;;;###autoload
 273 (defun org-plot/gnuplot (&optional params)
 274   "Plot table using gnuplot.  Gnuplot options can be specified with PARAMS.
 275 If not given options will be taken from the +PLOT
 276 line directly before or after the table."
 277   (interactive)
 278   (require 'gnuplot)
 279   (save-window-excursion
 280     (delete-other-windows)
 281     (when (get-buffer "*gnuplot*") ; reset *gnuplot* if it already running
 282       (with-current-buffer "*gnuplot*"
 283         (goto-char (point-max))))
 284     (org-plot/goto-nearest-table)
 285     ;; Set default options.
 286     (dolist (pair org-plot/gnuplot-default-options)
 287       (unless (plist-member params (car pair))
 288         (setf params (plist-put params (car pair) (cdr pair)))))
 289     ;; collect table and table information
 290     (let* ((data-file (make-temp-file "org-plot"))
 291            (table (org-table-to-lisp))
 292            (num-cols (length (if (eq (nth 0 table) 'hline) (nth 1 table)
 293                                (nth 0 table)))))
 294       (run-with-idle-timer 0.1 nil #'delete-file data-file)
 295       (while (eq 'hline (car table)) (setf table (cdr table)))
 296       (when (eq (cadr table) 'hline)
 297         (setf params
 298               (plist-put params :labels (nth 0 table))) ; headers to labels
 299         (setf table (delq 'hline (cdr table)))) ; clean non-data from table
 300       ;; Collect options.
 301       (save-excursion (while (and (equal 0 (forward-line -1))
 302                                   (looking-at "[[:space:]]*#\\+"))
 303                         (setf params (org-plot/collect-options params))))
 304       ;; Dump table to datafile (very different for grid).
 305       (pcase (plist-get params :plot-type)
 306         (`2d   (org-plot/gnuplot-to-data table data-file params))
 307         (`3d   (org-plot/gnuplot-to-data table data-file params))
 308         (`grid (let ((y-labels (org-plot/gnuplot-to-grid-data
 309                                 table data-file params)))
 310                  (when y-labels (plist-put params :ylabels y-labels)))))
 311       ;; Check for timestamp ind column.
 312       (let ((ind (1- (plist-get params :ind))))
 313         (when (and (>= ind 0) (eq '2d (plist-get params :plot-type)))
 314           (if (= (length
 315                   (delq 0 (mapcar
 316                            (lambda (el)
 317                              (if (string-match org-ts-regexp3 el) 0 1))
 318                            (mapcar (lambda (row) (nth ind row)) table))))
 319                  0)
 320               (plist-put params :timeind t)
 321             ;; Check for text ind column.
 322             (if (or (string= (plist-get params :with) "hist")
 323                     (> (length
 324                         (delq 0 (mapcar
 325                                  (lambda (el)
 326                                    (if (string-match org-table-number-regexp el)
 327                                        0 1))
 328                                  (mapcar (lambda (row) (nth ind row)) table))))
 329                        0))
 330                 (plist-put params :textind t)))))
 331       ;; Write script.
 332       (with-temp-buffer
 333         (if (plist-get params :script)  ; user script
 334             (progn (insert
 335                     (org-plot/gnuplot-script data-file num-cols params t))
 336                    (insert "\n")
 337                    (insert-file-contents (plist-get params :script))
 338                    (goto-char (point-min))
 339                    (while (re-search-forward "\\$datafile" nil t)
 340                      (replace-match data-file nil nil)))
 341           (insert (org-plot/gnuplot-script data-file num-cols params)))
 342         ;; Graph table.
 343         (gnuplot-mode)
 344         (gnuplot-send-buffer-to-gnuplot))
 345       ;; Cleanup.
 346       (bury-buffer (get-buffer "*gnuplot*")))))
 347
 348 (provide 'org-plot)
 349
 350 ;; Local variables:
 351 ;; generated-autoload-file: "org-loaddefs.el"
 352 ;; End:
 353
 354 ;;; org-plot.el ends here