[elpa] externals/org 51a60cd 1/4: lisp/ob-R: Async evaluation in R

[ELPA Syncer]

branch: externals/org
commit 51a60cd53f62261c5cfd3835571c27771be6c471
Author: Jeremie Juste <djj@debian-BULLSEYE-live-builder-AMD64>
Commit: Bastien <bzg@gnu.org>

    lisp/ob-R: Async evaluation in R
    
    * lisp/ob-R.el (ob-session-async-R-indicator): Add constant
    representing a prefix R to identity session.
    (ob-session-async-org-babel-R-evaluate-session): New function to
    evaluate R src block asynchrously.
    (ob-session-async-R-value-callback): New function that calls back
    the result of the asynchronous evaluation.
    (org-babel-R-evaluate): Add `async' parameter and call
    `ob-session-async-org-babel-R-evaluate-session' if `async'
    parameter is present.
    (org-babel-execute:R): Call `org-babel-comint-use-async' to check
    if async is among `params' and add async parameter to
    `org-babel-R-evaluate'.
    
    * testing/lisp/test-ob-R.el: Add 7 more tests for async
    evaluations, also taken from the `ob-session-async' package.
    
    This is almost a carbon copy of Jack Kamm's `ob-session-async'.
    The original source code can be found
    https://github.com/jackkamm/ob-session-async.
    
    Please refer to the following thread to trace back the discussion
    on async evaluation in R:
    
    https://list.orgmode.org/87eed9g9p6.fsf@gmail.com/
---
 lisp/ob-R.el              | 90 +++++++++++++++++++++++++++++++++++++++++++--
 testing/lisp/test-ob-R.el | 94 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 181 insertions(+), 3 deletions(-)

diff --git a/lisp/ob-R.el b/lisp/ob-R.el
index 2d9073c..299ccdf 100644
--- a/lisp/ob-R.el
+++ b/lisp/ob-R.el
@@ -158,6 +158,7 @@ This function is called by `org-babel-execute-src-block'."
   (save-excursion
     (let* ((result-params (cdr (assq :result-params params)))
           (result-type (cdr (assq :result-type params)))
+           (async (org-babel-comint-use-async params))
            (session (org-babel-R-initiate-session
                     (cdr (assq :session params)) params))
           (graphics-file (and (member "graphics" (assq :result-params params))
@@ -184,7 +185,8 @@ This function is called by `org-babel-execute-src-block'."
                  (cdr (assq :colname-names params)) colnames-p))
             (or (equal "yes" rownames-p)
                 (org-babel-pick-name
-                 (cdr (assq :rowname-names params)) rownames-p)))))
+                 (cdr (assq :rowname-names params)) rownames-p))
+             async)))
       (if graphics-file nil result))))
 
 (defun org-babel-prep-session:R (session params)
@@ -371,11 +373,14 @@ Has four %s escapes to be filled in:
 4. The name of the file to write to")
 
 (defun org-babel-R-evaluate
-  (session body result-type result-params column-names-p row-names-p)
+  (session body result-type result-params column-names-p row-names-p async)
   "Evaluate R code in BODY."
   (if session
+      (if async
+          (ob-session-async-org-babel-R-evaluate-session
+           session body result-type result-params column-names-p row-names-p)
       (org-babel-R-evaluate-session
-       session body result-type result-params column-names-p row-names-p)
+       session body result-type result-params column-names-p row-names-p))
     (org-babel-R-evaluate-external-process
      body result-type result-params column-names-p row-names-p)))
 
@@ -468,6 +473,85 @@ Insert hline if column names in output have been 
requested."
        (error "Could not parse R result"))
     result))
 
