| commit | author | age | ||
| 76bbd0 | 1 | ;;; org-plot.el --- Support for Plotting from Org -*- lexical-binding: t; -*- |
| C | 2 | |
| 3 | ;; Copyright (C) 2008-2018 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 | |
