[PATCH] async process in R

[Jeremie Juste <jeremiejuste@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 916 bytes --]

Hello,

I have integrated some of the ob-session-async package in ob-R.el
(finally). Most of the heavy lifting has been made by Jack.


So with the patch async evaluation is  expected to work out of the box
for :result value

#+begin_src R :session *R*  :results value :async :colnames yes
Sys.sleep(10)
as.list(1:5)
#+end_src

#+RESULTS:
| x |
|---|
| 1 |
| 2 |
| 3 |
| 4 |
| 5 |

But for the time being result output produces the following output.

#+begin_src R :session *R*  :results output :async
Sys.sleep(1)
print(1:5)
#+end_src

#+RESULTS:
: > Sys.sleep(1)
: > print(1:5)
: [1] 1 2 3 4 5
: > 'ob_comint_async_R_end_53c0a42fed17cf78f5508e5293029430'


From my understanding the async command of python does not suffer from
this issue. I'm not sure if the issue needs to be solve at the ob-R.el
or at the ob-core.el. I welcome any comments on this patch or any idea
to move it forward.

Best regards,
Jeremie


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: async in ob-R --]
[-- Type: text/x-diff, Size: 10655 bytes --]

From 51e1efb75e15fab348fd5a2c8b5fb5c1dbbf4d1c Mon Sep 17 00:00:00 2001
From: Jeremie Juste <djj@debian-BULLSEYE-live-builder-AMD64>
Date: Sun, 26 Sep 2021 18:25:23 +0200
Subject: [PATCH] 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
callback 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 ob-session-async package.

This is almost a carbon copy of the package of ob-session-async
of Jack Kamm. 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 2d9073cee..299ccdf1d 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 c36bac9e6..1e60ae903 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
-- 
2.30.2