clojisr 1.1.0

Author: genmeblog

CHANGELOG.md

@@ -6,6 +6,7 @@ All notable changes to this project will be documented in this file. This change
 - use devcontainer setup following template
 - generate docs for r-required symbols
 - TMD bump to 8.x
+- :err and :out messages are redirected to `*err*` and `*out*` (was `*out*` always)
 
 ## [1.0.0]
 - `require-r` creates namespace as `r.namespace`, also `namespace` as an alias

deps.edn

@@ -1,24 +1,21 @@
 {:deps {org.clojure/clojure {:mvn/version "1.12.4"},
-        org.clojure/tools.logging {:mvn/version "1.3.0"},
+        org.clojure/tools.logging {:mvn/version "1.3.1"},
         scicloj/tablecloth {:mvn/version "8.016"}
         org.scicloj/clojisr-rengine {:mvn/version "0.1.2"}
-        ;; org.rosuda.REngine/Rserve {:mvn/version "1.8.1"}
-        hiccup/hiccup {:mvn/version "2.0.0-RC3"}
-        org.clojure/core.async {:mvn/version "1.6.681"}
-        org.scicloj/kindly {:mvn/version "4-beta12"}}
+        hiccup/hiccup {:mvn/version "2.0.0"}
+        org.scicloj/kindly {:mvn/version "4-beta23"}}
  :paths ["src"]
  :aliases {:dev {:extra-paths ["resources" "notebooks"]
                  :jvm-opts ["-Dclojure.tools.logging.factory=clojure.tools.logging.impl/jul-factory"
                             "-Djava.awt.headless=true"]
                  :extra-deps {org.scicloj/clay {:mvn/version "2-beta16"}
                               io.github.nextjournal/clerk {:mvn/version "0.7.418"}
                               org.scicloj/kind-portal {:mvn/version "1-beta3"}
-                              djblue/portal {:mvn/version "0.58.5"}
-                              }}
+                              djblue/portal {:mvn/version "0.63.1"}}}
            :test {:extra-paths ["test"]
                   :extra-deps {org.scicloj/clay {:mvn/version "2-beta8"}
                                io.github.cognitect-labs/test-runner
-                               {:git/tag "v0.5.0" :git/sha "b3fd0d2"}}
+                               {:git/tag "v0.5.1" :git/sha "dfb30dd"}}
                   :jvm-opts ["-Djava.awt.headless=true"]
                   :main-opts ["-m" "cognitect.test-runner"]
                   :exec-fn cognitect.test-runner.api/test}}}

src/clojisr/v1/applications/plotting.clj

