I am running a lot of regressions through this code
vek <- read_excel("h24.xlsx")
filterfile <- read_excel("filterfile.xlsx")
x <- c(filterfile$Column)
sink("D:/test.csv")
for (temp_var in x){
h24 <- filter(vek,KEY == temp_var)
h24 <- na.omit(h24)
frml <- UNITS ~ h36+ z24+ z36+ pr
if (length(unique(h24$`F`)) > 1) frml <- update.formula(frml, ~ F + .)
if (length(unique(h24$`D`)) > 1) frml <- update.formula(frml, ~ D + .)
lmtest <- lm(frml, data = h24)
print(vif(lmtest))
}
sink()
The print(vif(lmtest)) throws some errors: there are aliased coefficients in the model
In case of these erros, I would like to run alias(lmtest)
Even though there are a few threads about trycatch() I could not fix it. What would be the easiest way to solve this?
tryCatch in R can look up to nice error handling in Python. You can try using tryCatch to catch the error and rerunning your code as necessary. Note that you can inspect if command returned an error and even what error exactly.
throwRandomError <- function(x = 0.5) {
if (runif(1) > x) {
stop("Random error encountered")
} else {
return(x)
}
}
set.seed(2)
ok <- tryCatch(
throwRandomError(x = 0.5),
error = function(e) e
)
bad <- tryCatch(
throwRandomError(x = 0.5),
error = function(e) e
)
str(bad)
List of 2
$ message: chr "Random error encountered"
$ call : language throwRandomError(x = 0.5)
- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"
# Catch any type of class, error, simpleError or condition.
# Only one is probably enough, but left here for redundancy.
if (class(bad) %in% c("error", "simpleError", "condition")) {
print("Rerunning lmtest")
result <- print(alias(lmtest))
}
You could catch specific error by using something along the lines of
if (bad$message == "Random error encountered") {
print("adapting workflow")
}
Related
This is a follow up question to this question which didn't get any traction. I realise now that this has nothing to do with purrr::possibly specifically as tryCatch also doesn't work like I thought.
I'm trying to write a function which will run any other arbitrary function without throwing an error. This might not be good practice but I want to understand why this does not work:
library(ggplot2)
## function I thought I could use to run other functions safely
safe_plot <- function(.FUN, ...) {
tryCatch({
.FUN(...)
},
error = function(e) {
message(e)
print("I have got passed the error")
})
}
## Simple plot function
plot_fun <- function(df) {
ggplot(df, aes(xvar, yvar)) +
geom_point()
}
## Works for good data
some_data <- data.frame(xvar = 1:10, yvar = 1:10)
safe_plot(.FUN = plot_fun, df = some_data)
## Works here for data that is not defined:
> safe_plot(.FUN = plot_fun, df = not_defined)
object 'not_defined' not found[1] " I have got passed the error"
## Falls over for an empty data frame
empty_data <- data.frame()
safe_plot(.FUN = plot_fun, df = empty_data)
## Why does't this get past this error and print the message?
> safe_plot(.FUN = plot_fun, df = empty_data)
Error in FUN(X[[i]], ...) : object 'xvar' not found
Why doesn't the last call get to the print statement? I suspect I am abusing tryCatch but I don't know why. Reading some other questions (1, 2) I checked for the class of what tryCatch returns:
> ## What is returned
> empty_data <- data.frame()
> what_is_this <- safe_plot(.FUN = plot_fun, df = empty_data)
> what_is_this
Error in FUN(X[[i]], ...) : object 'xvar' not found
> class(what_is_this)
[1] "gg" "ggplot"
So in the plot function above ggplot(df, does not fail because there is a df of empty_data. The error must occur in aes(xar, . But why does this not return an error class and instead returns a ggplot?
Using argparser in R, I'm getting an error when specifying the type of an argument in the call to add_argument but not passing an argument to the script at the MacOSX command line. For example, given this R script:
library(argparser)
p <- arg_parser(description = "A test parser")
p <- add_argument(p, "--alpha", type = "double", help = "alpha for p-value")
p <- add_argument(p, "--sig-digits", type = "integer", help="number of significant digits")
args <- parse_args(p)
print(str(args))
and invoking it at the command line:
Rscript argparser-test.R --alpha 0.1
I am returned the error:
Error in (function (object, class, nargs) :
Invalid argument value: expecting integer but got: (NA).
Calls: parse_args -> mapply -> <Anonymous>
Interestingly, there is no error if you let --alpha take it's default:
Rscript argparser-test.R
Returns:
List of 5
$ : logi FALSE
$ help : logi FALSE
$ opts : logi NA
$ alpha : logi NA
$ sig_digits: logi NA
NULL
Notice the NA value here for sig_digits is type logical, not integer, as defined in the add_argument function.
Am I doing something wrong here? In the mean time, I suppose I will get around this by making the default --sig-digits = -1, then handling that as an exception, but I'd prefer not to.
Update: Actually, -1 throws the same error, which is very frustrating because I want to use a number for the exception that non-sensical. 9999 works, and is unlikely to be input by the user, but actually it's valid.
I experienced this error a month back or so. This is a problem with how optional arguments are parsed by the argparser package. Basically it does respect the order of optional arguments as it should in every situation, and sometimes it thus expects the wrong argument type.
I've opened an issue on the package bitbucket page. I highly suggest upvoting this and adding a comment to help adding to the attention of the issue.
In my issue I provided a possible solution to the problem which amounts to changing parse_args to the following definition (one could pull and recreate the package with this function at which point it would [should] work as expected)
parse_args <- function (parser, argv = commandArgs(trailingOnly = TRUE))
{
stopifnot(is(parser, "arg.parser"))
values <- list()
argv <- preprocess_argv(argv, parser)
arg.flags <- parser$args[parser$is.flag]
x <- as.logical(parser$defaults[parser$is.flag])
x[is.na(x)] <- FALSE
names(x) <- sub("^-+", "", arg.flags)
flag.idx <- match(arg.flags, argv)
flag.idx <- flag.idx[!is.na(flag.idx)]
if (length(flag.idx) > 0) {
x[match(argv[flag.idx], arg.flags)] <- TRUE
argv <- argv[-flag.idx]
}
values <- c(values, x)
if (values$help) {
print(parser)
quit()
}
x <- parser$defaults[parser$is.opt.arg]
arg.opt <- parser$args[parser$is.opt.arg]
names(x) <- sub("^-+", "", arg.opt)
i <- match("--opts", argv)
if (!is.na(i)) {
opts <- readRDS(argv[i + 1])
opts <- opts[!names(opts) %in% c("opts", "help")]
idx <- match(sanitize_arg_names(names(opts)), sanitize_arg_names(names(x)))
if (any(is.na(idx))) {
stop("Extra arguments supplied in OPTS file: (",
paste(setdiff(names(opts), names(x)), collapse = ", "),
").")
}
x[idx] <- opts
}
arg.idx <- match(arg.opt, argv)
arg.idx <- arg.idx[!is.na(arg.idx)]
arg.opt.types <- parser$types[parser$is.opt.arg]
arg.opt.nargs <- parser$nargs[parser$is.opt.arg]
### ###
## Altered section ##
### ###
if (length(arg.idx) > 0) {
# extract values following the optional argument label
x[ind <- match(argv[arg.idx], arg.opt)] <- argv[arg.idx+1];
# convert type of extraced values; x is now a list
x[ind] <- mapply(convert_type,
object = x[ind],
class = arg.opt.types[ind],
nargs = arg.opt.nargs[ind],
SIMPLIFY = FALSE);
# remove extracted arguments
to.remove <- c(arg.idx, arg.idx+1);
argv <- argv[-to.remove];
}
### ###
## Altered section ##
### ###
values <- c(values, x)
x <- argv
args.req <- parser$args[parser$is.req.arg]
args.req.types <- parser$types[parser$is.req.arg]
args.req.nargs <- parser$nargs[parser$is.req.arg]
if (length(x) < length(args.req)) {
print(parser)
stop(sprintf("Missing required arguments: expecting %d values but got %d values: (%s).",
length(args.req), length(x), paste(x, collapse = ", ")))
}
else if (length(x) > length(args.req)) {
print(parser)
stop(sprintf("Extra arguments supplied: expecting %d values but got %d values: (%s).",
length(args.req), length(x), paste(x, collapse = ", ")))
}
else if (length(args.req) > 0) {
names(x) <- args.req
x <- mapply(convert_type, object = x, class = args.req.types,
nargs = args.req.nargs, SIMPLIFY = FALSE)
}
values <- c(values, x)
names(values) <- sanitize_arg_names(names(values))
values
}
I am following code from a textbook called "Data Mining with R" and I've hit a stumbling block when trying to run the sample code myself.
Here is the code so far:
library(quantmod)
getSymbols("^GSPC")
colnames(GSPC) <- c("Open", "High", "Low", "Close", "Volume", "AdjClose")
T.ind <- function(quotes, tgt.margin=.025, n.days=10) {
v <- apply(HLC(quotes), 1, mean)
r <- matrix(NA, ncol=n.days, nrow=NROW(quotes))
for(x in 1:n.days) r[,x] <- Next(Delt(v,k=x), x)
x <- apply(r,1, function(x) sum(x[x>tgt.margin|x < -tgt.margin]))
if (is.xts(quotes))
xts(x, time(quotes))
else x
}
candleChart(last(GSPC, "1 year"), theme="white", TA=NULL)
avgPrice <- function(p) apply(HLC(p), 1, mean)
addAvgPrice <- newTA(FUN=avgPrice, col=1, legend="AvgPrice")
addT.ind <- newTA(FUN=T.ind, col="red", legend="tgtRet")
addAvgPrice(on=1)
addT.ind()
But for the last 2 lines I get the error message:
> addAvgPrice(on=1)
Error in addAvgPrice(on = 1) : could not find function "get.current.chob"
> addT.ind()
Error in addT.ind() : could not find function "get.current.chob"
What is additionally odd is that I ran the code on 1 machine & have no issues but on my main PC I keep getting the error.
I tried googling this error but could not find any real solutions or explanations.
Any insight or assistance would be greatly appreciated.
> get.current.chob
Error: object 'get.current.chob' not found
get.current.chob is in quantmod, so...
> quantmod:::get.current.chob
function ()
{
first.chob <- which(sapply(sys.frames(), function(x) exists("chob",
envir = x)))[1]
if (!is.na(first.chob)) {
lchob <- get("chob", envir = first.chob)
}
else {
gchob <- get.chob()
if (dev.cur() == 1 || length(gchob) < dev.cur())
stop("improperly set or missing graphics device")
current.chob <- which(sapply(gchob, function(x) {
ifelse(class(x) == "chob" && x#device == as.numeric(dev.cur()),
TRUE, FALSE)
}))
if (identical(current.chob, integer(0)))
stop("no current plot")
lchob <- gchob[[current.chob]]
}
return(lchob)
}
<environment: namespace:quantmod>
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
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).