add preserved_refs

Author: rcqls

.vscode/settings.json

@@ -0,0 +1,5 @@
+{
+    "files.associations": {
+        "functional": "c"
+    }
+}

NAMESPACE

@@ -20,6 +20,7 @@ S3method("jl",integer)
 S3method("jl",double)
 S3method("jl",logical)
 S3method("jl",character)
+S3method("jl",factor)
 
 S3method("names",jlStruct)
 S3method("[",jlStruct)

R/jl_dataframe.R

@@ -11,15 +11,32 @@ names.DataFrame <- function(jlval) jlcallR("names",jlval)
         jlcall("getindex",jlval, i, jl_symbol(field))
     } else NULL
 }
+
 "$.DataFrame" <- function(jlval, field) jlval[field]
 
+toR.DataFrame <- function(jlval) {
+    nms <- toR(jlcall("names",jlval))
+    res <- list()
+    for(nm in nms) {
+        res[[nm]] <- jlcallR("getindex",jlval, jl_colon(), jl_symbol(nm))
+    }
+    attr(res,"row.names") <- as.character(1:length(res[[1]]))
+    class(res) <- "data.frame"
+    res
+}
+
 jl.data.frame <- function(df) {
     jlusing("DataFrames")
     DF <- jlcall("splat",jl("DataFrame"))
-    jl_args <- jl("[]")
+    args <- jl("[]")
+    vars <- list()
+    pairs <-list()
     for( nm in names(df)) {
-        jlcall("=>",jl_symbol("a"),jl(c(1,2,3)))
-        df[[nm]]
+        vars[[nm]] <- jl(df[[nm]])
+        pairs[[nm]] <- jlcall("=>",jl_symbol(nm), vars[[nm]])
+        jlcall("push!", args, pairs[[nm]])
     }
-    # jlcall("vcat",jlcall("=>",jl_symbol("a"),jl(c(1,2,3))),jlcall("=>",jl_symbol("b"),jl(c(3,4,1)))) -> jl_args
+    jl_func1(DF,args) -> jlval
+    # attr(jlval,"deps") <- list(vars=vars,pairs=pairs)
+    jlval
 }

R/jl_factor.R

@@ -0,0 +1,14 @@
+
+
+toR.CategoricalArray <- function(jlval) {
+    pool <- jl_getfield(jlval,"pool")
+    res <- jlR_getfield(jlval,"refs")
+    attr(res,"levels") <- jlcallR("levels",pool)
+    class(res) <- "factor"
+    res
+}
+
+jl.factor <- function(fa) {
+    jlusing("CategoricalArrays")
+    jlcall("categorical",jl(as.character(fa)))
+}

R/jltypes.R

@@ -12,10 +12,14 @@ jl_typeof <- function(jlval) {
 
 is.jlValue <- function(obj) inherits(obj,"jlValue")
 
-print.jlValue <- function(obj, ...) {
-    # cat(paste(class(obj),collapse=","),":\n",sep="")
-    # print(toR(obj))
-    invisible(jlcallR("display",obj))
+# print.jlValue <- function(obj, ...) {
+#     # cat(paste(class(obj),collapse=","),":\n",sep="")
+#     # print(toR(obj))
+#     invisible(jlcallR("display",obj))
+# }
+
+print.jlValue <- function(jlval, ...) {
+    invisible(.Call("jl4R_show_preserved_ref", jlval, PACKAGE = "jl4R"))
 }
 
 print.jlUnprintable <- function(obj, ...) print.default(obj)
@@ -40,23 +44,4 @@ toR.jlValue <- function(jlval) {
             if(is.list(res)) simplify2array(res) else res
         }
     }
-}
-
-toR.DataFrame <- function(jlval) {
-    nms <- toR(jlcall("names",jlval))
-    res <- list()
-    for(nm in nms) {
-        res[[nm]] <- jlcallR("getindex",jlval, jl_colon(), jl_symbol(nm))
-    }
-    attr(res,"row.names") <- as.character(1:length(res[[1]]))
-    class(res) <- "data.frame"
-    res
-}
-
-toR.CategoricalArray <- function(jlval) {
-    pool <- jl_getfield(jlval,"pool")
-    res <- jlR_getfield(jlval,"refs")
-    attr(res,"levels") <- jlcallR("levels",pool)
-    class(res) <- "factor"
-    res
 }

R/jlutils.R

@@ -1,4 +1,10 @@
-jl_symbol <- function(field) jl(paste0(":",field))
+# jl_symbol <- function(field) jl(paste0(":",field))
+jl_symbol <- function(field) {
+    if(!.jlrunning()) .jlinit()
+    res <- .External("jl4R_jl_symbol", field, PACKAGE = "jl4R")
+    res
+}
+
 jl_colon <- function() jl_unsafe(":")
 ## Struct facility