Lazy r defs

.devcontainer/Dockerfile

@@ -2,4 +2,4 @@ FROM mcr.microsoft.com/devcontainers/java:11-bullseye
 
 RUN bash -c "bash < <(curl -s https://raw.githubusercontent.com/babashka/babashka/master/install)"
 RUN bash -c "bash < <(curl -s https://raw.githubusercontent.com/clojure-lsp/clojure-lsp/master/install)"
-RUN apt-get update && apt-get install -y rlwrap gfortran libblas-dev liblapack-dev  libpng-dev libfontconfig1-dev libfreetype-dev gfortran  libicu-dev cmake
+RUN apt-get update && apt-get install -y rlwrap gfortran libblas-dev liblapack-dev  libpng-dev libfontconfig1-dev libfreetype-dev gfortran  libicu-dev cmake leiningen

.devcontainer/devcontainer.json

@@ -8,7 +8,9 @@
 
     "features": {
 	    	"ghcr.io/devcontainers-contrib/features/clojure-asdf:2": {},
-		"ghcr.io/rocker-org/devcontainer-features/r-apt:0": {}
+		"ghcr.io/rocker-org/devcontainer-features/r-apt:0": {},
+	        "ghcr.io/devcontainers-contrib/features/leiningen-sdkman:2": {},
+	        "ghcr.io/rocker-org/devcontainer-features/quarto-cli:1": {}
 
 
 },
@@ -20,7 +22,6 @@
 			"extensions": 
 			[
 				"vscjava.vscode-java-pack",
-				"borkdude.clj-kondo",
 				"betterthantomorrow.calva"
 			]
 		}

.gitignore

@@ -18,3 +18,4 @@ pom.xml.asc
 .clay*
 *qmd
 .clerk
+.calva

deps.edn

@@ -12,7 +12,8 @@
                  :extra-deps {org.scicloj/clay {:mvn/version "2-beta8"}
                               io.github.nextjournal/clerk {:mvn/version "0.7.418"}}}
            :test {:extra-paths ["test"]
-                  :extra-deps {io.github.cognitect-labs/test-runner
+                  :extra-deps {org.scicloj/clay {:mvn/version "2-beta8"}
+                               io.github.cognitect-labs/test-runner
                                {:git/tag "v0.5.0" :git/sha "b3fd0d2"}}
                   :main-opts ["-m" "cognitect.test-runner"]
                   :exec-fn cognitect.test-runner.api/test}}}

project.clj

@@ -4,8 +4,11 @@
   :license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
             :url "https://www.eclipse.org/legal/epl-2.0/"}
   :plugins [[lein-tools-deps "0.4.5"]]
-  :test-paths ["notebooks"]
+  :test-paths ["test","notebooks"]
   :middleware [lein-tools-deps.plugin/resolve-dependencies-with-deps-edn]
   ;; :repositories {"bedatadriven" {:url "https://nexus.bedatadriven.com/content/groups/public/"}}
   :lein-tools-deps/config {:config-files [:install :user :project]}
+  :profiles {
+             :test     {:dependencies [[org.scicloj/clay "2-beta8"]]}}
+
   :jvm-opts ["-Dclojure.tools.logging.factory=clojure.tools.logging.impl/jul-factory"])

src/clojisr/v1/applications/plotting.clj

@@ -11,53 +11,57 @@
            [java.awt.image BufferedImage]
            [javax.swing ImageIcon]))
 