+
+;;; async evaluation
+
+(defconst ob-session-async-R-indicator "'ob_comint_async_R_%s_%s'")
+
+(defun ob-session-async-org-babel-R-evaluate-session
+    (session body result-type result-params column-names-p row-names-p)
+  "Asynchronously evaluate BODY in SESSION.
+Returns a placeholder string for insertion, to later be replaced
+by `org-babel-comint-async-filter'."
+  (org-babel-comint-async-register
+   session (current-buffer)
+   "^\\(?:[>.+] \\)*\\[1\\] \"ob_comint_async_R_\\(.+?\\)_\\(.+\\)\"$"
+   'org-babel-chomp
+   'ob-session-async-R-value-callback)
+  (cl-case result-type
+    (value
+     (let ((tmp-file (org-babel-temp-file "R-")))
+       (with-temp-buffer
+         (insert
+          (org-babel-chomp body))
+         (let ((ess-local-process-name
+                (process-name (get-buffer-process session))))
+           (ess-eval-buffer nil)))
+       (with-temp-buffer
+        (insert
+         (mapconcat
+           'org-babel-chomp
+           (list (format org-babel-R-write-object-command
+                         (if row-names-p "TRUE" "FALSE")
+                         (if column-names-p
+                             (if row-names-p "NA" "TRUE")
+                           "FALSE")
+                         ".Last.value"
+                         (org-babel-process-file-name tmp-file 'noquote))
+                 (format ob-session-async-R-indicator
+                         "file" tmp-file))
+           "\n"))
+        (let ((ess-local-process-name
+               (process-name (get-buffer-process session))))
+          (ess-eval-buffer nil)))
+       tmp-file))
+    (output
+     (let ((uuid (md5 (number-to-string (random 100000000))))
+           (ess-local-process-name
+            (process-name (get-buffer-process session))))
+       (with-temp-buffer
+         (insert (format ob-session-async-R-indicator
+                                         "start" uuid))
+         (insert "\n")
+         (insert body)
+         (insert "\n")
+         (insert (format ob-session-async-R-indicator
+                                         "end" uuid))
+         (ess-eval-buffer nil))
+       uuid))))
+
+(defun ob-session-async-R-value-callback (params tmp-file)
+  "Callback for async value results.
+Assigned locally to `ob-session-async-file-callback' in R
+comint buffers used for asynchronous Babel evaluation."
+  (let* ((graphics-file (and (member "graphics" (assq :result-params params))
+                            (org-babel-graphical-output-file params)))
+        (colnames-p (unless graphics-file (cdr (assq :colnames params)))))
+    (org-babel-R-process-value-result
+     (org-babel-result-cond (assq :result-params params)
+       (with-temp-buffer
+         (insert-file-contents tmp-file)
+         (org-babel-chomp (buffer-string) "\n"))
+       (org-babel-import-elisp-from-file tmp-file '(16)))
+     (or (equal "yes" colnames-p)
+        (org-babel-pick-name
+         (cdr (assq :colname-names params)) colnames-p)))))
+
+
+
+;;; ob-session-async-R.el ends here
+
+
 (provide 'ob-R)
 
 ;;; ob-R.el ends here
diff --git a/testing/lisp/test-ob-R.el b/testing/lisp/test-ob-R.el
index c36bac9..1e60ae9 100644
--- a/testing/lisp/test-ob-R.el
+++ b/testing/lisp/test-ob-R.el
@@ -117,6 +117,8 @@ x
 ))))
 
 
+
+
 ;; (ert-deftest test-ob-r/output-with-error ()
 ;;   "make sure angle brackets are well formatted"
 ;;     (let (ess-ask-for-ess-directory ess-history-file)
@@ -151,6 +153,98 @@ log10(10)
 #+end_src"     
   (org-babel-execute-src-block))))))
 
