lisp/org-plot.el

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