### reflection functions - convenience function relying on the low-level
### functions .jcall/.jnew and friends
### reflection tools (inofficial so far, because it returns strings
### instead of the reflection objects - it's useful for quick checks,
### though)
.jmethods <- function(o, name=NULL, as.obj=FALSE, class.loader=.rJava.class.loader) {
cl <- if (is(o, "jobjRef")) .jcall(o, "Ljava/lang/Class;", "getClass") else if (is(o, "jclassName")) o@jobj else .jfindClass(as.character(o), class.loader=class.loader)
ms<-.jcall(cl,"[Ljava/lang/reflect/Method;","getMethods")
if (length(name)) {
n <- sapply(ms, function(o) .jcall(o, "S", "getName"))
ms <- ms[grep(name, n)]
}
if (isTRUE(as.obj)) ms else unlist(lapply(ms,function(x) .jcall(x,"S","toString")))
}
.jconstructors <- function(o, as.obj=FALSE, class.loader=.rJava.class.loader) {
cl <- if (is(o, "jobjRef")) .jcall(o, "Ljava/lang/Class;", "getClass") else if (is(o, "jclassName")) o@jobj else .jfindClass(as.character(o), class.loader=class.loader)
cs<-.jcall(cl,"[Ljava/lang/reflect/Constructor;","getConstructors")
if (isTRUE(as.obj)) return(cs)
unlist(lapply(cs,function(x) .jcall(x,"S","toString")))
}
### this list maps R class names to Java class names for which the constructor does the necessary conversion (for use in .jrcall)
### The order matters in case an object inherits from multiple (S3) classes - then the first one
### in the list is picked.
.class.to.jclass <- c(
jlong = "java/lang/Long",
jchar = "java/lang/Character",
jshort = "java/lang/Short",
jfloat = "java/lang/Float",
jbyte = "java/lang/Byte",
integer = "java/lang/Integer",
numeric = "java/lang/Double",
logical = "java/lang/Boolean",
character= "java/lang/String"
)
### Java classes that have a corresponding primitive type and thus a corresponding TYPE field to use with scalars
.primitive.classes = c("java/lang/Byte", "java/lang/Integer", "java/lang/Double", "java/lang/Boolean",
"java/lang/Long", "java/lang/Character", "java/lang/Short", "java/lang/Float")
### creates a valid java object
### if a is already a java object reference, all is good
### otherwise some primitive conversion occurs
# this is used for internal purposes only, in particular
# it does not dispatch arrays to jrectRef
._java_valid_object <- function(a) {
if (is(a, "jobjRef")) a
else if (is(a, "jclassName")) a@jobj
else if (is.null(a)) .jnull()
else if (is.raw(a)) .jarray(a, dispatch=FALSE) ## raw is always [B
else {
## check all classes (in S3 case, see #317)
cm <- match(class(a), names(.class.to.jclass))
if (!all(is.na(cm))) { ## at least one subclass matches
cm <- min(cm, na.rm=TRUE) ## pick the lowest (i.e. in precedence of the order above)
## scalar? then create directly
if (length(a) == 1) {
y <- .jnew(.class.to.jclass[cm], a)
if (.class.to.jclass[cm] %in% .primitive.classes) attr(y, "primitive") <- TRUE
y
} else .jarray(a, dispatch = FALSE)
} else {
stop("Sorry, parameter type `", class(a)[1] ,"' is ambiguous or not supported.")
}
}
}
### creates a list of valid java parameters, used in both .J and .jrcall
._java_valid_objects_list <- function( ... )
lapply(list(...), ._java_valid_object )
### returns a list of Class objects
### this is used in both .J and .jrcall
._isPrimitiveReference <- function(x)
isTRUE(attr(x, "primitive"))
._java_class <- function( x ){
## FIXME: not sure how to pass though the class loader here - only affects NULL objects
if (is.jnull(x)) { if (is(x,"jobjRef")) .jfindClass(x@jclass) else .jclassObject } else {
if (._isPrimitiveReference(x)) .jfield(x, "Ljava/lang/Class;", "TYPE") else .jcall(x, "Ljava/lang/Class;", "getClass")
}
}
._java_class_list <- function( objects_list )
lapply(objects_list, ._java_class )
### reflected call - this high-level call uses reflection to call a method
### it is much less efficient than .jcall but doesn't require return type
### specification or exact matching of parameter types
.jrcall <- function(o, method, ..., simplify=TRUE, class.loader=.rJava.class.loader) {
if (!is.character(method) | length(method) != 1)
stop("Invalid method name - must be exactly one character string.")
if (.need.init()) .jinit()
if (is(o, "jclassName"))
cl <- o@jobj
else if (is(o, "jobjRef"))
cl <- .jcall(o, "Ljava/lang/Class;", "getClass")
else
cl <- .jfindClass(o, class.loader=class.loader)
if (is.jnull(cl))
stop("Cannot find class of the object.")
# p is a list of parameters that are formed solely by valid Java objects
p <- ._java_valid_objects_list(...)
# list of classes
pc <- ._java_class_list( p )
# invoke the method directly from the RJavaTools class
# ( this throws the actual exception instead of an InvocationTargetException )
j_p <- .jarray(p, "java/lang/Object" , dispatch = FALSE )
j_pc <- .jarray(pc, "java/lang/Class" , dispatch = FALSE )
r <- .jcall( "RJavaTools", "Ljava/lang/Object;", "invokeMethod",
cl, .jcast(if(inherits(o,"jobjRef") || inherits(o, "jarrayRef")) o else cl, "java/lang/Object"),
.jnew( "java/lang/String", method),
j_p, j_pc, use.true.class = TRUE, evalString = simplify, evalArray = FALSE )
# null is returned when the return type of the method is void
# TODO[romain]: not sure how to distinguish when the result is null but the
# return type is not null
if( is.jnull( r ) || is.null(r) ){
return( invisible( NULL ) )
}
# simplify if needed and return the object
if( is(r, "jarrayRef" ) && simplify ){
._jarray_simplify( r )
} else if (simplify){
.jsimplify(r)
} else {
r
}
}
### reflected construction of java objects
### This uses reflection to call a suitable constructor based
### on the classes of the ... it does not require exact match between
### the objects and the constructor parameters
### This is to .jnew what .jrcall is to .jcall
.J <- function(class, ..., class.loader=.rJava.class.loader) {
## if it is a name, load the class, otherwise assume we have the object
if (is.character(class)) {
## allow non-JNI specifiation
class <- gsub("\\.","/",class)
class <- .jfindClass(class, class.loader=class.loader)
} else if (is(class, "jclassName")) {
class <- class@jobj
}
# p is a list of parameters that are formed solely by valid Java objects
p <- ._java_valid_objects_list(...)
# list of classes
pc <- ._java_class_list( p )
# use RJavaTools to find create the object
o <- .jcall("RJavaTools", "Ljava/lang/Object;",
"newInstance", class,
.jarray(p,"java/lang/Object", dispatch = FALSE ),
.jarray(pc,"java/lang/Class", dispatch = FALSE ),
evalString = FALSE, evalArray = FALSE, use.true.class = TRUE )
o
}
## make sure Java's -2147483648
.iNA <- function(o, convert=TRUE) if(convert && is.na(o)) -2147483648.0 else o
### simplify non-scalar reference to a scalar object if possible
.jsimplify <- function(o, promote=FALSE) {
if (!inherits(o, "jobjRef") && !inherits(o, "jarrayRef"))
return(o)
cn <- .jclass(o, true=TRUE)
if (cn == "java.lang.Boolean") .jcall(o, "Z", "booleanValue") else
if (cn == "java.lang.Integer" || cn == "java.lang.Short" || cn == "java.lang.Character" || cn == "java.lang.Byte") .iNA(.jcall(o, "I", "intValue"), promote) else
if (cn == "java.lang.Number" || cn == "java.lang.Double" || cn == "java.lang.Long" || cn == "java.lang.Float") .jcall(o, "D", "doubleValue") else
if (cn == "java.lang.String") .jstrVal(.jcast(o, "java/lang/String")) else
o
}
#! ### get the value of a field (static class fields are not supported yet)
#! .jrfield <- function(o, name, simplify=TRUE, true.class=TRUE) {
#! if (!inherits(o, "jobjRef") && !inherits(o, "jarrayRef") && !is.character(o))
#! stop("Object must be a Java reference or class name.")
#! if (is.character(o)) {
#! cl <- .jfindClass(o)
#! .jcheck(silent=TRUE)
#! if (is.null(cl))
#! stop("class not found")
#! o <- .jnull()
#! } else {
#! cl <- .jcall(o, "Ljava/lang/Class;", "getClass")
#! o <- .jcast(o, "java/lang/Object")
#! }
#! f <- .jcall(cl, "Ljava/lang/reflect/Field;", "getField", name)
#! r <- .jcall(f,"Ljava/lang/Object;","get",o)
#! if (simplify) r <- .jsimplify(r)
#! if (true.class && (inherits(r, "jobjRef") || inherits(r, "jarrayRef"))) {
#! cl <- .jcall(r, "Ljava/lang/Class;", "getClass")
#! cn <- .jcall(cl, "Ljava/lang/String;", "getName")
#! if (substr(cn,1,1) != '[')
#! r@jclass <- gsub("\\.","/",cn)
#! }
#! r
#! }
### list the fields of a class or object
.jfields <- function(o, name=NULL, as.obj=FALSE, class.loader=.rJava.class.loader) {
cl <- if (is(o, "jobjRef")) .jcall(o, "Ljava/lang/Class;", "getClass") else if (is(o, "jclassName")) o@jobj else .jfindClass(as.character(o), class.loader=class.loader)
f <- .jcall(cl, "[Ljava/lang/reflect/Field;", "getFields")
if (length(name)) {
n <- sapply(f, function(o) .jcall(o, "S", "getName"))
f <- f[grep(name, n)]
}
if (isTRUE(as.obj)) f else
unlist(lapply(f, function(x) .jcall(x, "S", "toString")))
}
._must_be_character_of_length_one <- function(name){
if( !is.character(name) || length(name) != 1L ){
stop( "'name' must be a character vector of length one" )
}
}
### checks if the java object x has a field called name
hasField <- function( x, name ){
._must_be_character_of_length_one(name)
.jcall("RJavaTools", "Z", "hasField", .jcast( x, "java/lang/Object" ), name)
}
hasJavaMethod <- function( x, name ){
._must_be_character_of_length_one(name)
.jcall("RJavaTools", "Z", "hasMethod", .jcast( x, "java/lang/Object" ), name)
}
hasClass <- function( x, name){
._must_be_character_of_length_one(name)
.jcall("RJavaTools", "Z", "hasClass", .jcast( x, "java/lang/Object" ), name)
}
### the following ones are needed for the static version of $
classHasField <- function(x, name, static=FALSE, class.loader=.rJava.class.loader) {
if (is(x, "jclassName")) x <- x@jobj else if (!is(x, "jobjRef")) x <- .jfindClass(as.character(x), class.loader=class.loader)
._must_be_character_of_length_one(name)
.jcall("RJavaTools", "Z", "classHasField", x, name, static)
}
classHasMethod <- function(x, name, static=FALSE, class.loader=.rJava.class.loader) {
if (is(x, "jclassName")) x <- x@jobj else if (!is(x, "jobjRef")) x <- .jfindClass(as.character(x), class.loader=class.loader)
._must_be_character_of_length_one(name)
.jcall("RJavaTools", "Z", "classHasMethod", x, name, static)
}
classHasClass <- function(x, name, static=FALSE, class.loader=.rJava.class.loader) {
if (is(x, "jclassName")) x <- x@jobj else if (!is(x, "jobjRef")) x <- .jfindClass(as.character(x), class.loader=class.loader)
._must_be_character_of_length_one(name)
.jcall("RJavaTools", "Z", "classHasClass", x, name, static)
}
### syntactic sugar to allow object$field and object$methods(...)
### first attempts to find a field of that name and then a method
._jobjRef_dollar <- function(x, name) {
if (hasField(x, name) ){
.jfield(x, , name)
} else if( hasJavaMethod( x, name ) ) {
function(...) .jrcall(x, name, ...)
} else if( hasClass(x, name) ) {
cl <- .jcall( x, "Ljava/lang/Class;", "getClass" )
inner.cl <- .jcall( "RJavaTools", "Ljava/lang/Class;", "getClass", cl, name, FALSE )
new("jclassName", name=.jcall(inner.cl, "S", "getName"), jobj=inner.cl)
} else if( is.character(name) && length(name) == 1L && name == "length" && isJavaArray(x) ){
length( x )
} else {
stop( sprintf( "no field, method or inner class called '%s' ", name ) )
}
}
setMethod("$", c(x="jobjRef"), ._jobjRef_dollar )
### support for object$field<-...
._jobjRef_dollargets <- function(x, name, value) {
if( hasField( x, name ) ){
.jfield(x, name) <- value
}
x
}
setMethod("$<-", c(x="jobjRef"), ._jobjRef_dollargets )
# get a class name for an object
.jclass <- function(o, true=TRUE) {
if (true) .jcall(.jcall(o, "Ljava/lang/Class;", "getClass"), "S", "getName")
else if( inherits( o, "jarrayRef" ) ) o@jsig else o@jclass
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.