+
+(ert-deftest ob-session-async-R-simple-session-async-value ()
+  (let (ess-ask-for-ess-directory
+        ess-history-file
+        (org-babel-temporary-directory "/tmp")
+        (org-confirm-babel-evaluate nil))
+    (org-test-with-temp-text
+     "#+begin_src R :session R :async yes\n  Sys.sleep(.1)\n  
paste(\"Yep!\")\n#+end_src\n"
+     (should (let ((expected "Yep!"))
+              (and (not (string= expected (org-babel-execute-src-block)))
+                   (string= expected
+                            (progn
+                              (sleep-for 0 200)
+                              (goto-char (org-babel-where-is-src-block-result))
+                              (org-babel-read-result)))))))))
+
+(ert-deftest ob-session-async-R-simple-session-async-output ()
+  (let (ess-ask-for-ess-directory
+        ess-history-file
+        (org-babel-temporary-directory "/tmp")
+        (org-confirm-babel-evaluate nil))
+    (org-test-with-temp-text
+     "#+begin_src R :session R :results output :async yes\n  Sys.sleep(.1)\n  
1:5\n#+end_src\n"
+     (should (let ((expected "[1] 1 2 3 4 5"))
+              (and (not (string= expected (org-babel-execute-src-block)))
+                   (string= expected
+                            (progn
+                              (sleep-for 0 200)
+                              (goto-char (org-babel-where-is-src-block-result))
+                              (org-babel-read-result)))))))))
+
+(ert-deftest ob-session-async-R-named-output ()
+  (let (ess-ask-for-ess-directory
+        ess-history-file
+        (org-babel-temporary-directory "/tmp")
+        org-confirm-babel-evaluate
+        (src-block "#+begin_src R :async :session R :results output\n  
1:5\n#+end_src")
+        (results-before "\n\n#+NAME: foobar\n#+RESULTS:\n: [1] 1")
+        (results-after "\n\n#+NAME: foobar\n#+RESULTS:\n: [1] 1 2 3 4 5\n"))
+    (org-test-with-temp-text
+     (concat src-block results-before)
+     (should (progn (org-babel-execute-src-block)
+                    (sleep-for 0 200)
+                    (string= (concat src-block results-after)
+                             (buffer-string)))))))
+
+(ert-deftest ob-session-async-R-named-value ()
+  (let (ess-ask-for-ess-directory
+        ess-history-file
+        org-confirm-babel-evaluate
+        (org-babel-temporary-directory "/tmp")
+        (src-block "#+begin_src R :async :session R :results value\n  
paste(\"Yep!\")\n#+end_src")
+        (results-before "\n\n#+NAME: foobar\n#+RESULTS:\n: [1] 1")
+        (results-after "\n\n#+NAME: foobar\n#+RESULTS:\n: Yep!\n"))
+    (org-test-with-temp-text
+     (concat src-block results-before)
+     (should (progn (org-babel-execute-src-block)
+                    (sleep-for 0 200)
+                    (string= (concat src-block results-after)
+                             (buffer-string)))))))
+
+(ert-deftest ob-session-async-R-output-drawer ()
+  (let (ess-ask-for-ess-directory
+        ess-history-file
+        org-confirm-babel-evaluate
+        (org-babel-temporary-directory "/tmp")
+        (src-block "#+begin_src R :async :session R :results output drawer\n  
1:5\n#+end_src")
+        (result "\n\n#+RESULTS:\n:results:\n[1] 1 2 3 4 5\n:end:\n"))
+    (org-test-with-temp-text
+     src-block
+     (should (progn (org-babel-execute-src-block)
+                    (sleep-for 0 200)
+                    (string= (concat src-block result)
+                             (buffer-string)))))))
+
+(ert-deftest ob-session-async-R-value-drawer ()
+  (let (ess-ask-for-ess-directory
+        ess-history-file
+        org-confirm-babel-evaluate
+        (org-babel-temporary-directory "/tmp")
+        (src-block "#+begin_src R :async :session R :results value drawer\n  
1:3\n#+end_src")
+        (result "\n\n#+RESULTS:\n:results:\n1\n2\n3\n:end:\n"))
+    (org-test-with-temp-text
+     src-block
+     (should (progn (org-babel-execute-src-block)
+                    (sleep-for 0 200)
+                    (string= (concat src-block result)
+                             (buffer-string)))))))
+
+
+
+
 (provide 'test-ob-R)
 
 ;;; test-ob-R.el ends here