1 ;;; org-babel-R.el --- org-babel functions for R code evaluation
3 ;; Copyright (C) 2009 Eric Schulte
5 ;; Author: Eric Schulte
6 ;; Keywords: literate programming, reproducible research, R, statistics
7 ;; Homepage: http://orgmode.org
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)
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.
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.
29 ;; Org-Babel support for evaluating R code
34 (org-babel-add-interpreter "R")
36 (add-to-list 'org-babel-tangle-langs
'("R" "r"))
38 (defun org-babel-execute:R
(body params
)
39 "Execute a block of R code with org-babel. This function is
40 called by `org-babel-execute-src-block' via multiple-value-bind."
41 (message "executing R source code block...")
42 (save-window-excursion
43 (let* ((session (org-babel-R-initiate-session session
))
44 (column-names-p (cdr (assoc :colnames params
)))
45 (out-file (cdr (assoc :file params
)))
48 (if out-file
(concat (org-babel-R-construct-graphics-device-call out-file params
) "\n") "")
49 (mapconcat ;; define any variables
50 (lambda (pair) (org-babel-R-assign-elisp (car pair
) (cdr pair
))) vars
"\n")
51 "\n" body
"\n" (if out-file
"dev.off()\n" "")))
52 (result (org-babel-R-evaluate session augmented-body result-type column-names-p
)))
53 (or out-file result
))))
55 (defun org-babel-prep-session:R
(session params
)
56 "Prepare SESSION according to the header arguments specified in PARAMS."
57 (let* ((session (org-babel-R-initiate-session session
))
58 (vars (org-babel-ref-variables params
)))
59 (mapc (lambda (pair) (org-babel-R-assign-elisp session
(car pair
) (cdr pair
))) vars
)))
63 (defun org-babel-R-quote-tsv-field (s)
64 "Quote field S for export to R."
66 (concat "\"" (mapconcat 'identity
(split-string s
"\"") "\"\"") "\"")
69 (defun org-babel-R-assign-elisp (name value
)
70 "Read the elisp VALUE into a variable named NAME."
72 (let ((transition-file (make-temp-file "org-babel-R-import")))
73 ;; ensure VALUE has an orgtbl structure (depth of at least 2)
74 (unless (listp (car value
)) (setq value
(list value
)))
75 (with-temp-file transition-file
76 (insert (orgtbl-to-tsv value
'(:fmt org-babel-R-quote-tsv-field
)))
78 (format "%s <- read.table(\"%s\", header=%s, sep=\"\\t\", as.is=TRUE)"
79 name transition-file
(if (eq (second value
) 'hline
) "TRUE" "FALSE")))
80 (format "%s <- %s" name
(org-babel-R-quote-tsv-field value
))))
82 (defun org-babel-R-initiate-session (session)
83 "If there is not a current R process then create one."
84 (unless (string= session
"none")
85 (setq session
(or session
"*R*"))
86 (if (org-babel-comint-buffer-livep session
)
88 (save-window-excursion
90 (rename-buffer (if (bufferp session
) (buffer-name session
)
91 (if (stringp session
) session
(buffer-name)))) (current-buffer)))))
93 (defun org-babel-R-construct-graphics-device-call (out-file params
)
94 "Construct the call to the graphics device"
103 (:postscript .
"postscript")))
104 (allowed-args '(:width
:height
:bg
:units
:pointsize
105 :antialias
:quality
:compression
:res
:type
106 :family
:title
:fonts
:version
:paper
:encoding
107 :pagecentre
:colormodel
:useDingbats
:horizontal
))
108 (device (and (string-match ".+\\.\\([^.]+\\)" out-file
) (match-string 1 out-file
)))
109 (extra-args (cdr (assq :R-dev-args params
))) filearg args
)
110 (setq device
(or (and device
(cdr (assq (intern (concat ":" device
)) devices
))) "png"))
111 (setq filearg
(if (member device
'("pdf" "postscript")) "file" "filename"))
112 (setq args
(mapconcat (lambda (pair)
113 (if (member (car pair
) allowed-args
)
114 (format ",%s=%s" (substring (symbol-name (car pair
)) 1) (cdr pair
)) ""))
116 (format "%s(%s=\"%s\"%s%s%s)\n" device filearg out-file args
(if extra-args
"," "") (or extra-args
""))))
118 (defvar org-babel-R-eoe-indicator
"'org_babel_R_eoe'")
119 (defvar org-babel-R-eoe-output
"[1] \"org_babel_R_eoe\"")
120 (defvar org-babel-R-wrapper-method
"main <- function ()\n{\n%s\n}
121 write.table(main(), file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=FALSE, col.names=%s, quote=FALSE)")
123 (defun org-babel-R-evaluate (buffer body result-type column-names-p
)
124 "Pass BODY to the R process in BUFFER. If RESULT-TYPE equals
125 'output then return a list of the outputs of the statements in
126 BODY, if RESULT-TYPE equals 'value then return the value of the
127 last statement in BODY, as elisp."
129 ;; external process evaluation
130 (let ((in-tmp-file (make-temp-file "R-in-functional-results"))
131 (out-tmp-file (make-temp-file "R-out-functional-results")))
134 (with-temp-file in-tmp-file
(insert body
))
135 (shell-command-to-string (format "R --slave --no-save < '%s' > '%s'"
136 in-tmp-file out-tmp-file
))
137 (with-temp-buffer (insert-file-contents out-tmp-file
) (buffer-string)))
139 (with-temp-file in-tmp-file
140 (insert (format org-babel-R-wrapper-method
141 body out-tmp-file
(if column-names-p
"TRUE" "FALSE"))))
142 (shell-command (format "R --no-save < '%s'" in-tmp-file
))
143 (org-babel-R-process-value-result
144 (org-babel-import-elisp-from-file out-tmp-file
) column-names-p
))))
145 ;; comint session evaluation
146 (org-babel-comint-in-buffer buffer
147 (let* ((tmp-file (make-temp-file "org-babel-R"))
151 (mapconcat #'org-babel-chomp
(list body
152 (format "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=FALSE, col.names=%s, quote=FALSE)" tmp-file
(if column-names-p
"TRUE" "FALSE"))
153 org-babel-R-eoe-indicator
) "\n"))
155 (mapconcat #'org-babel-chomp
(list body org-babel-R-eoe-indicator
) "\n"))))
156 (raw (org-babel-comint-with-output buffer org-babel-R-eoe-output nil
157 (insert full-body
) (inferior-ess-send-input)))
160 (value (org-babel-R-process-value-result
161 (org-babel-import-elisp-from-file tmp-file
) column-names-p
))
166 (and (string-match (regexp-quote org-babel-R-eoe-output
) el
)
169 (if (= (length el
) 0)
171 (if (string-match comint-prompt-regexp el
)
172 (substring el
(match-end 0))
176 (delete nil
(mapcar #'extractor
(mapcar #'org-babel-chomp raw
))) "\n"))))))))
178 (defun org-babel-R-process-value-result (result column-names-p
)
179 "R-specific processing of return value prior to return to org-babel.
181 Currently, insert hline if column names in output have been requested."
183 (cons (car result
) (cons 'hline
(cdr result
)))
187 (provide 'org-babel-R
)
188 ;;; org-babel-R.el ends here