Merge pull request #99 from behrica/lazyRDefs

Lazy r defs

.gitignore

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

CHANGELOG.md

@@ -2,10 +2,9 @@
 All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/).
 
 ## unreleased
-
+- added more operators `%/%`, `%%` ,`%in%`, `xor`
 - use devcontainer setup following template
 
-
 ## [1.0.0]
 - `require-r` creates namespace as `r.namespace`, also `namespace` as an alias
 - dependencies update, TMD 7.029

deps.edn

@@ -12,7 +12,9 @@
                  :extra-deps {org.scicloj/clay {:mvn/version "2-beta16"}
                               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"]
+                  :jvm-opts ["-Djava.awt.headless=true" ]
                   :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,25 @@
      (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 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 "`:`"))
+ (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))
 
-;;
 
 (defmacro defr
   "Create Clojure and R bindings at the same time"
@@ -174,7 +159,7 @@
   ([package string-or-symbol]
    (r (str (maybe-wrap-backtick package) "::" (maybe-wrap-backtick string-or-symbol)))))
 
-;; brackets!
+
 
 ;; FIXME! Waiting for session management.
 (defn- prepare-args-for-bra
@@ -185,16 +170,8 @@
      (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)
+
 
 ;; register shutdown hook
 ;; should be called once
@@ -222,3 +199,142 @@
   "Prints help for an R object or function"
   ([r-object] (println (help r-object)))
   ([function package] (println (help function package))))
+
+
+;; arithmetic operators
+(defn r- 
+  "R arithmetic operator `-`"
+  [e1 e2] ((r "`-`") e1 e2))
+
+(defn rdiv 
+  "R arithmetic operator `/`"
+  [e1 e2] ((r "`/`") e1 e2))
+
+(defn r* 
+  "R arithmetic operator `*`, but can be used on an arbitraty number of arguments."
+  [& args] 
+  (reduce (r "`*`") args))
+
+(defn r+
+  "R arithmetic operator `+`, but can be used on an arbitraty number of arguments."
+  [& args]
+  (reduce (r "`+`") args))
+
+(defn r** 
+  "R arithmetic operator `^`"
+  [e1 e2] 
+  ((r "`^`") e1 e2)) 
+
+(defn r%div%
+  "R arithmetic operator `%/%`"
+  [e1 e2]
+  ((r "`%/%`") e1 e2))
+
+(defn r%%
+  "R arithmetic operator `%%`"
+  [e1 e2]
+  ((r "`%%`") e1 e2))
+
+;; relational operators
+(defn r== 
+  "R relational operator `==`"
+  [e1 e2] ( (r "`==`") e1 e2))
+
+(defn r!= 
+  "R relational operator `=!`"
+  [e1 e2] ((r "`!=`") e1 e2))
+
+(defn r< 
+  "R relational operator `<`"
+  [e1 e2] ((r "`<`") e1 e2))
+
+(defn r> 
+  "R relational operator `>`"
+  [e1 e2] ((r "`>`") e1 e2))
+
+(defn r<= 
+  "R relational operator `<=`" 
+  [e1 e2] ((r "`<=`") e1 e2))
+
+(defn r>= 
+  "R relational operator `>=`" 
+  [e1 e2] ((r "`>=`") e1 e2))
+
+;; logical operators
+(defn r& 
+  "R logical operator `&`"
+  [e1 e2] ((r "`&`") e1 e2))
+
+(defn r&& 
+  "R logical operator `&&`"
+  [e1 e2] ((r "`&&`") e1 e2))
+
+(defn r| 
+  "R logical operator `|`"
+  [e1 e2] ((r "`|`") e1 e2))
+
+(defn r||
+  "R logical operator `||`"
+  [e1 e2] ((r "`||`") e1 e2))
+
+(defn r!
+  "R logical operator `!`"
+  [e] ((r "`!`") e))
+
+(defn rxor
+  "R logical operator `xor`"
+  [e1 e2] ((r "`xor`") e1 e2))
+
+
+;; colon operators
+(defn colon 
+  "R colon operator `:`"
+  [e1 e2] ((r "`:`") e1 e2))
+(defn rcolon 
+  "R colon operator `:`"
+  [e1 e2] (colon e1 e2))
+
+;; extract/replace operators
+(defn r$
+  "R extract operator `$`"
+  [e1 e2] ((r "`$`") e1 e2))
+
+
+(defn r%in%
+  "R match operator `%in%`"
+  [e1 e2] ((r "`%in%`") e1 e2))
+
+
+
+(defn bra 
+  "R extract operator `[`"
+  [& pars]
+  (let
+   [bra (clojisr.v1.r/r "`[`")
+    fixed (prepare-args-for-bra pars true)]
+    (clojure.core/apply bra fixed)))
+
+(defn brabra 
+  "R extract operator `[[`"
+  [& pars]
+  (let
+   [bra (clojisr.v1.r/r "`[[`")
+    fixed (prepare-args-for-bra pars true)]
+    (clojure.core/apply bra fixed)))
+
+(defn bra<- 
+  "R replace operator `[<-`"
+  [& pars]
+  (let
+   [bra (clojisr.v1.r/r "`[<-`")
+    fixed (prepare-args-for-bra pars false)]
+    (clojure.core/apply bra fixed)))
+
+(defn brabra<- 
+  "R replace operator `[[<-`"
+  [& pars]
+  (let
+   [bra (clojisr.v1.r/r "`[[<-`")
+    fixed (prepare-args-for-bra pars false)]
+    (clojure.core/apply bra fixed)))
+

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")))))
+