lisp/org-plot.el

   1 ;;; org-plot.el --- Support for plotting from Org-mode
   2
   3 ;; Copyright (C) 2008-2016 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     (setq-local org-plot-timestamp-fmt (or
 123                                         (plist-get params :timefmt)
 124                                         "%Y-%m-%d-%H:%M:%S"))
 125     (insert (orgtbl-to-generic
 126              table
 127              (org-combine-plists
 128               '(:sep "\t" :fmt org-plot-quote-tsv-field)
 129               params))))
 130   nil)
 131
 132 (defun org-plot/gnuplot-to-grid-data (table data-file params)
 133   "Export the data in TABLE to DATA-FILE for gnuplot.
 134 This means in a format appropriate for grid plotting by gnuplot.
 135 PARAMS specifies which columns of TABLE should be plotted as independent
 136 and dependant variables."
 137   (interactive)
 138   (let* ((ind (- (plist-get params :ind) 1))
 139          (deps (if (plist-member params :deps)
 140                    (mapcar (lambda (val) (- val 1)) (plist-get params :deps))
 141                  (let (collector)
 142                    (dotimes (col (length (first table)))
 143                      (setf collector (cons col collector)))
 144                    collector)))
 145          (counter 0)
 146          row-vals)
 147     (when (>= ind 0) ;; collect values of ind col
 148       (setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter))
 149                                (cons counter (nth ind row))) table)))
 150     (when (or deps (>= ind 0)) ;; remove non-plotting columns
 151       (setf deps (delq ind deps))
 152       (setf table (mapcar (lambda (row)
 153                             (dotimes (col (length row))
 154                               (unless (memq col deps)
 155                                 (setf (nth col row) nil)))
 156                             (delq nil row))
 157                           table)))
 158     ;; write table to gnuplot grid datafile format
 159     (with-temp-file data-file
 160       (let ((num-rows (length table)) (num-cols (length (first table)))
 161             (gnuplot-row (lambda (col row value)
 162                            (setf col (+ 1 col)) (setf row (+ 1 row))
 163                            (format "%f  %f  %f\n%f  %f  %f\n"
 164                                    col (- row 0.5) value ;; lower edge
 165                                    col (+ row 0.5) value))) ;; upper edge
 166             front-edge back-edge)
 167         (dotimes (col num-cols)
 168           (dotimes (row num-rows)
 169             (setf back-edge
 170                   (concat back-edge
 171                           (funcall gnuplot-row (- col 1) row
 172                                    (string-to-number (nth col (nth row table))))))
 173             (setf front-edge
 174                   (concat front-edge
 175                           (funcall gnuplot-row col row
 176                                    (string-to-number (nth col (nth row table)))))))
 177           ;; only insert once per row
 178           (insert back-edge) (insert "\n") ;; back edge
 179           (insert front-edge) (insert "\n") ;; front edge
 180           (setf back-edge "") (setf front-edge ""))))
 181     row-vals))
 182
 183 (defun org-plot/gnuplot-script (data-file num-cols params &optional preface)
 184   "Write a gnuplot script to DATA-FILE respecting the options set in PARAMS.
 185 NUM-COLS controls the number of columns plotted in a 2-d plot.
 186 Optional argument PREFACE returns only option parameters in a
 187 manner suitable for prepending to a user-specified script."
 188   (let* ((type (plist-get params :plot-type))
 189          (with (if (eq type 'grid) 'pm3d (plist-get params :with)))
 190          (sets (plist-get params :set))
 191          (lines (plist-get params :line))
 192          (map (plist-get params :map))
 193          (title (plist-get params :title))
 194          (file (plist-get params :file))
 195          (ind (plist-get params :ind))
 196          (time-ind (plist-get params :timeind))
 197          (timefmt (plist-get params :timefmt))
 198          (text-ind (plist-get params :textind))
 199          (deps (if (plist-member params :deps) (plist-get params :deps)))
 200          (col-labels (plist-get params :labels))
 201          (x-labels (plist-get params :xlabels))
 202          (y-labels (plist-get params :ylabels))
 203          (plot-str "'%s' using %s%d%s with %s title '%s'")
 204          (plot-cmd (case type
 205                      ('2d "plot")
 206                      ('3d "splot")
 207                      ('grid "splot")))
 208          (script "reset")
 209          ;; ats = add-to-script
 210          (ats (lambda (line) (setf script (concat script "\n" line))))
 211          plot-lines)
 212     (when file                          ; output file
 213       (funcall ats (format "set term %s" (file-name-extension file)))
 214       (funcall ats (format "set output '%s'" file)))
 215     (case type                          ; type
 216       (2d ())
 217       (3d (when map (funcall ats "set map")))
 218       (grid (if map (funcall ats "set pm3d map") (funcall ats "set pm3d"))))
 219     (when title (funcall ats (format "set title '%s'" title))) ; title
 220     (mapc ats lines)                                           ; line
 221     (dolist (el sets) (funcall ats (format "set %s" el)))      ; set
 222     ;; Unless specified otherwise, values are TAB separated.
 223     (unless (org-string-match-p "^set datafile separator" script)
 224       (funcall ats "set datafile separator \"\\t\""))
 225     (when x-labels                      ; x labels (xtics)
 226       (funcall ats
 227                (format "set xtics (%s)"
 228                        (mapconcat (lambda (pair)
 229                                     (format "\"%s\" %d" (cdr pair) (car pair)))
 230                                   x-labels ", "))))
 231     (when y-labels                      ; y labels (ytics)
 232       (funcall ats
 233                (format "set ytics (%s)"
 234                        (mapconcat (lambda (pair)
 235                                     (format "\"%s\" %d" (cdr pair) (car pair)))
 236                                   y-labels ", "))))
 237     (when time-ind                      ; timestamp index
 238       (funcall ats "set xdata time")
 239       (funcall ats (concat "set timefmt \""
 240                            (or timefmt  ; timefmt passed to gnuplot
 241                                "%Y-%m-%d-%H:%M:%S") "\"")))
 242     (unless preface
 243       (case type                        ; plot command
 244         (2d (dotimes (col num-cols)
 245               (unless (and (eq type '2d)
 246                            (or (and ind (equal (1+ col) ind))
 247                                (and deps (not (member (1+ col) deps)))))
 248                 (setf plot-lines
 249                       (cons
 250                        (format plot-str data-file
 251                                (or (and ind (> ind 0)
 252                                         (not text-ind)
 253                                         (format "%d:" ind)) "")
 254                                (1+ col)
 255                                (if text-ind (format ":xticlabel(%d)" ind) "")
 256                                with
 257                                (or (nth col col-labels) (format "%d" (1+ col))))
 258                        plot-lines)))))
 259         (3d
 260          (setq plot-lines (list (format "'%s' matrix with %s title ''"
 261                                         data-file with))))
 262         (grid
 263          (setq plot-lines (list (format "'%s' with %s title ''"
 264                                         data-file with)))))
 265       (funcall ats
 266                (concat plot-cmd " " (mapconcat #'identity
 267                                                (reverse plot-lines)
 268                                                ",\\\n    "))))
 269     script))
 270
 271 ;;-----------------------------------------------------------------------------
 272 ;; facade functions
 273 ;;;###autoload
 274 (defun org-plot/gnuplot (&optional params)
 275   "Plot table using gnuplot.  Gnuplot options can be specified with PARAMS.
 276 If not given options will be taken from the +PLOT
 277 line directly before or after the table."
 278   (interactive)
 279   (require 'gnuplot)
 280   (save-window-excursion
 281     (delete-other-windows)
 282     (when (get-buffer "*gnuplot*") ; reset *gnuplot* if it already running
 283       (with-current-buffer "*gnuplot*"
 284         (goto-char (point-max))))
 285     (org-plot/goto-nearest-table)
 286     ;; Set default options.
 287     (dolist (pair org-plot/gnuplot-default-options)
 288       (unless (plist-member params (car pair))
 289         (setf params (plist-put params (car pair) (cdr pair)))))
 290     ;; collect table and table information
 291     (let* ((data-file (make-temp-file "org-plot"))
 292            (table (org-table-to-lisp))
 293            (num-cols (length (if (eq (first table) 'hline) (second table)
 294                                (first table)))))
 295       (run-with-idle-timer 0.1 nil #'delete-file data-file)
 296       (while (eq 'hline (car table)) (setf table (cdr table)))
 297       (when (eq (cadr table) 'hline)
 298         (setf params (plist-put params :labels (first 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       (case (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