making progress bringing org-babel-R.el into the new evaluation schema
This commit is contained in:
Eric Schulte
parent
0e8ae41dfc
commit
005e682948
|
|
@ -33,35 +33,29 @@
|
|||
|
||||
(org-babel-add-interpreter "R")
|
||||
|
||||
(defvar org-babel-R-buffer "org-babel-R"
|
||||
"Holds the buffer for the current R process")
|
||||
|
||||
(defun org-babel-R-initiate-R-buffer ()
|
||||
"If there is not a current R process then create one."
|
||||
(unless (org-babel-comint-buffer-livep org-babel-R-buffer)
|
||||
(save-window-excursion (R) (setf org-babel-R-buffer (current-buffer)))))
|
||||
|
||||
(defun org-babel-execute:R (body params)
|
||||
"Execute a block of R code with org-babel. This function is
|
||||
called by `org-babel-execute-src-block'."
|
||||
(message "executing R source code block...")
|
||||
(save-window-excursion
|
||||
(let ((vars (org-babel-ref-variables params))
|
||||
(results-params (split-string (or (cdr (assoc :results params)) "")))
|
||||
results)
|
||||
;; (message (format "%S" results-params))
|
||||
(org-babel-R-initiate-R-buffer)
|
||||
(mapc (lambda (pair) (org-babel-R-assign-elisp (car pair) (cdr pair))) vars)
|
||||
(cond
|
||||
((member "script" results-params) ;; collect all output
|
||||
(let ((tmp-file (make-temp-file "org-babel-R-script-output")))
|
||||
(org-babel-comint-input-command org-babel-R-buffer (format "sink(%S)" tmp-file))
|
||||
(org-babel-comint-input-command org-babel-R-buffer body)
|
||||
(org-babel-comint-input-command org-babel-R-buffer "sink()")
|
||||
(with-temp-buffer (insert-file-contents tmp-file) (buffer-string))))
|
||||
((member "last" results-params) ;; the value of the last statement
|
||||
(org-babel-comint-input-command org-babel-R-buffer body)
|
||||
(org-babel-R-last-value-as-elisp))))))
|
||||
(let* ((vars (org-babel-ref-variables params))
|
||||
(result-params (split-string (or (cdr (assoc :results params)) "")))
|
||||
(result-type (cond ((member "output" result-params) 'output)
|
||||
((member "value" result-params) 'value)
|
||||
(t 'value)))
|
||||
;; (session (org-babel-R-initiate-session (cdr (assoc :session params))))
|
||||
(session (get-buffer "*R*"))
|
||||
results)
|
||||
;; assign variables
|
||||
(mapc (lambda (pair) (org-babel-R-assign-elisp session (car pair) (cdr pair))) vars)
|
||||
;; evaluate body and convert the results to ruby
|
||||
(message (format "result-type=%S" result-type))
|
||||
(message (format "body=%S" body))
|
||||
(setq results (org-babel-R-evaluate session body result-type))
|
||||
(message (format "results=%S" results))
|
||||
(let ((tmp-file (make-temp-file "org-babel-R")))
|
||||
(with-temp-file tmp-file (insert results))
|
||||
(org-babel-import-elisp-from-file tmp-file)))))
|
||||
|
||||
(defun org-babel-R-quote-tsv-field (s)
|
||||
"Quote field S for export to R."
|
||||
|
|
@ -69,12 +63,12 @@ called by `org-babel-execute-src-block'."
|
|||
(concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")
|
||||
(format "%S" s)))
|
||||
|
||||
(defun org-babel-R-assign-elisp (name value)
|
||||
(defun org-babel-R-assign-elisp (session name value)
|
||||
"Read the elisp VALUE into a variable named NAME in the current
|
||||
R process in `org-babel-R-buffer'."
|
||||
(unless org-babel-R-buffer (error "No active R buffer"))
|
||||
(unless session (error "No active R buffer"))
|
||||
(org-babel-comint-input-command
|
||||
org-babel-R-buffer
|
||||
session
|
||||
(if (listp value)
|
||||
(let ((transition-file (make-temp-file "org-babel-R-import")))
|
||||
;; ensure VALUE has an orgtbl structure (depth of at least 2)
|
||||
|
|
@ -86,21 +80,60 @@ R process in `org-babel-R-buffer'."
|
|||
name transition-file))
|
||||
(format "%s <- %s" name (org-babel-R-quote-tsv-field value)))))
|
||||
|
||||
(defun org-babel-R-last-value-as-elisp ()
|
||||
"Return the last value returned by R as Emacs lisp."
|
||||
(let ((tmp-file (make-temp-file "org-babel-R")) result)
|
||||
(org-babel-comint-input-command
|
||||
org-babel-R-buffer
|
||||
(format "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=FALSE, col.names=FALSE, quote=FALSE)"
|
||||
tmp-file))
|
||||
(org-babel-import-elisp-from-file tmp-file)))
|
||||
;; functions for comint evaluation
|
||||
|
||||
(defun org-babel-R-read (cell)
|
||||
"Strip nested \"s from around strings in exported R values."
|
||||
(org-babel-read (or (and (stringp cell)
|
||||
(string-match "\\\"\\(.+\\)\\\"" cell)
|
||||
(match-string 1 cell))
|
||||
cell)))
|
||||
(defun org-babel-R-initiate-session (session)
|
||||
"If there is not a current R process then create one."
|
||||
(unless (org-babel-comint-buffer-livep session)
|
||||
(save-window-excursion (R) (current-buffer))))
|
||||
|
||||
(defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'")
|
||||
(defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"")
|
||||
|
||||
(defun org-babel-R-evaluate (buffer body result-type)
|
||||
"Pass BODY to the R process in BUFFER. If RESULT-TYPE equals
|
||||
'output then return a list of the outputs of the statements in
|
||||
BODY, if RESULT-TYPE equals 'value then return the value of the
|
||||
last statement in BODY."
|
||||
(org-babel-comint-in-buffer buffer
|
||||
(let* ((string-buffer "")
|
||||
(tmp-file (make-temp-file "org-babel-R"))
|
||||
(last-value-eval
|
||||
(format "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=FALSE, col.names=FALSE, quote=FALSE)"
|
||||
tmp-file))
|
||||
(full-body (mapconcat #'org-babel-chomp (list body last-value-eval org-babel-R-eoe-indicator) "\n"))
|
||||
results)
|
||||
(flet ((my-filt (text) (setq string-buffer (concat string-buffer text))))
|
||||
;; setup filter
|
||||
(add-hook 'comint-output-filter-functions 'my-filt)
|
||||
;; pass FULL-BODY to process
|
||||
(goto-char (process-mark (get-buffer-process buffer)))
|
||||
(insert full-body)
|
||||
(comint-send-input)
|
||||
;; wait for end-of-evaluation indicator
|
||||
(while (progn
|
||||
(goto-char comint-last-input-end)
|
||||
(not (save-excursion (and (re-search-forward comint-prompt-regexp nil t)
|
||||
(re-search-forward (regexp-quote org-babel-R-eoe-output) nil t)))))
|
||||
(accept-process-output (get-buffer-process buffer)))
|
||||
;; remove filter
|
||||
(remove-hook 'comint-output-filter-functions 'my-filt))
|
||||
;; remove echo'd FULL-BODY from input
|
||||
(if (string-match (replace-regexp-in-string "\n" "\r\n" (regexp-quote full-body)) string-buffer)
|
||||
(setq string-buffer (substring string-buffer (match-end 0))))
|
||||
;; split results with `comint-prompt-regexp'
|
||||
(setq results (let ((broke nil))
|
||||
(delete nil (mapcar (lambda (el)
|
||||
(if (or broke
|
||||
(string-match (regexp-quote org-babel-R-eoe-output) el)
|
||||
(= (length el) 0))
|
||||
(progn (setq broke t) nil)
|
||||
el))
|
||||
(mapcar #'org-babel-trim (split-string string-buffer comint-prompt-regexp))))))
|
||||
(case result-type
|
||||
(output (mapconcat #'identity results "\n"))
|
||||
(value (with-temp-buffer (insert-file-contents tmp-file) (buffer-string)))
|
||||
(t (reverse results))))))
|
||||
|
||||
(provide 'org-babel-R)
|
||||
;;; org-babel-R.el ends here
|
||||
|
|
|
|||
|
|
@ -51,5 +51,26 @@ body inside the protection of `save-window-excursion' and
|
|||
(set-buffer buffer)
|
||||
,@body)))
|
||||
|
||||
(defun org-babel-comint-input-command (buffer cmd)
|
||||
"Pass CMD to BUFFER The input will not be echoed."
|
||||
(org-babel-comint-in-buffer buffer
|
||||
(goto-char (process-mark (get-buffer-process buffer)))
|
||||
(insert cmd)
|
||||
(comint-send-input)
|
||||
(org-babel-comint-wait-for-output buffer)))
|
||||
|
||||
(defun org-babel-comint-wait-for-output (buffer)
|
||||
"Wait until output arrives. Note: this is only safe when
|
||||
waiting for the result of a single statement (not large blocks of
|
||||
code)."
|
||||
(org-babel-comint-in-buffer buffer
|
||||
(while (progn
|
||||
(goto-char comint-last-input-end)
|
||||
(not (and (re-search-forward comint-prompt-regexp nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(string= (face-name (face-at-point))
|
||||
"comint-highlight-prompt"))))
|
||||
(accept-process-output (get-buffer-process buffer)))))
|
||||
|
||||
(provide 'org-babel-comint)
|
||||
;;; org-babel-comint.el ends here
|
||||
|
|
|
|||
|
|
@ -78,6 +78,8 @@ Emacs-lisp table, otherwise return the results as a string."
|
|||
"'" "\"" results)))))
|
||||
results)))
|
||||
|
||||
;; functions for comint evaluation
|
||||
|
||||
(defun org-babel-ruby-initiate-session (&optional session)
|
||||
"If there is not a current inferior-process-buffer in SESSION
|
||||
then create. Return the initialized session."
|
||||
|
|
|
|||
|
|
@ -362,22 +362,30 @@ This is taken almost directly from `org-read-prop'."
|
|||
(defun org-babel-import-elisp-from-file (file-name)
|
||||
"Read the results located at FILE-NAME into an elisp table. If
|
||||
the table is trivial, then return it as a scalar."
|
||||
(with-temp-buffer
|
||||
(condition-case nil
|
||||
(progn
|
||||
(org-table-import file-name nil)
|
||||
(delete-file file-name)
|
||||
(setq result (mapcar (lambda (row)
|
||||
(mapcar #'org-babel-R-read row))
|
||||
(org-table-to-lisp))))
|
||||
(error nil))
|
||||
(if (null (cdr result)) ;; if result is trivial vector, then scalarize it
|
||||
(if (consp (car result))
|
||||
(if (null (cdr (car result)))
|
||||
(caar result)
|
||||
result)
|
||||
(car result))
|
||||
result)))
|
||||
(let (result)
|
||||
(with-temp-buffer
|
||||
(condition-case nil
|
||||
(progn
|
||||
(org-table-import file-name nil)
|
||||
(delete-file file-name)
|
||||
(setq result (mapcar (lambda (row)
|
||||
(mapcar #'org-babel-string-read row))
|
||||
(org-table-to-lisp))))
|
||||
(error nil))
|
||||
(if (null (cdr result)) ;; if result is trivial vector, then scalarize it
|
||||
(if (consp (car result))
|
||||
(if (null (cdr (car result)))
|
||||
(caar result)
|
||||
result)
|
||||
(car result))
|
||||
result))))
|
||||
|
||||
(defun org-babel-string-read (cell)
|
||||
"Strip nested \"s from around strings in exported R values."
|
||||
(org-babel-read (or (and (stringp cell)
|
||||
(string-match "\\\"\\(.+\\)\\\"" cell)
|
||||
(match-string 1 cell))
|
||||
cell)))
|
||||
|
||||
(defun org-babel-reverse-string (string)
|
||||
(apply 'string (reverse (string-to-list string))))
|
||||
|
|
|
|||
|
|
@ -521,29 +521,27 @@ schulte + 3
|
|||
schulte
|
||||
#+end_src
|
||||
|
||||
**** TODO R [3/3]
|
||||
**** TODO R [0/4]
|
||||
|
||||
- [X] functional results working with comint
|
||||
- [X] script results
|
||||
- [X] ensure callable by other source block
|
||||
- [ ] functional results working with comint
|
||||
- [ ] script results
|
||||
- [ ] ensure callable by other source block
|
||||
- [ ] rename buffer after session
|
||||
|
||||
To redirect output to a file, you can use the =sink()= command.
|
||||
|
||||
#+srcname: task_R_B
|
||||
#+begin_src R :results replace script
|
||||
a <- 8
|
||||
b <- 9
|
||||
c <- 10
|
||||
a + b
|
||||
#+begin_src R :results replace output scalar
|
||||
92
|
||||
21
|
||||
a + b + c
|
||||
#+end_src
|
||||
|
||||
#+resname: task-R-with-inf-process-buffer
|
||||
: [1] 17
|
||||
: [1] 21
|
||||
: [1] 27
|
||||
#+resname: task_R_B
|
||||
| "[1]" | 92 |
|
||||
| "[1]" | 21 |
|
||||
|
||||
|
||||
|
||||
|
||||
#+srcname: task-R-use-other-output
|
||||
#+begin_src R :var twoentyseven=task_R_B() :results replace script
|
||||
|
|
|
|||
Loading…
Reference in New Issue