lisp/org-babel-R.el

   1 ;;; org-babel-R.el --- org-babel functions for R code evaluation
   2
   3 ;; Copyright (C) 2009 Eric Schulte
   4
   5 ;; Author: Eric Schulte
   6 ;; Keywords: literate programming, reproducible research, R, statistics
   7 ;; Homepage: http://orgmode.org
   8 ;; Version: 0.01
   9
  10 ;;; License:
  11
  12 ;; This program 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, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program 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; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; Org-Babel support for evaluating R code
  30
  31 ;;; Code:
  32 (require 'org-babel)
  33
  34 (org-babel-add-interpreter "R")
  35
  36 (defun org-babel-execute:R (body params)
  37   "Execute a block of R code with org-babel.  This function is
  38 called by `org-babel-execute-src-block'."
  39   (message "executing R source code block...")
  40   (save-window-excursion
  41     (let ((vars (org-babel-ref-variables params))
  42           results)
  43       (org-babel-R-initiate-R-buffer)
  44       (mapc (lambda (pair) (org-babel-R-assign-elisp (car pair) (cdr pair))) vars)
  45       (org-babel-R-input-command body)
  46       (org-babel-R-last-value-as-elisp))))
  47
  48 (defun org-babel-R-quote-tsv-field (s)
  49   "Quote field S for export to R."
  50   (if (stringp s)
  51       (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
  52     (format "%S" s)))
  53
  54 (defun org-babel-R-assign-elisp (name value)
  55   "Read the elisp VALUE into a variable named NAME in the current
  56 R process in `org-babel-R-buffer'."
  57   (unless org-babel-R-buffer (error "No active R buffer"))
  58   (org-babel-R-input-command
  59    (if (listp value)
  60        (let ((transition-file (make-temp-file "org-babel-R-import")))
  61          ;; ensure VALUE has an orgtbl structure (depth of at least 2)
  62          (unless (listp (car value)) (setq value (list value)))
  63          (with-temp-file transition-file
  64            (insert (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)))
  65            (insert "\n"))
  66          (format "%s <- read.table(\"%s\", header=FALSE, sep=\"\\t\", as.is=TRUE)"
  67                  name transition-file))
  68      (format "%s <- %s" name (org-babel-R-quote-tsv-field value)))))
  69
  70 (defun org-babel-R-last-value-as-elisp ()
  71   "Return the last value returned by R as Emacs lisp."
  72   (let ((tmp-file (make-temp-file "org-babel-R")) result)
  73     (org-babel-R-input-command
  74      (format "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=FALSE, col.names=FALSE, quote=FALSE)"
  75               tmp-file))
  76     (with-temp-buffer
  77       (condition-case nil
  78           (progn
  79             (org-table-import tmp-file nil)
  80             (delete-file tmp-file)
  81             (setq result (mapcar (lambda (row)
  82                                    (mapcar #'org-babel-R-read row))
  83                                  (org-table-to-lisp))))
  84
  85         (error nil))
  86       (if (null (cdr result)) ;; if result is trivial vector, then scalarize it
  87           (if (consp (car result))
  88               (if (null (cdr (car result)))
  89                   (caar result)
  90                 result)
  91             (car result))
  92         result))))
  93
  94 (defun org-babel-R-read (cell)
  95   "Strip nested \"s from around strings in exported R values."
  96   (org-babel-read (or (and (stringp cell)
  97                          (string-match "\\\"\\(.+\\)\\\"" cell)
  98                          (match-string 1 cell))
  99                     cell)))
 100
 101 ;; functions for evaluation of R code
 102 (defvar org-babel-R-buffer nil
 103   "Holds the buffer for the current R process")
 104
 105 (defun org-babel-R-initiate-R-buffer ()
 106   "If there is not a current R process then create one."
 107   (unless (and (buffer-live-p org-babel-R-buffer) (get-buffer org-babel-R-buffer))
 108     (save-excursion
 109       (R)
 110       (setf org-babel-R-buffer (current-buffer))
 111       (org-babel-R-wait-for-output)
 112       (org-babel-R-input-command ""))))
 113
 114 (defun org-babel-R-command-to-string (command)
 115   "Send a command to R, and return the results as a string."
 116   (org-babel-R-input-command command)
 117   (org-babel-R-last-output))
 118
 119 (defun org-babel-R-input-command (command)
 120   "Pass COMMAND to the R process running in `org-babel-R-buffer'."
 121   (save-excursion
 122     (save-match-data
 123       (set-buffer org-babel-R-buffer)
 124       (goto-char (process-mark (get-buffer-process (current-buffer))))
 125       (insert command)
 126       (comint-send-input)
 127       (org-babel-R-wait-for-output))))
 128
 129 (defun org-babel-R-wait-for-output ()
 130   "Wait until output arrives"
 131   (save-excursion
 132     (save-match-data
 133       (set-buffer org-babel-R-buffer)
 134       (while (progn
 135                (goto-char comint-last-input-end)
 136                (not (re-search-forward comint-prompt-regexp nil t)))
 137         (accept-process-output (get-buffer-process (current-buffer)))))))
 138
 139 (defun org-babel-R-last-output ()
 140   "Return the last R output as a string"
 141   (save-excursion
 142     (save-match-data
 143       (set-buffer org-babel-R-buffer)
 144       (goto-char (process-mark (get-buffer-process (current-buffer))))
 145       (forward-line 0)
 146       (let ((raw (buffer-substring comint-last-input-end (- (point) 1)))
 147             output output-flag)
 148         (mapconcat
 149          (lambda (el)
 150            (if (stringp el)
 151                (format "%s" el)
 152              (format "%S" el)))
 153          (delq nil
 154                (mapcar
 155                 (lambda (line)
 156                   (unless (string-match "^>" line)
 157                     (and (string-match "\\[[[:digit:]]+\\] *\\(.*\\)$" line)
 158                          (match-string 1 line))))
 159                 ;; drop first, because it's the last line of input
 160                 (cdr (split-string raw "[\n\r]")))) "\n")))))
 161
 162 (provide 'org-babel-R)
 163 ;;; org-babel-R.el ends here