The following:
install.packages("quantreg")
require(quantreg)
y=rnorm(10)
x=rnorm(10)
summary(rq(y~x,tau=0.01),se="ker")
Generates the error Error in summary.rq(rq(y ~ x, tau = 0.01), se = "ker") :
tau - h < 0: error in summary.rq.
Say I loop over different y and x 1000 times. I want to be able to know when the error occurs and implement a fix mid-loop.
However all my attempts to work with summary(rq(y~x,tau=0.01),se="ker") using is() etc etc doesn't get anywhere. I've never worked with this object type before (and Google/SE searches haven't revealed the answer yet).
I want something like is.error(summary(rq(y~x,tau=0.01),se="ker")), which doesn't actually exist.
The following command will return a logical value indicating whether an error occured:
class(tryCatch(summary(rq(y ~ x,tau = 0.01),se = "ker"),
error = function(e) e))[1] == "simpleError"
You can use replicate instead of a for loop. It is more efficient. In the follwing example, a list including x, y, and the logical errorvalue is returned. The procedure is replicated two times. You could use n = 1000 to replicate it 1000 times.
replicate(n = 2,
expr = {y <- rnorm(10);
x <- rnorm(10);
error <- class(tryCatch(summary(rq(y ~ x,tau = 0.01),se = "ker"), error = function(e) e))[1] == "simpleError";
return(list(x = x, y = y, error = error))},
simplify = FALSE)
Elaborating on the answer from #SvenHohenstein one would like to return the result on successful evaluation, not just whether an error occurred. We'd likely also want to return the reason for the error message using conditionMessage. We'd like to catch errors of class simpleError, so we write a handlers specific to that type of condition. So
error <- FALSE # no error yet
result <- tryCatch({ # result from summary(), or from the error handler
summary(rq(y ~ x,tau = 0.01),se = "ker")
}, simpleError = function(e) { # only catch simpleErrors
error <<- TRUE # yes, error occurred
conditionMessage(e) # 'result' gets error message
})
we'd then return list(x = x, y = y, error=error, result=result).
Related
I have a regression model (lm or glm or lmer ...) and I do fitmodel <- lm(inputs) where inputs changes inside a loop (the formula and the data). Then, if the model function does not produce any warning I want to keep fitmodel, but if I get a warning I want to update the model and I want the warning not printed, so I do fitmodel <- lm(inputs) inside tryCatch. So, if it produces a warning, inside warning = function(w){f(fitmodel)}, f(fitmodel) would be something like
fitmodel <- update(fitmodel, something suitable to do on the model)
In fact, this assignation would be inside an if-else structure in such a way that depending on the warning if(w$message satisfies something) I would adapt the suitable to do on the model inside update.
The problem is that I get Error in ... object 'fitmodel' not found. If I use withCallingHandlers with invokeRestarts, it just finishes the computation of the model with the warning without update it. If I add again fitmodel <- lm(inputs) inside something suitable to do on the model, I get the warning printed; now I think I could try suppresswarnings(fitmodel <- lm(inputs)), but yet I think it is not an elegant solution, since I have to add 2 times the line fitmodel <- lm(inputs), making 2 times all the computation (inside expr and inside warning).
Summarising, what I would like but fails is:
tryCatch(expr = {fitmodel <- lm(inputs)},
warning = function(w) {if (w$message satisfies something) {
fitmodel <- update(fitmodel, something suitable to do on the model)
} else if (w$message satisfies something2){
fitmodel <- update(fitmodel, something2 suitable to do on the model)
}
}
)
What can I do?
The loop part of the question is because I thought it like follows (maybe is another question, but for the moment I leave it here): it can happen that after the update I get another warning, so I would do something like while(get a warning on update){update}; in some way, this update inside warning should be understood also as expr. Is something like this possible?
Thank you very much!
Generic version of the question with minimal example:
Let's say I have a tryCatch(expr = {result <- operations}, warning = function(w){f(...)} and if I get a warning in expr (produced in fact in operations) I want to do something with result, so I would do warning = function(w){f(result)}, but then I get Error in ... object 'result' not found.
A minimal example:
y <- "a"
tryCatch(expr = {x <- as.numeric(y)},
warning = function(w) {print(x)})
Error in ... object 'x' not found
I tried using withCallingHandlers instead of tryCatch without success, and also using invokeRestart but it does the expression part, not what I want to do when I get a warning.
Could you help me?
Thank you!
The problem, fundamentally, is that the handler is called before the assignment happens. And even if that weren’t the case, the handler runs in a different scope than the tryCatch expression, so the handler can’t access the names in the other scope.
We need to separate the handling from the value transformation.
For errors (but not warnings), base R provides the function try, which wraps tryCatch to achieve this effect. However, using try is discouraged, because its return type is unsound.1 As mentioned in the answer by ekoam, ‘purrr’ provides soundly typed functional wrappers (e.g. safely) to achieve a similar effect.
However, we can also build our own, which might be a better fit in this situation:
with_warning = function (expr) {
self = environment()
warning = NULL
result = withCallingHandlers(expr, warning = function (w) {
self$warning = w
tryInvokeRestart('muffleWarning')
})
list(result = result, warning = warning)
}
This gives us a wrapper that distinguishes between the result value and a warning. We can now use it to implement your requirement:
fitmodel = with(with_warning(lm(inputs)), {
if (! is.null(warning)) {
if (conditionMessage(warning) satisfies something) {
update(result, something suitable to do on the model)
} else {
update(result, something2 suitable to do on the model)
}
} else {
result
}
})
1 What this means is that try’s return type doesn’t distinguish between an error and a non-error value of type try-error. This is a real situation that can occur, for example, when nesting multiple try calls.
It seems that you are looking for a functional wrapper that captures both the returned value and side effects of a function call. I think purrr::quietly is a perfect candidate for this kind of task. Consider something like this
quietly <- purrr::quietly
foo <- function(x) {
if (x < 3)
warning(x, " is less than 3")
if (x < 4)
warning(x, " is less than 4")
x
}
update_foo <- function(x, y) {
x <- x + y
foo(x)
}
keep_doing <- function(inputs) {
out <- quietly(foo)(inputs)
repeat {
if (length(out$warnings) < 1L)
return(out$result)
cat(paste0(out$warnings, collapse = ", "), "\n")
# This is for you to see the process. You can delete this line.
if (grepl("less than 3", out$warnings[[1L]])) {
out <- quietly(update_foo)(out$result, 1.5)
} else if (grepl("less than 4", out$warnings[[1L]])) {
out <- quietly(update_foo)(out$result, 1)
}
}
}
Output
> keep_doing(1)
1 is less than 3, 1 is less than 4
2.5 is less than 3, 2.5 is less than 4
[1] 4
> keep_doing(3)
3 is less than 4
[1] 4
Are you looking for something like the following? If it is run with y <- "123", the "OK" message will be printed.
y <- "a"
#y <- "123"
x <- tryCatch(as.numeric(y),
warning = function(w) w
)
if(inherits(x, "warning")){
message(x$message)
} else{
message(paste("OK:", x))
}
It's easier to test several argument values with the code above rewritten as a function.
testWarning <- function(x){
out <- tryCatch(as.numeric(x),
warning = function(w) w
)
if(inherits(out, "warning")){
message(out$message)
} else{
message(paste("OK:", out))
}
invisible(out)
}
testWarning("a")
#NAs introduced by coercion
testWarning("123")
#OK: 123
Maybe you could assign x again in the handling condition?
tryCatch(
warning = function(cnd) {
x <- suppressWarnings(as.numeric(y))
print(x)},
expr = {x <- as.numeric(y)}
)
#> [1] NA
Perhaps not the most elegant answer, but solves your toy example.
Don't put the assignment in the tryCatch call, put it outside. For example,
y <- "a"
x <- tryCatch(expr = {as.numeric(y)},
warning = function(w) {y})
This assigns y to x, but you could put anything in the warning body, and the result will be assigned to x.
Your "what I would like" example is more complicated, because you want access to the expr value, but it hasn't been assigned anywhere at the time the warning is generated. I think you'll have to recalculate it:
fitmodel <- tryCatch(expr = {lm(inputs)},
warning = function(w) {if (w$message satisfies something) {
update(lm(inputs), something suitable to do on the model)
} else if (w$message satisfies something2){
update(lm(inputs), something2 suitable to do on the model)
}
}
)
Edited to add:
To allow the evaluation to proceed to completion before processing the warning, you can't use tryCatch. The evaluate package has a function (also called evaluate) that can do this. For example,
y <- "a"
res <- evaluate::evaluate(quote(x <- as.numeric(y)))
for (i in seq_along(res)) {
if (inherits(res[[i]], "warning") &&
conditionMessage(res[[i]]) == gettext("NAs introduced by coercion",
domain = "R"))
x <- y
}
Some notes: the res list will contain lots of different things, including messages, warnings, errors, etc. My code only looks at the warnings. I used conditionMessage to extract the warning message, but
it will be translated to the local language, so you should use gettext to translate the English version of the message for comparison.
When I try to debug a certain function (itself defined within the function NbCluster), I get a could not find function error. I have checked and the function in question is definitely loaded when debug is called.
> data("USArrests")
> arrests <- scale(USArrests)
> source("NbCluster_copy.R")
> NbCluster_copy(data = arrests, diss = NULL, distance = "euclidean", min.nc = 2, max.nc = 12,
+ method = "ward.D2", index = "gap", alphaBeale = 0.1)
[1] "Indice.Gap exists"
Error in debug(fun = "Indice.Gap") : could not find function "Indice.Gap"
And the issue does not happen if I manually step through the function (by selecting and running lines instead of calling the function).
I tried making a minimal example, but was unable to, so I don't think it is the nested functions that are the problem.
###This works as expected, when I run "wrapper", debug is called from within the function:
wrapper <- function(x){
wrapper <- function(x){
fun1 <- function(x){
fun0 <- function(x){
y = x + 1
return(y)
}
debug(fun0)
y = fun0(x) * 2
return(y)
}
fun1(x)
}
> wrapper(2)
debugging in: fun0(x)
debug at #3: {
y = x + 1
return(y)
}
Browse[2]>
debug at #4: y = x + 1
Browse[2]>
debug at #5: return(y)
Browse[2]>
exiting from: fun0(x)
[1] 6
This is the part I added into the NbClust function.
if(exists("Indice.Gap")){
print("Indice.Gap exists")
}
debug(fun = "Indice.Gap")
right before the first call of Indice.Gap:
resultSGAP <- Indice.Gap(x = jeu, clall = clall,
reference.distribution = "unif", B = 10, method = "ward.D2",
d = NULL, centrotypes = "centroids")
I only made very minor changes besides the one shown above, but if you want to look at the whole function, my copy is here: https://pastebin.com/wxKKDbHy
Just remove the quotes in debug and it should work:
debug(Indice.Gap)
should do the trick.
outer_fun <- function() {
inner_fun <- function() 1
## does not work
# debug("inner_fun")
## works
debug(inner_fun)
inner_fun()
}
outer_fun()
Funny enough on the top level you can provide the function name as string:
debug("outer_fun") # works
debug(outer_fun) # works
When writing a function including a ... argument, making a mistake
in an argument name will not trigger an error immediately.
it's especially annoying when we forget to "dot" an argument
addxy <- function(..., .x, .y, .z){
.x + .y
}
addxy(.x=1,.y=2)
# [1] 3
addxy(.x=1,y=2)
# Error in addxy(.x = 1, y = 2) : argument ".y" is missing, with no default
In a real situation the error might be less explicit, and y might be a valid
input or not so I can't dismiss it from the start.
How can I give a friendly error in this case to help the user correct their call ?
We can wrap the function call in try and then if it fails, do some
gymnastics to get analyse the original call and the formals and determine what
might have gone wrong.
Putting it all in one function we get :
with_friendly_dot_error <- function(fun){
fiendly_fun <- fun
body(fiendly_fun) <- substitute({
MC <- match.call()
MC[[1]] <- quote(fun)
res <- try(eval.parent(MC),silent = TRUE)
if(inherits(res,"try-error")){
frmls <- setdiff(names(formals()),"...")
dot_names <- names(eval(substitute(alist(...))))
candidates <- intersect(paste0(".",dot_names), frmls)
stop(attr(res,"condition")$message,
"\nDid you forget the dots in argument(s): ",
paste0(candidates, collapse = ", ")," ?")
}
res
})
fiendly_fun
}
Works normally when no error :
with_friendly_dot_error(addxy)(.x=1,.y=2)
# [1] 3
Gives helpful error when relevant :
with_friendly_dot_error(addxy)(.x=1, y=2)
# Error in with_friendly_dot_error(addxy)(.x = 1, y = 2) :
# argument ".y" is missing, with no default
# Did you forget the dots in argument(s): .y ?
I am mainting the package "hdm" and I encountered the following problem.
The following code runs in plain R and used to run in RStudio, but not anymore:
library(hdm)
attach(GrowthData)
fmla= "Outcome ~ ."
fmla.y= "Outcome ~ . - gdpsh465 "
rY= rlasso(fmla.y, data =GrowthData)
Error message:
Error in exists("homoscedastic", where = penalty) : object 'n' not
found
If no penalty in the function rlasso is specified it is set by default containing the variable "n", the sample size of x, which is evaluated later.
n is gotten by lazy evaluation and it seems that in RStudio the correct environment is not found anymore.
The error occurs here, but the problem is that penalty contains n which is not know
if (!exists("homoscedastic", where = penalty)) penalty$homoscedastic = "FALSE"
Somehow I am not sure to solve this and would like to ask if you have any idea.
Thanks a lot for your efforts in advance!
Best,
Martin
When x is a character object, the problem arises because n is not defined in the environment from which rlasso.formula is called, i.e. rlasso.character(), or its parents. This is roughly what's happening:
test <- function(x, ...) {
UseMethod("test")
}
test.character <- function(x, pen = list(alpha = n)) {
test.formula(x, pen = pen)
}
test.formula <- function(x, pen = list(alpha = n)) {
n <- 2
test.default(x, pen)
}
test.default <- function(x, pen = list(alpha = n)) {
n <- 3
exists("alpha", where = pen)
}
test("y ~ x")
# Error in exists("alpha", where = pen) : object 'n' not found
test(y ~ x)
# [1] TRUE
test(123)
# [1] TRUE
A workaround is to not specify pen in the call to the formula method if it's not defined when the character method is called:
test.character <- function(x, pen = list(alpha = n)) {
if (missing(pen))
test.formula(x)
else
test.formula(x, pen = pen)
}
test("y ~ x")
# [1] TRUE
I am quite new to R and I am confused by the correct usage of tryCatch. My goal is to make a prediction for a large data set. If the predictions cannot fit into memory, I want to circumvent the problem by splitting my data.
Right now, my code looks roughly as follows:
tryCatch({
large_vector = predict(model, large_data_frame)
}, error = function(e) { # I ran out of memory
for (i in seq(from = 1, to = dim(large_data_frame)[1], by = 1000)) {
small_vector = predict(model, large_data_frame[i:(i+step-1), ])
save(small_vector, tmpfile)
}
rm(large_data_frame) # free memory
large_vector = NULL
for (i in seq(from = 1, to = dim(large_data_frame)[1], by = 1000)) {
load(tmpfile)
unlink(tmpfile)
large_vector = c(large_vector, small_vector)
}
})
The point is that if no error occurs, large_vector is filled with my predictions as expected. If an error occurs, large_vector seems to exist only in the namespace of the error code - which makes sense because I declared it as a function. For the same reason, I get a warning saying that large_data_frame cannot be removed.
Unfortunately, this behavior is not what I want. I would want to assign the variable large_vector from within my error function. I figured that one possibility is to specify the environment and use assign. Thus, I would use the following statements in my error code:
rm(large_data_frame, envir = parent.env(environment()))
[...]
assign('large_vector', large_vector, parent.env(environment()))
However, this solution seems rather dirty to me. I wonder whether there is any possibility to achieve my goal with "clean" code?
[EDIT]
There seems to be some confusion because I put the code above mainly to illustrate the problem, not to give a working example. Here's a minimal example that shows the namespace issue:
# Example 1 : large_vector fits into memory
rm(large_vector)
tryCatch({
large_vector = rep(5, 1000)
}, error = function(e) {
# do stuff to build the vector
large_vector = rep(3, 1000)
})
print(large_vector) # all 5
# Example 2 : pretend large_vector does not fit into memory; solution using parent environment
rm(large_vector)
tryCatch({
stop(); # simulate error
}, error = function(e) {
# do stuff to build the vector
large_vector = rep(3, 1000)
assign('large_vector', large_vector, parent.env(environment()))
})
print(large_vector) # all 3
# Example 3 : pretend large_vector does not fit into memory; namespace issue
rm(large_vector)
tryCatch({
stop(); # simulate error
}, error = function(e) {
# do stuff to build the vector
large_vector = rep(3, 1000)
})
print(large_vector) # does not exist
I would do something like this :
res <- tryCatch({
large_vector = predict(model, large_data_frame)
}, error = function(e) { # I ran out of memory
ll <- lapply(split(data,seq(1,nrow(large_data_frame),1000)),
function(x)
small_vector = predict(model, x))
return(ll)
})
rm(large_data_frame)
if(is.list(ll))
res <- do.call(rbind,res)
The idea is to return a list of predictions results if you run out of the memory.
NOTE, i am not sure of the result here, because we don't have a reproducible example.
EDIT: Let's try again:
You can use finally argument of tryCatch:
step<-1000
n<-dim(large_data_frame)[1]
large_vector <- NULL
tryCatch({
large_vector <- predict(model, large_data_frame)
}, error = function(e) { # ran out of memory
for (i in seq(from = 1, to = n, by = step)) {
small_vector <- predict(model, large_data_frame[i:(i+step-1),]) #predict in pieces
save(small_vector,file=paste0("tmpfile",i)) #same pieces
}
rm(large_data_frame) #free memory
},finally={if(is.null(large_vector)){ #if we run out of memory
large_vector<-numeric(n) #make vector
for (i in seq(from = 1, to = n, by = step)){
#collect pieces
load(paste0("tmpfile",i))
large_vector[i:(i+step-1)] <- small_vector
}
}})
Here's a simplified version to see what is going on:
large_vector<-NULL
rm(y)
tryCatch({
large_vector <- y
}, error = function(e) {# y is not found
print("error")
},finally={if(is.null(large_vector)){
large_vector<-1
}})
> large_vector
[1] 1
EDIT2: Another tip regarding the scope which could be useful for you (although maybe not in this situation as you didn't want to declare large_vector beforehand): The <<- operator, from R-help:
The operators <<- and ->> are normally only used in functions, and
cause a search to made through parent environments for an existing
definition of the variable being assigned...
Therefore you could use above example code like this:
large_vector<-NULL
rm(y)
tryCatch({
large_vector <- y
}, error = function(e) {# y is not found
large_vector <<- 1
print("error")
})
> large_vector
[1] 1
The code below is quite self explanatory. Indeed the problem is that anything inside the error function is not by default applied to the parent environment.
b=0
as explained, this doesn't work:
tryCatch(expr = {stop("error1")}, error=function(e) {b=1})
b
SOLUTION 1: assign to the parent environment
tryCatch(expr = {stop("error2")}, error=function(e) {assign(x = "b", value =
2, envir = parent.env(env = environment()))})
b
SOLUTION 2: the most simple (only works if you are assigning to b in both expr and error)
b = tryCatch(expr = {stop("error3")}, error=function(e) {b=3;return(b)})
b