@@ -1,33 +1,33 @@
 (ns ^:no-doc clojisr.v1.applications.plotting
-  (:require [clojisr.v1.r :refer [r r->clj rsymbol]]
+  (:require [clojisr.v1.r :as r :refer [r r->clj rsymbol require-r]]
             [clojisr.v1.util :refer [exception-cause]]
-            [clojisr.v1.require :refer [require-r]]
             [clojure.tools.logging.readable :as log]
-            [clojure.java.io :refer [make-parents]]
+            [clojure.java.io :as io]
             [scicloj.kindly.v4.kind :as kind])
   (:import [java.io File]
            [clojisr.v1.robject RObject]
            [java.awt Graphics2D Image]
            [java.awt.image BufferedImage]
            [javax.swing ImageIcon]))
 
-
-
+(defn- svglite-installed?
+  "Check if svglite is available."
+  []
+  (-> '(%in% "svglite" (rownames (installed.packages)))
+      (r)
+      (r->clj)
+      (first)))
 
 (def files->fns (delay
-                  (atom (let [_ (require-r '[grDevices])
-                              devices (select-keys (ns-publics 'r.grDevices) '[pdf png svg jpeg tiff bmp])]
-                          (if-let [jpg (get devices 'jpeg)]
-                            (let [devices (assoc devices 'jpg jpg)]
-                              (if (-> '(%in% "svglite" (rownames (installed.packages))) ;; check if svglite is available
-                                      (r)
-                                      (r->clj)
-                                      (first))
-                                (assoc devices 'svg (rsymbol "svglite" "svglite"))
-                                (do (log/warn [::plotting {:message "We highly recommend installing of `svglite` package."}])
-                                    devices)))
-                            devices)))))
-
+                (atom (let [_ (require-r '[grDevices])
+                            devices (select-keys (ns-publics 'r.grDevices) '[pdf png svg jpeg tiff bmp xfig postscript])
+                            svglite? (svglite-installed?)]
+                        (when-not svglite?
+                          (log/warn [::plotting {:message "We highly recommend installing of `svglite` package."}]))
+                        (cond-> devices
+                          (devices 'postscript) (assoc 'ps (devices 'postscript))
+                          (devices 'jpeg) (assoc 'jpg (devices 'jpeg))
+                          svglite? (assoc 'svg (rsymbol "svglite" "svglite")))))))
 
 (defn use-svg!
   "Use from now on build-in svg device for plotting svg."
@@ -40,9 +40,6 @@
   []
   (swap! @files->fns assoc 'svg (rsymbol "svglite" "svglite")))
 
-
-
-
 (defn plot->file
   [^String filename plotting-function-or-object & device-params]
   (let [r-print (delay (r "print"))
@@ -52,7 +49,7 @@
     (if-not (contains? @@files->fns extension)
       (log/warn [::plot->file {:message (format "%s filetype is not supported!" (name extension))}])
       (try
-        (make-parents filename)
+        (io/make-parents filename)
         (apply device :filename apath device-params)
         (let [the-plot-robject (try
                                  (if (instance? RObject plotting-function-or-object)

src/clojisr/v1/impl/rserve/proc.clj

@@ -3,6 +3,7 @@
 
 (ns clojisr.v1.impl.rserve.proc
   (:require [clojure.java.io :refer [reader writer]]
+            [clojure.string :as str]
             [clojure.java.shell :refer [sh]]
             [clojisr.v1.util :refer [file-exists?]]
             [clojure.tools.logging.readable :as log])
@@ -31,10 +32,9 @@
   "Find path to R executable"
   []
   {:post [(not= % "")]}
-  (apply str
-         (-> (sh "which" "R")
-             (get :out)
-             (butlast)))) ; avoid trailing newline
+  (-> (sh "which" "R")
+      (get :out)
+      (str/trim)))
 
 (defn alive? [rserve]
   (when rserve
@@ -60,8 +60,8 @@
                rstr-temp)]
 
     (spawn (r-path)
-           "--no-save" ; don't save workspace when quitting
+           "--no-save"            ; don't save workspace when quitting
            "--no-restore-data"
            "--slave"
-           "-e" ; evaluate (boot server)
+           "-e"                         ; evaluate (boot server)
            rstr)))

src/clojisr/v1/impl/rserve/session.clj

@@ -6,34 +6,30 @@
             [clojisr.v1.impl.rserve.call :as call]
             [clojisr.v1.impl.rserve.packages :as packages]
             [clojisr.v1.impl.rserve.printing :as printing]
-            [clojure.core.async :as async]
             [clojure.tools.logging.readable :as log]
             [clojisr.v1.util :refer [exception-cause get-free-port]])
   (:import [org.rosuda.REngine.Rserve RConnection]
            [java.io BufferedReader]))
 
-(def defaults
-  (atom
-   {:host "localhost"
-    :spawn-rserve? true}))
+(def defaults (atom {:host "localhost"
+                   :spawn-rserve? true}))
 
 (defn close! [{:keys [^RConnection r-connection rserve]}]
   (when r-connection
     (.close r-connection))
   (when rserve
-    (proc/close rserve))
-  nil)
+    (proc/close rserve)))
 
 ;; Session is valid when there is connection, also when we have rserve, process should be active
 ;; if something is not true, ensure cleaning the rest and close the session
 (defn active?-or-close! [{:keys [^RConnection r-connection rserve]
-                          :as sess}]
+                       :as session}]
   (let [state (and r-connection
                    (.isConnected r-connection)
                    (if-not rserve
                      true
                      (proc/alive? rserve)))]
-    (or state (close! sess))))
+    (or state (close! session))))
 
 (defrecord RserveSession [id
                           session-args
@@ -44,12 +40,9 @@
     (close! session))
   (closed? [session]
     (not (active?-or-close! session)))
-  (id [_session]
-    id)
-  (session-args [_session]
-    session-args)
-  (desc [_session]
-    session-args)
+  (id [_session] id)
+  (session-args [_session] session-args)
+  (desc [_session] session-args)
   (eval-r->java [session code]
     (log/debug [::eval-r->java {:code code
                                 :session-args (:session-args session)}])
@@ -58,16 +51,11 @@
     ;; Unlike (.assign r-connection ...), the following approach
     ;; allows for a varname like "abc$xyz".
     (locking r-connection
-      (.eval
-       r-connection
-       (call/assignment varname java-obj)
-       nil
-       true)))
+      (.eval r-connection (call/assignment varname java-obj) nil true)))
   (print-to-string [session r-obj]
     (printing/print-to-string session r-obj))
   (package-symbol->r-symbol-names [session package-symbol]
-    (packages/package-symbol->r-symbol-names
-     session package-symbol))
+    (packages/package-symbol->r-symbol-names session package-symbol))
 
   iprot/Engine
   (->nil [_] (rexp/->rexp-nil))
@@ -82,33 +70,37 @@
   (->named-list [_ ks vs] (rexp/->rexp-named-list ks vs))
   (native? [_ x] (rexp/rexp? x)))
 
-(defn rserve-print-loop [{:keys [rserve]
-                          :as session}]
-  (log/info [::rserve-print-loop {:action :started
-                                  :session-args (:session-args session)}])
-  (async/go-loop []
-    (doseq [^BufferedReader reader
-            (-> rserve
-                ((juxt :out :err)))]
-      (loop []
-        (when (.ready reader)
-          (let [line (.readLine reader)]
-            (when-not
-                (re-find
-                 ;; Just avoidingg this confusing message.
-                 #"(This session will block until Rserve is shut down)" line)
-              (println line)))
-          (recur))))
+(defn print-loop-task
+  [{:keys [rserve] :as session}]
+  (fn [] (doseq [[k output-stream] [[:out *out*] [:err *err*]]]
+          (let [^BufferedReader reader (-> rserve k)]
+            (binding [*out* output-stream]
+              (loop []
+                (when (.ready reader)
+                  (let [line (.readLine reader)]
+                    (when-not
+                        (re-find
+                         ;; Just avoidingg this confusing message.
+                         #"(This session will block until Rserve is shut down)" line)
+                      (println line)))
+                  (recur))))))
     (Thread/sleep 100)
     (if (not (prot/closed? session))
       (recur)
       (log/info [::rserve-print-loop {:action :stopped
                                       :session-args (:session-args session)}]))))
 
+(defn rserve-print-loop [session]
+  (log/info [::rserve-print-loop {:action :started
+                                  :session-args (:session-args session)}])
+  (.start (Thread. (print-loop-task session))))
+
+(defn make 
+  "Creates RServe session.
 
-(defn make [id session-args]
-  (let [{:keys [host port spawn-rserve? init-r]} (merge @defaults
-                                                        session-args)
+  Process is spawned (optionally), then connection is established."
+  [id session-args]
+  (let [{:keys [host port spawn-rserve? init-r] :as args} (merge @defaults session-args)
         port (or port (get-free-port))
         rserve (when spawn-rserve?
                  (proc/start-rserve port init-r))]
@@ -119,14 +111,14 @@
         (if (or (zero? attempts)
                 (proc/alive? rserve))
           (when-not (proc/alive? rserve)
-            (throw (Exception. "Can't create RServe process.")))
+            (throw (ex-info "Can't create RServe process." args)))
           (do
             (log/warn [::rserve-spawn {:message "Rserve is not alive yet, waiting 0.5s"}])
             (recur (dec attempts))))))
 
     (let [conn (loop [attempts (int 1)] ;; try 5 times to connect
                  (when (> attempts 5) ;; throw an Exception when can't connect
-                   (throw (Exception. "Can't connect to RServe, please check host/port settings.")))
+                   (throw (ex-info "Can't connect to RServe, please check host/port settings." args)))
                  (Thread/sleep (* attempts 200))
                  (let [conn (try
                               (RConnection. host port)
@@ -142,6 +134,6 @@
           session (->RserveSession id
                                    session-args
                                    conn
-                                   rserve)]      
+                                   rserve)]   
       (when rserve (rserve-print-loop session))
       session)))

src/clojisr/v1/impl/types.clj

@@ -46,6 +46,7 @@
 
 (defonce ^:private ^java.text.SimpleDateFormat date-format (java.text.SimpleDateFormat. "yyyy-MM-dd HH:mm:ss"))
 (defonce ^:private ^DateTimeFormatter java-time-date-format (DateTimeFormatter/ofPattern "yyyy-MM-dd HH:mm:ss"))
+
 (def ^:private java-time-formatters
   {ZonedDateTime java-time-date-format
    LocalDateTime java-time-date-format

src/clojisr/v1/require.clj

@@ -99,18 +99,18 @@
           r-object))
 
 
-(defn symbols->add-to-ns [ns-symbol r-symbols generate-doc-strings?]
+(defn symbols->add-to-ns [ns-symbol r-symbols docstrings?]
   (doseq [[r-symbol r-object] r-symbols]
     (add-to-ns ns-symbol r-symbol r-object))
 
-  (when generate-doc-strings?
+  (when docstrings?
     (run!
      (fn [[r-symbol r-object]]
        (assoc-doc-to-meta! ns-symbol r-symbol r-object))
      r-symbols)))
 
 
-(defn require-r-package [[package-symbol & {:keys [as refer generate-doc-strings?]}]]
+(defn require-r-package [[package-symbol & {:keys [as refer docstrings?]}]]
   (try
     (let [session (session/fetch-or-make nil)]
       (evl/eval-form `(library ~package-symbol) session)
@@ -119,26 +119,25 @@
                              symbol)
             r-symbols (all-r-symbols-map package-symbol)]
 
-      ;; r.package namespace
+        ;; r.package namespace
         (find-or-create-ns r-ns-symbol)
-        (symbols->add-to-ns r-ns-symbol r-symbols generate-doc-strings?)
+        (symbols->add-to-ns r-ns-symbol r-symbols docstrings?)
 
-      ;; alias namespaces
-      ;; https://clojurians.zulipchat.com/#narrow/stream/224816-clojisr-dev/topic/require-r.20vs.20-require-python
-      ;; https://clojurians.zulipchat.com/#narrow/stream/224816-clojisr-dev/topic/clojisr.201.2E1.2E0/near/441026754
+        ;; alias namespaces
+        ;; https://clojurians.zulipchat.com/#narrow/stream/224816-clojisr-dev/topic/require-r.20vs.20-require-python
+        ;; https://clojurians.zulipchat.com/#narrow/stream/224816-clojisr-dev/topic/clojisr.201.2E1.2E0/near/441026754
         (if as
           (alias as r-ns-symbol)
           (alias package-symbol r-ns-symbol))
 
-      ;; inject symbol into current namespace
+        ;; inject symbol into current namespace
         (when refer
           (let [this-ns-symbol (-> *ns* str symbol)]
-            (symbols->add-to-ns
-             this-ns-symbol
-             (if (= refer :all)
-               r-symbols
-               (select-keys r-symbols refer))
-             generate-doc-strings?)))))
+            (symbols->add-to-ns this-ns-symbol
+                                (if (= refer :all)
+                                  r-symbols
+                                  (select-keys r-symbols refer))
+                                docstrings?)))))
     (catch Exception e
       (log/warn [::require-r-package {:package-symbol package-symbol
                                       :cause (exception-cause e)}])

test/clojisr/v1/help_test.clj

@@ -6,7 +6,7 @@
 
 
 (deftest help-docstring
-  (r/require-r '[stats :generate-doc-strings? true])
+  (r/require-r '[stats :docstrings? true])
   (is (str/starts-with? 
        (->
         (ns-publics 'r.stats)
@@ -22,9 +22,7 @@
        "Fitting Linear")))
 
 (deftest require-defauls-should-not-throws-exception
-
-  ; should not crash
-  (r/require-r '[base :generate-doc-strings? true])
+  (r/require-r '[base :docstrings? true])
   (r/require-r '[stats])
   (r/require-r '[utils])
   (r/require-r '[graphics])