dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

ob-julia.el (12424B)


      1 ;;; ob-julia.el --- org-babel functions for julia code evaluation  -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2013-2023 Free Software Foundation, Inc.
      4 ;; Authors: G. Jay Kerns
      5 ;; Maintainer: Pedro Bruel <pedro.bruel@gmail.com>
      6 ;; Keywords: literate programming, reproducible research, scientific computing
      7 ;; URL: https://github.com/phrb/ob-julia
      8 
      9 ;; This file is part of GNU Emacs.
     10 
     11 ;; GNU Emacs is free software: you can redistribute it and/or modify
     12 ;; it under the terms of the GNU General Public License as published by
     13 ;; the Free Software Foundation, either version 3 of the License, or
     14 ;; (at your option) any later version.
     15 
     16 ;; GNU Emacs is distributed in the hope that it will be useful,
     17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     19 ;; GNU General Public License for more details.
     20 
     21 ;; You should have received a copy of the GNU General Public License
     22 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     23 
     24 ;;; Commentary:
     25 
     26 ;; Org-Babel support for evaluating julia code
     27 ;;
     28 ;; Based on ob-R.el by Eric Schulte and Dan Davison.
     29 ;;
     30 ;; Session support requires the installation of the DataFrames and CSV
     31 ;; Julia packages.
     32 
     33 ;;; Code:
     34 
     35 (require 'org-macs)
     36 (org-assert-version)
     37 
     38 (require 'cl-lib)
     39 (require 'ob)
     40 
     41 (declare-function orgtbl-to-csv "org-table" (table params))
     42 (declare-function julia "ext:ess-julia" (&optional start-args))
     43 (declare-function inferior-ess-send-input "ext:ess-inf" ())
     44 (declare-function ess-make-buffer-current "ext:ess-inf" ())
     45 (declare-function ess-eval-buffer "ext:ess-inf" (vis))
     46 (declare-function ess-wait-for-process "ext:ess-inf"
     47 		  (&optional proc sec-prompt wait force-redisplay))
     48 
     49 (defvar org-babel-header-args:julia
     50   '((width		 . :any)
     51     (horizontal		 . :any)
     52     (results             . ((file list vector table scalar verbatim)
     53 			    (raw org html latex code pp wrap)
     54 			    (replace silent append prepend)
     55 			    (output value graphics))))
     56   "Julia-specific header arguments.")
     57 
     58 (add-to-list 'org-babel-tangle-lang-exts '("julia" . "jl"))
     59 
     60 (defvar org-babel-default-header-args:julia '())
     61 
     62 (defcustom org-babel-julia-command "julia"
     63   "Name of command to use for executing julia code."
     64   :version "24.3"
     65   :package-version '(Org . "8.0")
     66   :group 'org-babel
     67   :type 'string)
     68 
     69 (defvar ess-current-process-name) ; dynamically scoped
     70 (defvar ess-local-process-name)   ; dynamically scoped
     71 (defvar ess-eval-visibly-p)       ; dynamically scoped
     72 (defvar ess-local-customize-alist); dynamically scoped
     73 (defun org-babel-edit-prep:julia (info)
     74   (let ((session (cdr (assq :session (nth 2 info)))))
     75     (when (and session
     76 	       (string-prefix-p "*"  session)
     77 	       (string-suffix-p "*" session))
     78       (org-babel-julia-initiate-session session nil))))
     79 
     80 (defun org-babel-expand-body:julia (body params &optional _graphics-file)
     81   "Expand BODY according to PARAMS, return the expanded body."
     82   (mapconcat #'identity
     83 	     (append
     84 	      (when (cdr (assq :prologue params))
     85 		(list (cdr (assq :prologue params))))
     86 	      (org-babel-variable-assignments:julia params)
     87 	      (list body)
     88 	      (when (cdr (assq :epilogue params))
     89 		(list (cdr (assq :epilogue params)))))
     90 	     "\n"))
     91 
     92 (defun org-babel-execute:julia (body params)
     93   "Execute a block of julia code.
     94 This function is called by `org-babel-execute-src-block'."
     95   (save-excursion
     96     (let* ((result-params (cdr (assq :result-params params)))
     97 	   (result-type (cdr (assq :result-type params)))
     98            (session (org-babel-julia-initiate-session
     99 		     (cdr (assq :session params)) params))
    100 	   (graphics-file (and (member "graphics" (assq :result-params params))
    101 			       (org-babel-graphical-output-file params)))
    102 	   (colnames-p (unless graphics-file (cdr (assq :colnames params))))
    103 	   (full-body (org-babel-expand-body:julia body params graphics-file))
    104 	   (result
    105 	    (org-babel-julia-evaluate
    106 	     session full-body result-type result-params
    107 	     (or (equal "yes" colnames-p)
    108 		 (org-babel-pick-name
    109 		  (cdr (assq :colname-names params)) colnames-p)))))
    110       (if graphics-file nil result))))
    111 
    112 (defun org-babel-normalize-newline (result)
    113   (replace-regexp-in-string
    114    "\\(\n\r?\\)\\{2,\\}"
    115    "\n"
    116    result))
    117 
    118 (defun org-babel-prep-session:julia (session params)
    119   "Prepare SESSION according to the header arguments specified in PARAMS."
    120   (let* ((session (org-babel-julia-initiate-session session params))
    121 	 (var-lines (org-babel-variable-assignments:julia params)))
    122     (org-babel-comint-in-buffer session
    123       (mapc (lambda (var)
    124               (end-of-line 1) (insert var) (comint-send-input nil t)
    125               (org-babel-comint-wait-for-output session)) var-lines))
    126     session))
    127 
    128 (defun org-babel-load-session:julia (session body params)
    129   "Load BODY into SESSION."
    130   (save-window-excursion
    131     (let ((buffer (org-babel-prep-session:julia session params)))
    132       (with-current-buffer buffer
    133         (goto-char (process-mark (get-buffer-process (current-buffer))))
    134         (insert (org-babel-chomp body)))
    135       buffer)))
    136 
    137 ;; helper functions
    138 
    139 (defun org-babel-variable-assignments:julia (params)
    140   "Return list of julia statements assigning the block's variables."
    141   (let ((vars (org-babel--get-vars params)))
    142     (mapcar
    143      (lambda (pair) (org-babel-julia-assign-elisp (car pair) (cdr pair)))
    144      (mapcar
    145       (lambda (i)
    146 	(cons (car (nth i vars))
    147 	      (org-babel-reassemble-table
    148 	       (cdr (nth i vars))
    149 	       (cdr (nth i (cdr (assq :colname-names params))))
    150 	       (cdr (nth i (cdr (assq :rowname-names params)))))))
    151       (number-sequence 0 (1- (length vars)))))))
    152 
    153 (defun org-babel-julia-quote-csv-field (s)
    154   "Quote field S for export to julia."
    155   (if (stringp s)
    156       (concat "\"" (mapconcat #'identity (split-string s "\"") "\"\"") "\"")
    157     (format "%S" s)))
    158 
    159 (defun org-babel-julia-assign-elisp (name value)
    160   "Construct julia code assigning the elisp VALUE to a variable named NAME."
    161   (if (listp value)
    162       (let* ((lengths (mapcar #'length (cl-remove-if-not #'sequencep value)))
    163              (max (if lengths (apply #'max lengths) 0))
    164              (min (if lengths (apply #'min lengths) 0)))
    165         ;; Ensure VALUE has an orgtbl structure (depth of at least 2).
    166         (unless (listp (car value)) (setq value (list value)))
    167         (let ((file (orgtbl-to-csv value '(:fmt org-babel-julia-quote-csv-field))))
    168           (if (= max min)
    169               (format "%s = begin
    170     using CSV
    171     CSV.read(\"%s\")
    172 end" name file)
    173             (format "%s = begin
    174     using CSV
    175     CSV.read(\"%s\")
    176 end"
    177                     name file))))
    178     (format "%s = %s" name (org-babel-julia-quote-csv-field value))))
    179 
    180 (defvar ess-ask-for-ess-directory) ; dynamically scoped
    181 (defun org-babel-julia-initiate-session (session params)
    182   "If there is not a current julia process then create one."
    183   (unless (string= session "none")
    184     (let ((session (or session "*Julia*"))
    185 	  (ess-ask-for-ess-directory
    186 	   (and (bound-and-true-p ess-ask-for-ess-directory)
    187                 (not (cdr (assq :dir params))))))
    188       (if (org-babel-comint-buffer-livep session)
    189 	  session
    190 	;; FIXME: Depending on `display-buffer-alist', (julia) may end up
    191         ;; popping up a new frame which `save-window-excursion' won't be able
    192         ;; to "undo", so we really should call a kind of
    193         ;; `julia-no-select' instead so we don't need to undo any
    194         ;; window-changes afterwards.
    195 	(save-window-excursion
    196 	  (when (get-buffer session)
    197 	    ;; Session buffer exists, but with dead process
    198 	    (set-buffer session))
    199           (require 'ess) (set-buffer (julia))
    200 	  (rename-buffer
    201 	   (if (bufferp session)
    202 	       (buffer-name session)
    203 	     (if (stringp session)
    204 		 session
    205 	       (buffer-name))))
    206 	  (current-buffer))))))
    207 
    208 (defun org-babel-julia-graphical-output-file (params)
    209   "Name of file to which julia should send graphical output."
    210   (and (member "graphics" (cdr (assq :result-params params)))
    211        (cdr (assq :file params))))
    212 
    213 (defconst org-babel-julia-eoe-indicator "print(\"org_babel_julia_eoe\")")
    214 (defconst org-babel-julia-eoe-output "org_babel_julia_eoe")
    215 
    216 (defconst org-babel-julia-write-object-command "begin
    217     local p_ans = %s
    218     local p_tmp_file = \"%s\"
    219 
    220     try
    221         using CSV, DataFrames
    222 
    223         if typeof(p_ans) <: DataFrame
    224            p_ans_df = p_ans
    225         else
    226             p_ans_df = DataFrame(:ans => p_ans)
    227         end
    228 
    229         CSV.write(p_tmp_file,
    230                   p_ans_df,
    231                   writeheader = %s,
    232                   transform = (col, val) -> something(val, missing),
    233                   missingstring = \"nil\",
    234                   quotestrings = false)
    235         p_ans
    236     catch e
    237         err_msg = \"Source block evaluation failed. $e\"
    238         CSV.write(p_tmp_file,
    239                   DataFrame(:ans => err_msg),
    240                   writeheader = false,
    241                   transform = (col, val) -> something(val, missing),
    242                   missingstring = \"nil\",
    243                   quotestrings = false)
    244 
    245         err_msg
    246     end
    247 end")
    248 
    249 (defun org-babel-julia-evaluate
    250     (session body result-type result-params column-names-p)
    251   "Evaluate julia code in BODY."
    252   (if session
    253       (org-babel-julia-evaluate-session
    254        session body result-type result-params column-names-p)
    255     (org-babel-julia-evaluate-external-process
    256      body result-type result-params column-names-p)))
    257 
    258 (defun org-babel-julia-evaluate-external-process
    259     (body result-type result-params column-names-p)
    260   "Evaluate BODY in external julia process.
    261 If RESULT-TYPE equals `output' then return standard output as a
    262 string.  If RESULT-TYPE equals `value' then return the value of the
    263 last statement in BODY, as elisp."
    264   (cl-case result-type
    265     (value
    266      (let ((tmp-file (org-babel-temp-file "julia-")))
    267        (org-babel-eval org-babel-julia-command
    268 		       (format org-babel-julia-write-object-command
    269 			       (format "begin %s end" body)
    270 			       (org-babel-process-file-name tmp-file 'noquote)
    271                                (if column-names-p "true" "false")
    272                                ))
    273        (org-babel-julia-process-value-result
    274 	(org-babel-result-cond result-params
    275 	  (with-temp-buffer
    276 	    (insert-file-contents tmp-file)
    277 	    (buffer-string))
    278 	  (org-babel-import-elisp-from-file tmp-file '(4)))
    279 	column-names-p)))
    280     (output (org-babel-eval org-babel-julia-command body))))
    281 
    282 (defun org-babel-julia-evaluate-session
    283     (session body result-type result-params column-names-p)
    284   "Evaluate BODY in SESSION.
    285 If RESULT-TYPE equals `output' then return standard output as a
    286 string.  If RESULT-TYPE equals `value' then return the value of the
    287 last statement in BODY, as elisp."
    288   (cl-case result-type
    289     (value
    290      (with-temp-buffer
    291        (insert (org-babel-chomp body))
    292        (let ((ess-local-customize-alist t)
    293              (ess-local-process-name
    294 	      (process-name (get-buffer-process session)))
    295 	     (ess-eval-visibly-p nil))
    296 	 (ess-eval-buffer nil)))
    297      (let ((tmp-file (org-babel-temp-file "julia-")))
    298        (org-babel-comint-eval-invisibly-and-wait-for-file
    299 	session tmp-file
    300 	(format org-babel-julia-write-object-command
    301                 "ans"
    302 		(org-babel-process-file-name tmp-file 'noquote)
    303                 (if column-names-p "true" "false")
    304                 ))
    305        (org-babel-julia-process-value-result
    306 	(org-babel-result-cond result-params
    307 	  (with-temp-buffer
    308 	    (insert-file-contents tmp-file)
    309 	    (buffer-string))
    310 	  (org-babel-import-elisp-from-file tmp-file '(4)))
    311 	column-names-p)))
    312     (output
    313      (mapconcat
    314       #'org-babel-chomp
    315       (butlast
    316        (delq nil
    317 	     (mapcar
    318 	      (lambda (line) (when (> (length line) 0) line))
    319 	      (mapcar
    320 	       (lambda (line) ;; cleanup extra prompts left in output
    321 		 (if (string-match
    322 		      "^\\([>+.]\\([ ][>.+]\\)*[ ]\\)"
    323 		      (car (split-string line "\n")))
    324 		     (substring line (match-end 1))
    325 		   line))
    326 	       (org-babel-comint-with-output (session org-babel-julia-eoe-output)
    327 		 (insert (mapconcat #'org-babel-chomp
    328 				    (list body org-babel-julia-eoe-indicator)
    329 				    "\n"))
    330                  (inferior-ess-send-input))))))
    331       "\n"))))
    332 
    333 (defun org-babel-julia-process-value-result (result column-names-p)
    334   "Julia-specific processing of return value.
    335 Insert hline if column names in output have been requested."
    336   (if column-names-p
    337       (cons (car result) (cons 'hline (cdr result)))
    338     result))
    339 
    340 (provide 'ob-julia)
    341 
    342 ;;; ob-julia.el ends here