I'm using SWIG to generate wrapper code to access C code from within the R language. The wrapper code uses the R externalptr type to hold references to C pointers. In some situations, those pointers are NULL on the C side, which show up in R as a nil value when displayed. On the R side, calling is.null() and is.na() on the externalptr both return FALSE. For example:
> val = librdf_query_results_get_binding_value(results, 2)
> val
An object of class "_p_librdf_node_s"
Slot "ref":
<pointer: (nil)>
> class(val#ref)
[1] "externalptr"
> is.null(val#ref)
[1] FALSE
> is.na(val#ref)
[1] FALSE
As can be seen from the code output above, the ref slot contains an externalptr, which is "nil". How do I determine from within R that this pointer in C is NULL?
If you want to see the code in context, it is available in GitHub:
https://github.com/ropensci/redland-bindings/blob/master/R/redland/inst/tests/test.redland_base.R#L40
The C solution above is most elegant, but a compiler might not always be available. A solution that does not require compiled code could be something like:
identical(pointer, new("externalptr"))
However this would not work if the object has custom attributes. If this is the case, you could do:
isnull <- function(pointer){
a <- attributes(pointer)
attributes(pointer) <- NULL
out <- identical(pointer, new("externalptr"))
attributes(pointer) <- a
return(out)
}
Again a bit more involved than the C solution, but will work in a simple script on any platform.
For completeness, here's the solution I used. It required a function on the C side, and one on the R side, as suggested by #DirkEddelbuettel. The C function is:
#include <Rinternals.h>
SEXP isnull(SEXP pointer) {
return ScalarLogical(!R_ExternalPtrAddr(pointer));
}
And the wrapper function in R is:
is.null.externalptr <- function(pointer) {
stopifnot(is(pointer, "externalptr"))
.Call("isnull", pointer)
}
For an example of use from within R:
> p <- new("externalptr")
> p
<pointer: (nil)>
> is.null.externalptr(p)
[1] TRUE
Related
How can a function inspect and modify the arguments of a call that it received as argument?
Application: A user feeds a call to function a as an argument to function b, but they forget to specify one of the required arguments of a. How can function b detect the problem and fix it?
In this minimal example, function a requires two arguments:
a <- function(arg1, arg2) {
return(arg1 + arg2)
}
Function b accepts a call and an argument. The commented lines indicate what I need to do:
b <- function(CALL, arg3) {
# 1. check if `arg2` is missing from CALL
# 2. if `arg2` is missing, plug `arg3` in its place
# 3. return evaluated call
CALL
}
Expected behavior:
b(CALL = a(arg1 = 1, arg2 = 2), arg3 = 3)
> 3
b(CALL = a(arg1 = 1), arg3 = 3)
> 4
The second call currently fails because the user forgot to specify the required arg2 argument. How can function b fix this mistake automatically?
Can I exploit lazy evaluation to modify the call to a before it is evaluated? I looked into rlang::modify_call but couldn't figure it out.
Here's a method that would work
b <- function(CALL, arg3) {
scall <- substitute(CALL)
stopifnot(is.call(scall)) #check that it's a call
lcall <- as.list(scall)
if (!"arg2" %in% names(lcall)) {
lcall <- c(lcall, list(arg2 = arg3))
}
eval.parent(as.call(lcall))
}
We use substitute() to grab the unevaluated version the CALL parameter. We convert it to a list so we can modify it. Then we append to the list another list with the parameter name/value we want. Finally, we turn the list back into a call and then evaluate that call in the environment of the caller rather than in the function body itself.
If you wanted to use rlang::modify_call and other rlang functions you could use
b <- function(CALL, arg3) {
scall <- rlang::enquo(CALL)
stopifnot(rlang::quo_is_call(scall))
if (!"arg2" %in% names(rlang::quo_get_expr(scall))) {
scall <- rlang::call_modify(scall, arg2=arg3)
}
rlang::eval_tidy(scall, env = rlang::caller_env())
}
I don't see why fancy language manipulation is needed. The problem is what to do when a, which requires 2 arguments, is supplied only 1. Wrapping it with b, which has a default value for the 2nd argument, solves this.
b <- function(arg1, arg2=42)
{
a(arg1, arg2)
}
b(1)
# [1] 43
b(1, 2)
# [1] 3
From Chambers' (excellent) Extending R (2016):
A validity method will be called automatically from the default method for initialize(). The recommended form of an initialize method ends with a callNextMethod() call, to ensure that subclass slots can be specified in a call to the generator for the class. If this convention is followed, initialization will end with a call to the default method, and the validity method will be called after all initialization has occurred.
I thought I understood, but the behavior I am getting does not seem to follow this convention.
setClass("A", slots = c(s1 = "numeric"))
setValidity("A", function(object) {
if (length(object#s1) > 5) {
return("s1 longer than 5")
}
TRUE
})
setMethod("initialize", "A", function(.Object, s1, ...) {
if (!missing(s1)) .Object#s1 <- s1 + 4
callNextMethod(.Object, ...)
})
A <- new("A", rep(1.0, 6))
A
# An object of class "A"
# Slot "s1":
# [1] 5 5 5 5 5 5
validObject(A)
# Error in validObject(A) : invalid class “A” object: s1 longer than 5
I expected the validity checking to be done by adding callNextMethod() to the end of the initialize method. Adding an explicit validObject(.Object) before callNextMethod() works, but I am clearly not understanding something here.
Obviously, I can also do all the same checks in the validity method, but ideally all of the validity checking would occur within setValidity so future edits live in one place.
Changing the initialize function slightly gives the desired result -- is there a reason to use one approach over the other? Chambers seems to prefer using .Object#<- whereas I have seen the following method elsewhere (Gentlemman & Hadley).
setMethod("initialize", "A", function(.Object, s1, ...) {
if (!missing(s1)) s1 + 4
else s1 <- numeric()
callNextMethod(.Object, s1 = s1, ...)
})
Perhaps the best guide comes from initialize itself — if you inspect the code for the default method
getMethod("initialize",signature(.Object="ANY"))
then you see that it does indeed contain an explicit call to validObject at the end:
...
validObject(.Object)
}
.Object
}
so if you define your own initialize method, the most similar thing you could do would be to call it at the end of your method, right before you call callNextMethod.
In your case, when you call callNextMethod, that is only checking that the slot you have created is a valid numeric object (which it is), rather than checking the validity of the larger object (which requires the s1 slot to be no longer than 5 elements)
I would like to make == a generic function.
When I run: setGeneric("=="), the definition does not appear to change:
> `==`
function (e1, e2) .Primitive("==")
> setGeneric("==")
[1] "=="
> `==`
function (e1, e2) .Primitive("==")
And when I call setgeneric("`==`"), I get the following error:
> setGeneric("`==`")
Error in setGeneric("`==`") :
must supply a function skeleton for ‘`==`’, explicitly or via an existing function
I can define the == function with:
`==` <- function(x,y) 42;
And then I can use setGeneric on it. But then I'd have to put the body of the original == there, which seems clunky.
So is there any way to make == be generic in S4?
Thanks to MrFlick's response:
It turns out that == is already generic (implement in C). So you don't need to call setGeneric.
Rather, you can just use setMethod.
setMethod("==",
c(e1="Class1",e2="Class2"),
funciton(e1,e2) { .... })
I'm using SWIG to generate wrapper code to access C code from within the R language. The wrapper code uses the R externalptr type to hold references to C pointers. In some situations, those pointers are NULL on the C side, which show up in R as a nil value when displayed. On the R side, calling is.null() and is.na() on the externalptr both return FALSE. For example:
> val = librdf_query_results_get_binding_value(results, 2)
> val
An object of class "_p_librdf_node_s"
Slot "ref":
<pointer: (nil)>
> class(val#ref)
[1] "externalptr"
> is.null(val#ref)
[1] FALSE
> is.na(val#ref)
[1] FALSE
As can be seen from the code output above, the ref slot contains an externalptr, which is "nil". How do I determine from within R that this pointer in C is NULL?
If you want to see the code in context, it is available in GitHub:
https://github.com/ropensci/redland-bindings/blob/master/R/redland/inst/tests/test.redland_base.R#L40
The C solution above is most elegant, but a compiler might not always be available. A solution that does not require compiled code could be something like:
identical(pointer, new("externalptr"))
However this would not work if the object has custom attributes. If this is the case, you could do:
isnull <- function(pointer){
a <- attributes(pointer)
attributes(pointer) <- NULL
out <- identical(pointer, new("externalptr"))
attributes(pointer) <- a
return(out)
}
Again a bit more involved than the C solution, but will work in a simple script on any platform.
For completeness, here's the solution I used. It required a function on the C side, and one on the R side, as suggested by #DirkEddelbuettel. The C function is:
#include <Rinternals.h>
SEXP isnull(SEXP pointer) {
return ScalarLogical(!R_ExternalPtrAddr(pointer));
}
And the wrapper function in R is:
is.null.externalptr <- function(pointer) {
stopifnot(is(pointer, "externalptr"))
.Call("isnull", pointer)
}
For an example of use from within R:
> p <- new("externalptr")
> p
<pointer: (nil)>
> is.null.externalptr(p)
[1] TRUE
S4 classes allow you to define validity checks using validObject() or setValidity(). However, this does not appear to work for ReferenceClasses.
I have tried adding assert_that() or if (badness) stop(message) clauses to the $initialize() method of a ReferenceClass. However, when I simulate loading the package (using devtools::load_all()), it must try to create some prototype class because the initialize method executes and fails (because no fields have been set).
What am I doing wrong?
Implement a validity method on the reference class
A = setRefClass("A", fields=list(x="numeric", y="numeric"))
setValidity("A", function(object) {
if (length(object$x) != length(object$y)) {
"x, y lengths differ"
} else NULL
})
and invoke the validity method explicitly
> validObject(A())
[1] TRUE
> validObject(A(x=1:5, y=5:1))
[1] TRUE
> validObject(A(x=1:5, y=5:4))
Error in validObject(A(x = 1:5, y = 5:4)) :
invalid class "A" object: x, y lengths differ
Unfortunately, setValidity() would need to be called explicitly as the penultimate line of an initialize method or constructor.
Ok so you can do this in initialize. It should have the form:
initialize = function (...) {
if (nargs()) return ()
# Capture arguments in list
args <- list(...)
# If the field name is passed to the initialize function
# then check whether it is valid and assign it. Otherwise
# assign a zero length value (character if field_name has
# that type)
if (!is.null(args$field_name)) {
assert_that(check_field_name(args$field_name))
field_name <<- field_name
} else {
field_name <<- character()
}
# Make sure you callSuper as this will then assign other
# fields included in ... that weren't already specially
# processed like `field_name`
callSuper(...)
}
This is based on the strategy set out in the lme4 package.