This is really a mystery for me. I have defined my method like this (for class "graf"):
addStatistics <- function(x) UseMethod("addStatistics")
addStatistics.graf <- function (x, stat_name = NULL, value = NULL)
{
if (stat_name == "env_coef_delta_mnll") {
x$env_coef_delta_mnll <- value
}
x
}
I am calling the method like this, and getting an error:
addStatistics(m, "env_coef_delta_mnll", 0)
#Error in addStatistics(m, "env_coef_delta_mnll", 0) :
# unused arguments ("env_coef_delta_mnll", 0)
Why the method doesn't accept those supplied arguments and says they are "unused"?
Here is a way of solving the problem. Apparently you are creating a setter function, so I will change the generic a bit.
`addStatistics<-` <- function(x, ...) UseMethod("addStatistics<-")
`addStatistics<-.graf` <- function (x, stat_name = NULL, value = NULL)
{
if (stat_name == "env_coef_delta_mnll") {
x$env_coef_delta_mnll <- value
}
x
}
as.graf <- function(x){
class(x) <- "graf"
x
}
x <- as.graf(list())
addStatistics(x, "env_coef_delta_mnll") <- 1234
x
#$env_coef_delta_mnll
#[1] 1234
#
#attr(,"class")
#[1] "graf"
#GGrothendieck beat me to the punch, but here's a reprex to prove it;
addStatistics <- function(...) UseMethod("addStatistics")
addStatistics.graf <- function (x, stat_name, value)
{
if(!missing(stat_name)){
if (stat_name == "env_coef_delta_mnll") {
x$env_coef_delta_mnll <- value
}}
x
}
m <- list(env_coef_delta_mnll = 3)
class(m) <- "graf"
addStatistics(m, stat_name = "env_coef_delta_mnll", 4)
#> $env_coef_delta_mnll
#> [1] 4
#>
#> attr(,"class")
#> [1] "graf"
Created on 2020-02-20 by the reprex package (v0.3.0)
Related
My function foo() below produces 3 types of messages. Two of them are created by message(), and one of them is created by cat().
Suppose I call foo() multiple times by lapply().
I want to know if() we have any error message (the second message that contains the term error) from my lapply() call?
NOTE: I don't want to use stop or warning.
foo <- function(dat_obj) {
v1 <- sapply(names(dat_obj), function(i) length(unique(dat_obj[[i]])))
i1 <- names(which(v1 != 1))
if(length(i1) == 1) {
message(paste("Note: potential problem in",i1))
} else if(length(i1) > 1) {
message(paste("Error: fatal problem in x & y."))
} else {
cat(paste("OK: No issues detected.\n"))
}
}
#----- EXAMPLE OF USE:
INPUT <- list(
A = data.frame(x = c(1,1,1,1), y = c(2,4,3,3)),
B = data.frame(x = c(1,2,1,1), y = c(3,3,3,3)),
C = data.frame(x = c(1,2,1,1), y = c(3,2,3,3)),
D = data.frame(x = c(1,1,1,1), y = c(3,3,3,3)))
invisible(lapply(INPUT, foo))
#----- OUTPUT:
#Note: potential problem in y
#Note: potential problem in x
#Error: fatal problem in x & y.
#OK: No issues detected.
Functions should return something, even if only invisible(NULL). In the case below, I have changed the return value to NA assigned to a variable, y. Then the logical test numbers, 1, 2, or 3 are an attribute of this returned value.
foo <- function(dat_obj) {
v1 <- sapply(names(dat_obj), function(i) length(unique(dat_obj[[i]])))
i1 <- names(which(v1 != 1))
if(length(i1) == 1) {
Attrib <- 1
message(paste("Note: potential problem in",i1))
} else if(length(i1) > 1) {
Attrib <- 2
message(paste("Error: fatal problem in x & y."))
} else {
Attrib <- 3
cat(paste("OK: No issues detected.\n"))
}
y <- NA
attr(y, "message") <- Attrib
y
}
invisible(res <- lapply(INPUT, foo))
sapply(res, attr, "message")
You can use capture.output to capture the output returned from the function.
temp <- capture.output(lapply(INPUT, foo), type = 'message')
temp
#[1] "Note: potential problem in y" "Note: potential problem in x"
# "Error: fatal problem in x & y."
To find output where 'Error' is returned you can use grep.
grep('Error', temp)
#[1] 3
i need to find the number 35 in x and assign it a function.
Then call the function.
code:
x <- 1:100
z <- 0
z[x == 35] <- function() { # error here
print("hello")
}
z <- max(z, na.rm=TRUE) # remove all NA in vector
z() # run it
error:
Error in z[x == 35] <- function() { :
incompatible types (from closure to double) in subassignment type fix
Thanks!!
Quite why you'd want to do it, but...
x <- 1:100
z <- list()
z[[which(x == 35)]] <- function() {
print("hello")
}
z[[which(x == 35)]]() # run it
[1] "hello"
The key is to use a list, not a vector.
Do you mean something like this?
z <- function(x) {
print("hello")
max(x, na.rm=TRUE) # remove all NA in vector
}
for (x in 1:100){
if (x == 35){
z(x)
}
}
In an S3 generic function, I'd like to modify a function argument before calling NextMethod(). As a starting point, I looked through #44 of Henrik Bengtsson's "Wishlist for R". The following snippet is taken from there and corresponds to his suggestion on to how modify an argument before calling NextMethod().
x <- structure(NA, class = "A")
expected <- list(x = x, a = 3)
foo <- function(x, a) UseMethod("foo")
foo.A <- function(x, a) {
a <- a + 1
NextMethod()
}
foo.default <- function(x, a) {
list(x = x, a = a)
}
identical(foo(x, a = 2), expected)
#> [1] TRUE
identical(foo(x, 2), expected)
#> [1] TRUE
Now what has me stumped is the following behavior where the argument to be modified has a default value.
bar <- function(x, a) UseMethod("bar")
bar.A <- function(x, a = 2) {
a <- a + 1
NextMethod()
}
bar.default <- function(x, a = 2) {
list(x = x, a = a)
}
identical(bar(x, a = 2), expected)
#> [1] TRUE
identical(bar(x, 2), expected)
#> [1] TRUE
identical(bar(x), expected)
#> [1] FALSE
Can someone help me understand what is happening here? Any ideas on how to make the default argument case work (apart from an explicit call of bar.default())?
I'm not sure how realistic this set-up is, but the problem with it is that calling bar(x) means that you are calling bar.A(x), then (via NextMethod()) you are calling bar.default(x), rather than bar.default(x, a = 3) as you might expect.
The way round this is to specifically pass a as a parameter in NextMethod. The issue you will have with this is that if the user doesn't name the second parameter, then bar.default will throw because it is being given 3 parameters instead of two (x, 2 and a = 3). You can get round this by including a ... parameter in bar.default so that unnamed parameters are ignored.
x <- structure(NA, class = "A")
expected <- list(x = x, a = 3)
bar <- function(x, ...) UseMethod("bar")
bar.A <- function(x, a = 2) {
a <- a + 1
NextMethod("bar", x, a = a)
}
bar.default <- function(x, ..., a = 2) {
list(x = x, a = a)
}
identical(bar(x, a = 2), expected)
#> [1] TRUE
identical(bar(x, 2), expected)
#> [1] TRUE
identical(bar(x), expected)
#> [1] TRUE
Created on 2020-04-02 by the reprex package (v0.3.0)
I have three functions and one function is made out of the other two by using useMethod().
logReg <- function(x, ...) UseMethod("logReg")
logRec.numeric <- function(x, y) {
print(x)
}
logReg.formula <- function(formula, data) {
print(formula)
}
My functions are a bit more complex but does not matter for my question. I want logReg to give me additionaly the original function call as output (not the function call of logReg.numeric oder logReg.formula). My first try was:
logReg <- function(x, ...) {
out <- list()
out$call <- match.call()
out
UseMethod("logReg")
}
But it does not work. Can someone give me a hint how to solve my problem?
Here's another way :
logReg <- function(x, ...) {
logReg <- function(x, ...) UseMethod("logReg")
list(logReg(x,...), call=match.call())
}
res <- logReg(1,2)
# [1] 1
res
# [[1]]
# [1] 1
#
# $call
# logReg(x = 1, 2)
#
You can make it work with atttibutes too if you prefer.
Try evaluating it explicitly. Note that this preserves the caller as the parent frame of the method.
logReg <- function(x, ...) {
cl <- mc <- match.call()
cl[[1]] <- as.name("logReg0")
out <- structure(eval.parent(cl), call = mc)
out
}
logReg0 <- function(x, ...) UseMethod("logReg0")
logReg0.numeric <- function(x, ...) print(x)
logReg0.formula <- function(x, ...) print(x)
result <- logReg(c(1,2))
## [1] 1 2
result
## [1] 1 2
## attr(,"call")
## logReg(x = c(1, 2))
This is an extension of Using callNextMethod() within accessor function in R.
Update 2017-03-25: To illustrate how this only fails when loading the methods, but not when it's in a built package, I created a dummy package: https://github.com/zkamvar/inheritest#readme
Basic problem:
I have a class bar that inherits another class foo, and both of them have additional arguments for the [ method. The method for foo works consistently, but the method for bar fails after the first use.
Error and Traceback:
Error in callNextMethod(x, i, j, ..., drop): bad object found as method (class "function")
4: stop(gettextf("bad object found as method (class %s)", dQuote(class(method))),
domain = NA)
3: callNextMethod(x, i, j, ..., drop) at #9
2: .local(x, i, j, ..., drop = drop)
1: BAR["x"]
Further details:
I have a package that implements a class that depends on a class from another package. When the packages are built, everything works fine, but when my package is simply loaded (using devtools::load_all(".")), I get the behavior below.
Minimum Working Example:
foo <- setClass("foo", representation(x = "numeric", y = "numeric"))
bar <- setClass("bar", representation(distance = "numeric"), contains = "foo")
setMethod(f = "[", signature = signature(x = "foo", i = "ANY", j = "ANY", drop = "ANY"),
definition = function(x, i, j, ..., foo = TRUE, drop = FALSE) {
if (foo)
message("FOOOOOOO")
if (i == "x") {
return(x#x)
} else {
if (i == "y") {
return(x#y)
}
}
})
#> [1] "["
setMethod(f = "[", signature = signature(x = "bar", i = "ANY", j = "ANY", drop = "ANY"),
definition = function(x, i, j, ..., bar = TRUE, drop = FALSE) {
if (bar)
message("BAAAAAAR")
if (i == "distance") {
return(x#distance)
} else {
callNextMethod(x, i, j, ..., drop)
}
})
#> [1] "["
FOO <- new("foo", x = 1, y = 4)
BAR <- new("bar", x = 1, y = 4, distance = 3)
FOO["x"]
#> FOOOOOOO
#> [1] 1
BAR["x"]
#> BAAAAAAR
#> FOOOOOOO
#> [1] 1
FOO["x"]
#> FOOOOOOO
#> [1] 1
BAR["distance"]
#> BAAAAAAR
#> [1] 3
BAR["x"] # fails
#> BAAAAAAR
#> Error in callNextMethod(x, i, j, ..., drop): bad object found as method (class "function")
BAR["x", foo = FALSE]
#> BAAAAAAR
#> [1] 1
Note: when I passed this through reprex, The first and last calls to BAR resulted in errors as well, but I am showing what I experience in an interactive session. I am using R version 3.3.3
This is because callNextMethod() is not smart enough to handle methods on primitives with augmented formals. I've fixed it and will commit to trunk soon.
Here's a partial answer: it is to do with "[" specifically. Here is some working code, that replaces the '[' method with a 'bat' method. It works fine for me:
foo <- setClass("foo", representation(x = "numeric", y = "numeric"))
bar <- setClass("bar", representation(distance = "numeric"), contains = "foo")
bat <- function (x, i, j, ..., drop = FALSE) message('in bat')
setGeneric('bat')
setMethod(f = "bat", signature = signature(x = "foo"),
definition = function(x, i, j, ..., foo = TRUE, drop = FALSE) {
if (foo)
message("FOOOOOOO")
if (i == "x") {
return(x#x)
} else {
if (i == "y") {
return(x#y)
}
}
})
#> [1] "["
setMethod(f = "bat", signature = signature(x = "bar"),
definition = function(x, i, j, ..., bar = TRUE, drop = FALSE) {
if (bar)
message("BAAAAAAR")
if (i == "distance") {
return(x#distance)
} else {
callNextMethod(x, i, j, ..., drop)
}
})
FOO <- new("foo", x = 1, y = 4)
BAR <- new("bar", x = 1, y = 4, distance = 3)
bat(FOO, 'x')
bat(BAR, 'distance')
bat(BAR, 'x')
And now:
bat(FOO, 'x')
FOOOOOOO
[1] 1
bat(BAR, 'x')
BAAAAAAR
FOOOOOOO
[1] 1
bat(BAR, 'distance')
BAAAAAAR
[1] 3
bat(BAR, 'x')
BAAAAAAR
FOOOOOOO
[1] 1
So, I think this is something to do with the interaction of S4 dispatch and ['s own dispatching... and solutions? I have none, except to avoid S4 like the plague it seems to be. Maybe R-devel can help. It's possible this is a genuine R bug, given that the code only breaks for [.
The issue has likely to do with the fact that [ is a primitive, and primitives are dealt with differently when using S4. Digging into callNextMethod shows that the callstack isn't analyzed correctly in the case that the method has different arguments compared to the generic for that primitive function. If you drop the argument bar from the method definition, dispatching works correctly.
That said, there is another workaround that doesn't require you to choose another function name. I add an extra function as.foo and recall the generic after converting to a foo object:
setGeneric("as.foo", function(x)standardGeneric("as.foo"))
setMethod("as.foo", signature = "bar",
function(x)
new("foo", x = x#x, y = x#y))
setMethod(f = "[", signature = signature(x = "bar", i = "ANY", j = "ANY", drop = "ANY"),
definition = function(x, i, j, ..., bar = TRUE, drop = FALSE) {
if (bar)
message("BAAAAAAR")
if (i == "distance") {
return(x#distance)
} else {
x <- as.foo(x)
callGeneric()
}
}
)
This way you circumvent the hiccup in dispatching, and all the code that used to fail now works
FOO["x"]
#> FOOOOOOO
#> [1] 1
BAR["x"]
#> BAAAAAAR
#> FOOOOOOO
#> [1] 1
BAR["distance"]
#> BAAAAAAR
#> [1] 3
BAR["x"]
#> BAAAAAAR
#> FOOOOOOO
#> [1] 1
BAR["x", foo = FALSE]
#> BAAAAAAR
#> [1] 1