-(require-r '[grDevices])
 
-(def files->fns (atom (let [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 {:messaage "We highly recommend installing of `svglite` package."}])
-                                  devices)))
-                          devices))))
+
+
+(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 {:messaage "We highly recommend installing of `svglite` package."}])
+                                    devices)))
+                            devices)))))
 
 
 (defn use-svg!
   "Use from now on build-in svg device for plotting svg."
   []
-  (swap! files->fns assoc 'svg (get (ns-publics 'r.grDevices) 'svg)))
+  (swap! @files->fns assoc 'svg (get (ns-publics 'r.grDevices) 'svg)))
 
 (defn use-svglite!
   "Use from now on svglite device for plotting svg.
   Requires package `svglite` to be installed"
   []
-  (swap! files->fns assoc 'svg (rsymbol "svglite" "svglite")))
+  (swap! @files->fns assoc 'svg (rsymbol "svglite" "svglite")))
+
 
 
-(def ^:private r-print (r "print")) ;; avoid importing `base` here
 
 (defn plot->file
   [^String filename plotting-function-or-object & device-params]
-  (let [apath (.getAbsolutePath (File. filename))
+  (let [r-print (delay (r "print"))
+        apath (.getAbsolutePath (File. filename))
         extension (symbol (or (second (re-find #"\.(\w+)$" apath)) :no))
-        device (@files->fns extension)]
-    (if-not (contains? @files->fns extension)
+        device (@@files->fns extension)]
+    (if-not (contains? @@files->fns extension)
       (log/warn [::plot->file {:message (format "%s filetype is not supported!" (name extension))}])
       (try
         (make-parents filename)
         (apply device :filename apath device-params)
         (let [the-plot-robject (try
                                  (if (instance? RObject plotting-function-or-object)
-                                   (r-print plotting-function-or-object)
+                                   (@r-print plotting-function-or-object)
                                    (plotting-function-or-object))
                                  (catch Exception e
                                    (log/warn [::plot->file {:message   "Evaluation plotting function failed."
                                                             :exception (exception-cause e)}]))
-                                 (finally (r.grDevices/dev-off)))]
+                                 (finally (r "grDevices::dev.off()")))]
           (log/debug [[::plot->file {:message (format "File %s saved." apath)}]])
           the-plot-robject)
         (catch clojure.lang.ExceptionInfo e (throw e))

src/clojisr/v1/r.clj

@@ -9,7 +9,7 @@
             [clojisr.v1.impl.java-to-clj :as java2clj]
             [clojisr.v1.impl.clj-to-java :as clj2java]
             [clojure.string :as string]
-            [clojisr.v1.util :refer [bracket-data maybe-wrap-backtick]]
+            [clojisr.v1.util :refer [maybe-wrap-backtick]]
             [clojisr.v1.require :refer [require-r-package]]
             [clojisr.v1.engines :refer [engines]])
   (:import clojisr.v1.robject.RObject))
@@ -124,40 +124,40 @@
      (r (format fmt n (name package)))
      (intern *ns* ns (r ns)))))
 
-(def r== (r "`==`"))
-(def r!= (r "`!=`"))
-(def r< (r "`<`"))
-(def r> (r "`>`"))
-(def r<= (r "`<=`"))
-(def r>= (r "`>=`"))
-(def r& (r "`&`"))
-(def r&& (r "`&&`"))
-(def r| (r "`||`"))
-(def r|| (r "`||`"))
-(def r! (r "`!`"))
-(def r$ (r "`$`"))
-
-(def captured-str
-  "For the R function [str](https://www.rdocumentation.org/packages/utils/versions/3.6.1/topics/str), we capture the standard output and return the corresponding string."
-  (r "function(x) capture.output(str(x))"))
-
-(def println-captured-str (comp println-r-lines captured-str))
-
-(def str-md (comp r-lines->md captured-str))
-
-(def r** (r "`^`"))
-(def rdiv (r "`/`"))
-(def r- (r "`-`"))
+(defn- intern-r-binary [clj-op op]
+  (intern *ns*  (symbol clj-op)
+          (fn [e1 e2]
+            ((clojisr.v1.r/r (format  "`%s`" op)) e1 e2))))
+
+
+ (defn- captured-str []
+   "For the R function [str](https://www.rdocumentation.org/packages/utils/versions/3.6.1/topics/str), we capture the standard output and return the corresponding string."
+   (r "function(x) capture.output(str(x))")  )
+
+ (defn println-captured-str[x] 
+   (->
+    (apply-function
+     (captured-str)
+     [x])
+    println-r-lines))
+
+ (defn str-md [x]
+   (->
+    (apply-function
+     (captured-str)
+     [x])
+    r-lines->md))
+
+
+
 (defn r* [& args] (reduce (r "`*`") args))
+
 (defn r+
   "The plus operator is a binary one, and we want to use it on an arbitraty number of arguments."
   [& args]
   (reduce (r "`+`") args))
 
-;; Some special characters will get a name in letters.
-(def colon (r "`:`"))
 
-;;
 
 (defmacro defr
   "Create Clojure and R bindings at the same time"
@@ -185,16 +185,32 @@
      (prepare-args-for-bra pars)
      (conj (prepare-args-for-bra (butlast pars)) (last pars)))))
 
-(defmacro ^:private make-bras
-  []
-  `(do ~@(for [[bra-sym-name [bra-str all?]] bracket-data
-               :let [bra-sym (symbol bra-sym-name)]]
-           `(let [bra# (r ~bra-str)]
-              (defn ~bra-sym [& pars#]
-                (let [fixed# (prepare-args-for-bra pars# ~all?)]
-                  (apply bra# fixed#)))))))
 
-(make-bras)
+(defn bra [& pars]
+  (let
+   [bra (clojisr.v1.r/r "`[`")
+    fixed (prepare-args-for-bra pars true)]
+    (clojure.core/apply bra fixed)))
+
+(defn brabra [& pars]
+  (let
+   [bra (clojisr.v1.r/r "`[[`")
+    fixed (prepare-args-for-bra pars true)]
+    (clojure.core/apply bra fixed)))
+
+(defn bra<- [& pars]
+  (let
+   [bra (clojisr.v1.r/r "`[<-`")
+    fixed (prepare-args-for-bra pars false)]
+    (clojure.core/apply bra fixed)))
+
+(defn brabra<- [& pars]
+  (let
+   [bra (clojisr.v1.r/r "`[[<-`")
+    fixed (prepare-args-for-bra pars false)]
+    (clojure.core/apply bra fixed)))
+
+
 
 ;; register shutdown hook
 ;; should be called once
@@ -222,3 +238,16 @@
   "Prints help for an R object or function"
   ([r-object] (println (help r-object)))
   ([function package] (println (help function package))))
+
+
+(run!
+ (fn [op] (intern-r-binary (str "r" op) op))
+ ["==", "!=" "<" ">" "<=" ">=" "&" "&&" "|" "||"  "$" "-"])
+
+(intern *ns* (symbol "r!")
+        (fn [e]
+          ((clojisr.v1.r/r "`!`") e)))
+(intern-r-binary "r**" "^")
+(intern-r-binary "rdiv" "/")
+;; Some special characters will get a name in letters.
+(intern-r-binary "colon" ":")

test/clojisr/v1/applications/plotting_test.clj

@@ -0,0 +1,25 @@
+(ns clojisr.v1.applications.plotting-test
+  (:require [clojisr.v1.applications.plotting :as plot]
+            [clojisr.v1.r :as r]
+            [clojure.string :as str]
+            [clojisr.v1.applications.plotting :refer [plot->svg plot->file plot->buffered-image]]
+            [clojure.test :refer [is deftest]]))
+
+(r/require-r '[graphics :refer [plot hist]])
+
+(deftest plot-svg 
+  (let [svg
+        (plot->svg
+         (fn []
+           (->> rand
+                (repeatedly 30)
+                (reductions +)
+                (plot :xlab "t"
+                      :ylab "y"
+                      :type "l"))))]
+
+    (is ( true?
+         (str/includes?
+          svg
+          "M 3.8125 -7.96875 C 3.207031 -7.96875 2.75 -7.664062 2.4375 -7.0625")))))
+

test/clojisr/v1/r_test.clj

@@ -0,0 +1,95 @@
+(ns clojisr.v1.r-test
+  (:require [clojisr.v1.r :as r]
+            [tech.v3.dataset :as ds]
+            [clojisr.v1.require :as require-r]
+            [clojure.test :refer [is deftest] :as t])) 
+
+(require-r/require-r '[datasets])
+(require-r/require-r '[base])
+
+(def v [1 2 3])
+
+
+(deftest bras
+  (is (= [1]
+         (-> (r/bra v 1) r/r->clj)))
+  (is (= [1]
+         (-> (r/brabra v 1) r/r->clj))))
+
+
+(deftest binaries 
+  (is (= [true false false false true true true true true true 0 2 1 1.0 1]
+
+         (map 
+          (fn [f]
+            (first (r/r->clj (f 1 1))))
+
+          [r/r== 
+           r/r!= 
+           r/r<
+           r/r>
+           r/r<=
+           r/r>=
+           r/r&
+           r/r&&
+           r/r|
+           r/r||
+           r/r-
+           r/r+
+           r/r*
+           r/rdiv
+           r/colon
+           ]))))
+
+(deftest unary 
+
+  (is (= 9.0 (-> (r/r** 3 2) r/r->clj first)))
+  (is (not
+       (-> (r/r! true) r/r->clj first)
+       )))
+
+
+
+(deftest bra-colon
+  (is  (= [21.0]
+          (-> r.datasets/mtcars
+              (r/r$  "mpg")
+              (r/brabra 1)
+              (r/r->clj))))
+  (is  (= [21.0 22.8 21.4]
+          (-> r.datasets/mtcars
+              (r/r$  "mpg")
+              (r/bra (r/colon 2 4))
+              (r/r->clj)))))
+
+(deftest str-md
+  (r/println-captured-str r.datasets/mtcars)
+  (is (= 
+       "```\n'data.frame':\t32 obs. of  11 variables:\n $ mpg : num  21 21 22.8 21.4 18.7 18.1 14.3 24.4 22.8 19.2 ...\n $ cyl : num  6 6 4 6 8 6 8 4 4 6 ...\n $ disp: num  160 160 108 258 360 ...\n $ hp  : num  110 110 93 110 175 105 245 62 95 123 ...\n $ drat: num  3.9 3.9 3.85 3.08 3.15 2.76 3.21 3.69 3.92 3.92 ...\n $ wt  : num  2.62 2.88 2.32 3.21 3.44 ...\n $ qsec: num  16.5 17 18.6 19.4 17 ...\n $ vs  : num  0 0 1 1 0 1 0 1 1 1 ...\n $ am  : num  1 1 1 0 0 0 0 0 0 0 ...\n $ gear: num  4 4 4 3 3 3 3 4 4 4 ...\n $ carb: num  4 4 1 1 2 1 4 2 2 4 ...\n```"
+       (r/str-md r.datasets/mtcars))))
+
+
+
+(deftest brabra<- 
+  (is (= 8
+         (->
+          (r/brabra<-
+           (base/matrix (r/colon 1 12))
+           1 8)
+          r/r->clj
+          (ds/column 1)
+          first))))
+
+(deftest bra<-
+  (is (= 8
+         (->
+          (r/bra<-
+           (range 5)
+           1 8)
+          r/r->clj
+          first)
+         )))
+
+
+
+