adding support for R source code blocks

litorgy/init.el

@@ -35,7 +35,7 @@
 
 ;; language specific files
 (require 'litorgy-script)
-(require 'litorgy-R)
 (require 'litorgy-lisp)
+(require 'litorgy-R)
 
 ;;; init.el ends here

litorgy/litorgy-R.el

@@ -1,9 +1,9 @@
 ;;; litorgy-R.el --- litorgy functions for R code evaluation
 
-;; Copyright (C) 2009 Eric Schulte, Dan Davison, Austin F. Frank
+;; Copyright (C) 2009 Eric Schulte
 
-;; Author: Eric Schulte, Dan Davison, Austin F. Frank
-;; Keywords: literate programming, reproducible research
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research, R, statistics
 ;; Homepage: http://orgmode.org
 ;; Version: 0.01
 
@@ -31,16 +31,87 @@
 ;;; Code:
 (require 'litorgy)
 
-(litorgy-add-interpreter "emacs-R")
+(litorgy-add-interpreter "R")
 
-(defun litorgy-execute:emacs-R (body params)
-  "Execute a block of emacs-R code with litorgy.  This
-function is called by `litorgy-execute-src-block'."
+(defun litorgy-execute:R (body params)
+  "Execute a block of R code with litorgy.  This function is
+called by `litorgy-execute-src-block'."
+  (message "executing R source code block...")
   (save-window-excursion
     (let ((vars (litorgy-reference-variables params))
           results)
-      ;;TODO: implement
-      (error "`litorgy-execute:emacs-R' is not implemented"))))
+      (litorgy-R-initiate-R-buffer)
+      (litorgy-R-command-to-string body))))
+
+;; functions for evaluation of R code
+(defvar litorgy-R-buffer nil
+  "Holds the buffer for the current R process")
+
+(defun litorgy-R-initiate-R-buffer ()
+  "If there is not a current R process then create one."
+  (unless (and (buffer-live-p litorgy-R-buffer) (get-buffer litorgy-R-buffer))
+    (save-excursion
+      (R)
+      (setf litorgy-R-buffer (current-buffer))
+      (litorgy-R-wait-for-output)
+      (litorgy-R-input-command ""))))
+
+(defun litorgy-R-command-to-string (command)
+  "Send a command to R, and return the results as a string."
+  (litorgy-R-input-command command)
+  (litorgy-R-last-output))
+
+(defun litorgy-R-input-command (command)
+  "Pass COMMAND to the R process running in `litorgy-R-buffer'."
+  (save-excursion
+    (save-match-data
+      (set-buffer litorgy-R-buffer)
+      (goto-char (process-mark (get-buffer-process (current-buffer))))
+      (insert command)
+      (comint-send-input)
+      (litorgy-R-wait-for-output))))
+
+(defun litorgy-R-wait-for-output ()
+  "Wait until output arrives"
+  (save-excursion
+    (save-match-data
+      (set-buffer litorgy-R-buffer)
+      (while (progn
+	       (goto-char comint-last-input-end)
+	       (not (re-search-forward comint-prompt-regexp nil t)))
+	(accept-process-output (get-buffer-process (current-buffer)))))))
+
+(defun litorgy-R-last-output ()
+  "Return the last R output as a string"
+  (save-excursion
+    (save-match-data
+      (set-buffer litorgy-R-buffer)
+      (goto-char (process-mark (get-buffer-process (current-buffer))))
+      (forward-line 0)
+      (let ((raw (buffer-substring comint-last-input-end (- (point) 1)))
+            output output-flag)
+        (mapconcat
+         (lambda (el)
+           (if (stringp el)
+               (format "%s" el)
+             (format "%S" el)))
+         (delq nil
+               (mapcar
+                (lambda (line)
+                  (unless (string-match "^>" line)
+                    (and (string-match "\\[[[:digit:]]+\\] *\\(.*\\)$" line)
+                         (match-string 1 line))))
+                ;; drop first, because it's the last line of input
+                (cdr (split-string raw "[\n\r]")))) "\n")))))
+
+(defun litorgy-R-table-or-results (results)
+  "If the results look like a matrix, then convert them into an
+Emacs-lisp table otherwise return the results as a string."
+  ;; TODO: these simple assumptions will probably need some tweaking
+  (when (string-match "[ \f\t\n\r\v]+" results)
+    (concat "(" (mapconcat #'litorgy-R-tale-or-results
+                           (split-string results) " ") ")"))
+  results)
 
 (provide 'litorgy-R)
 ;;; litorgy-R.el ends here

rorg.org

@@ -746,6 +746,8 @@ out...
    finally it should insert the transposed table into the buffer
    immediately following the block
 
+*** Emacs lisp
+
 #+begin_src emacs-lisp
 (defun transpose (table)
   (apply #'mapcar* #'list table))
@@ -763,6 +765,8 @@ out...
 (transpose table)
 #+end_src
 
+*** Ruby and Python
+
 #+begin_src ruby :var table=sandbox :replace t
 table.first.join(" - ")
 #+end_src
@@ -789,6 +793,24 @@ table
 | 1 |         2 | 3 |
 | 4 | "schulte" | 6 |
 
+*** R
+
+#+begin_src R :replace t
+a <- 9
+b <- 8
+
+#+end_src
+
+#+begin_src R :replace t
+x <- c(rnorm(10, mean=-3, sd=1), rnorm(10, mean=3, sd=1))
+x
+#+end_src
+
+: -2.059712 -1.299807 -2.518628 -4.319525 -1.944779 -5.345708 -3.921314
+: -2.841109 -0.963475 -2.465979  4.092037  1.299202  1.476687  2.128594
+: 3.200629  1.990952  1.888890  3.561541  3.818319  1.969161
+
+
 
 * COMMENT Commentary
 I'm seeing this as like commit notes, and a place for less formal