Browse Source

R source blocks can now read in variables from org-mode tables, and insert results as org tables

Eric Schulte 16 years ago
parent
commit
834dd2908f
2 changed files with 59 additions and 33 deletions
  1. 41 19
      litorgy/litorgy-R.el
  2. 18 14
      rorg.org

+ 41 - 19
litorgy/litorgy-R.el

@@ -33,7 +33,9 @@
 
 (litorgy-add-interpreter "R")
 
-(defvar litorgy-R-var-name "litorgy_R_variable")
+(defvar litorgy-R-func-name "litorgy_R_main"
+  "This is the main function which wraps each R source code
+block.")
 
 (defun litorgy-execute:R (body params)
   "Execute a block of R code with litorgy.  This function is
@@ -42,25 +44,54 @@ called by `litorgy-execute-src-block'."
   (save-window-excursion
     (let ((vars (litorgy-ref-variables params))
           results)
-      (message (format "--%S--" vars))
-      (mapc (lambda (pair)
-              (litorgy-R-input-command
-               (format "%s <- %s" (car pair) (cdr pair))))
-            vars)
       (litorgy-R-initiate-R-buffer)
-      (litorgy-R-command-to-string body))))
+      (mapc (lambda (pair) (litorgy-R-assign-elisp (car pair) (cdr pair))) vars)
+      (litorgy-R-input-command
+       (format "%s <- function ()\n{\n%s\n}" litorgy-R-func-name body))
+      (litorgy-R-to-elisp litorgy-R-func-name))))
+
+(defun litorgy-R-quote-tsv-field (s)
+  "Quote field S for export to R."
+  (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\""))
+
+(defun litorgy-R-assign-elisp (name value)
+  "Read the elisp VALUE into a variable named NAME in the current
+R process in `litorgy-R-buffer'."
+  (unless litorgy-R-buffer
+    (error "No active R buffer"))
+  (if (listp value)
+      (let ((transition-file (make-temp-file "litorgy-R-import"))
+            (value (mapcar (lambda (row)
+                             (mapcar (lambda (cell)
+                                       (if (stringp cell)
+                                           cell
+                                         (format "%S" cell))) row)) value)))
+        (with-temp-file transition-file
+          (insert (orgtbl-to-tsv value '(:sep "\t" :fmt litorgy-R-quote-tsv-field)))
+          (insert "\n"))
+        (litorgy-R-input-command (format "%s <- read.table(\"%s\")" name transition-file)))))
 
 (defun litorgy-R-to-elisp (func-name)
   "Return the result of calling the function named FUNC-NAME in
 `litorgy-R-buffer' as Emacs lisp."
-  (let ((tmp-file (make-temp-file "litorgy-R")))
-    (message (format "temp-file=%s" tmp-file))
+  (let ((tmp-file (make-temp-file "litorgy-R")) result)
     (litorgy-R-input-command
      (format "write.table(%s(), \"%s\", , ,\"\\t\", ,\"nil\", , FALSE, FALSE)" func-name tmp-file))
     (with-temp-buffer
       (org-table-import tmp-file nil)
       (delete-file tmp-file)
-      (org-table-to-lisp))))
+      (setq result (mapcar (lambda (row)
+                             (mapcar #'litorgy-R-read row))
+                           (org-table-to-lisp)))
+      ;; TODO: we may want to scalarize single-element vectors
+      result)))
+
+(defun litorgy-R-read (cell)
+  "Strip nested \"s from around strings in exported R values."
+  (litorgy-read (or (and (stringp cell)
+                         (string-match "\\\"\\(.+\\)\\\"" cell)
+                         (match-string 1 cell))
+                    cell)))
 
 ;; functions for evaluation of R code
 (defvar litorgy-R-buffer nil
@@ -123,14 +154,5 @@ called by `litorgy-execute-src-block'."
                 ;; 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

+ 18 - 14
rorg.org

@@ -30,12 +30,16 @@ options (maybe more)
 
 This is now implemented see the example in the [[* silent evaluation][sandbox]]
 
+** DONE assign variables from tables in R
+This is now working (see [[* (sandbox table) R][(sandbox-table)-R]]).  Although it's not that
+impressive until we are able to print table results from R.
+
 ** TODO insert 2-D R results as tables
 everything is working but R and shell
 
 *** TODO shells
 
-*** TODO R
+*** DONE R
 
 This has already been tackled by Dan in [[file:existing_tools/org-R.el::defconst%20org%20R%20write%20org%20table%20def][org-R:check-dimensions]].  The
 functions there should be useful in combination with [[http://cran.r-project.org/doc/manuals/R-data.html#Export-to-text-files][R-export-to-csv]]
@@ -51,7 +55,6 @@ deal with trivial vectors (scalars) in R.  I'm tempted to just treat
 them as vectors, but then that would lead to a proliferation of
 trivial 1-cell tables...
 
-
 ** TODO allow variable initialization from source blocks
 Currently it is possible to initialize a variable from an org-mode
 table with a block argument like =table=sandbox= (note that the
@@ -142,7 +145,8 @@ b <- 17
 a + b
 #+end_src
 
-: 26
+| 26 |
+
 
 #+begin_src R
 hist(rgamma(20,3,3))
@@ -257,24 +261,24 @@ table
 | 1 |         2 | 3 |
 | 4 | "schulte" | 6 |
 
-*** R
-
-#+begin_src R :results replace
-a <- 9
-b <- 8
-b*a
-#+end_src
+*** (sandbox table) R
 
-: 72
+#+TBLNAME: sandbox_r
+| 1 |       2 | 3 |
+| 4 | schulte | 6 |
 
 #+begin_src R :results replace
 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
+#+begin_src R var tabel=sandbox_r :results replace
+tabel
+#+end_src
+
+| 1 |         2 | 3 |
+| 4 | "schulte" | 6 |
+