The below example does not do what is required. Namely, on error the loop does not restart, but rather runs the 1000 (or what ever length is provided) and stops. I would need it to restart every 10sec and restart the calculation from beginning on error.
Here is snippet:
get_daydata <- function(n){
message(paste("remaining runs", n))
withRestarts(err <- tryCatch({ for(i in seq_along(he)){
#.... some calculation .....
}},error=function(e) { invokeRestart("rerun") }),
rerun = function() { message ("re-running"); stopifnot(n > 0);
for(i in 1:10) { Sys.sleep(1); cat(i) }; getdata(n-1) })}
get_daydata(1000)
How about this. I save the original n and then reset the inner n to orig_n on error
get_daydata <- function(n) {
orig_n <- n
message(paste("remaining runs", n))
withRestarts(
err <- tryCatch({
for (i in seq_along(he)) {
#.... some calculation .....
}
}, error = function(e) {
n <<- orig_n + 1
invokeRestart("rerun")
}),
rerun = function() {
message ("re-running")
stopifnot(n > 0)
for (i in 1:2) {
Sys.sleep(1)
cat(i)
}
get_daydata(n - 1)
}
)
}
get_daydata(1000)
Related
My initial code for double sampling is the following. I did only one sample.
# Data
samples<-matrix(NA,nrow = 12, ncol = 2000)
for (i in 1:12) {
samples[i,]<- rbinom(2000,1,prob = 0.05)
}
# Double Sampling Plan
accept<-rep(0,12)
for (i in 1:12) {
if (sum(samples[i,1:80])<=5){
accept[i]<-1
} else if (sum(samples[i,1:80]<=8) & sum(samples[i,1:80]>5) ) {
if (sum(samples[i,1:160])<=12) {
accept[i]<-1
}
}
}
sum(accept)
Since I generated randomly from Bernoulli, every time you run the code, the results will not be the same.
I want 100 repetitions of this double sample.
My solution:
nm=double(100)
for (j in 1:100){
# Data
samples<-matrix(NA,nrow = 12, ncol = 2000)
for (i in 1:12) {
samples[i,]<- rbinom(2000,1,prob = 0.05)
}
# Double Sampling Plan
accept<-rep(0,12)
for (i in 1:12) {
if (sum(samples[i,1:80])<=5){
accept[i]<-1
} else if (sum(samples[i,1:80]<=8) & sum(samples[i,1:80]>5) ) {
if (sum(samples[i,1:160])<=12) {
accept[i]<-1
}
}
}
nm[j]=sum(accept)
}
mean(nm)
What do you think?
If we follow the proposition of #Onyambu, we can embeded one simulation inside a function and call it in a loop like this :
one_double_sampling <- function(){
# Data
samples<-matrix(NA,nrow = 12, ncol = 2000)
for (i in 1:12) {
samples[i,]<- rbinom(2000,1,prob = 0.05)
}
# Double Sampling Plan
accept<-rep(0,12)
for (i in 1:12) {
if (sum(samples[i, 1:80])<=5){
accept[i]<-1
} else if (sum(samples[i,1:80]<=8) & sum(samples[i,1:80]>5) ) {
if (sum(samples[i,1:160])<=12) {
accept[i]<-1
}
}
}
return(sum(accept))
}
set.seed(123)
# number of sample
n <- 100
# stock the result
res <- rep(0, n)
for(i in 1:n){
res[i] <- one_double_sampling()
}
# mean
mean(res)
Definitly your code is correct. For people interresting by the double sampling method I advise you to see this.
Edit 1
In one line code based on Onyambu advise :
mean(replicate(n, one_double_sampling()))
How can I simply tell R to retry a statement a few times if it errors? E.g. I was hoping to do something like:
tryCatch(dbGetQuery(...), # Query database
error = function(e) {
if (is.locking.error(e)) # If database is momentarily locked
retry(times = 3) # retry dbGetQuery(...) 3 more times
else {
# Handle other errors
}
}
)
I usually put the try block in a loop,
and exit the loop when it no longer fails or the maximum number of attempts is reached.
some_function_that_may_fail <- function() {
if( runif(1) < .5 ) stop()
return(1)
}
r <- NULL
attempt <- 1
while( is.null(r) && attempt <= 3 ) {
attempt <- attempt + 1
try(
r <- some_function_that_may_fail()
)
}
I wrote a quick function that allows you to easily retry an operating a configurable number of times, with a configurable wait between attempts:
library(futile.logger)
library(utils)
retry <- function(expr, isError=function(x) "try-error" %in% class(x), maxErrors=5, sleep=0) {
attempts = 0
retval = try(eval(expr))
while (isError(retval)) {
attempts = attempts + 1
if (attempts >= maxErrors) {
msg = sprintf("retry: too many retries [[%s]]", capture.output(str(retval)))
flog.fatal(msg)
stop(msg)
} else {
msg = sprintf("retry: error in attempt %i/%i [[%s]]", attempts, maxErrors,
capture.output(str(retval)))
flog.error(msg)
warning(msg)
}
if (sleep > 0) Sys.sleep(sleep)
retval = try(eval(expr))
}
return(retval)
}
So you can just write val = retry(func_that_might_fail(param1, param2), maxErrors=10, sleep=2) to retry calling that function with those parameters, give up after 10 errors, and sleep 2 seconds between attempts.
Also, you can redefine the meaning of what an error looks like by passing a different function as parameter isError, which by default will catch an error signaled with stop. This is useful if the function being called does something else on error, such as returning FALSE or NULL.
This is the alternative I've found so far that results in clearer, more readable code.
Hope this helps.
A solution without pre-assigning values and using for instead of while:
some_function_that_may_fail <- function(i) {
if( runif(1) < .5 ) stop()
return(i)
}
for(i in 1:10){
try({
r <- some_function_that_may_fail(i)
break #break/exit the for-loop
}, silent = FALSE)
}
r will be equal to the number of tries that were needed. If you dont want the output of the errors set silent to TRUE
Here's a function to generate a custom condition to respond to
locked <- function(message="occurred", ...) {
cond <- simpleCondition(message, ...)
class(cond) <- c("locked", class(cond))
cond
}
and a function implemented to allow (an infinite number of) restarts
f <- function() {
cnt <- 0L
repeat {
again <- FALSE
cnt <- cnt + 1L
withRestarts({
## do work here, and if needed...
signalCondition(locked())
}, retry=function() {
again <<- TRUE
})
if (!again) break
}
cnt
}
and the use of withCallingHandlers (to keep the context where the condition was signaled active unlike tryCatch) to handle the locked condition
withCallingHandlers({
n_tries <- 0L
f()
}, locked=function(e) {
n_tries <<- n_tries + 1L
if (n_retries < 3)
invokeRestart("retry")
})
I have put together the code and make it package: retry
f <- function(x) {
if (runif(1) < 0.9) {
stop("random error")
}
x + 1
}
# keep retring when there is a random error
retry::retry(f(1), when = "random error")
#> [1] 2
# keep retring until a requirement is satisified.
retry::retry(f(1), until = function(val, cnd) val == 2)
#> [1] 2
# or using one sided formula
retry::retry(f(1), until = ~ . == 2, max_tries = 10)
#> [1] 2
I like setting my object as an error from the start, also sometimes useful to add some sleep time if you're having connection problems:
res <- simpleError("Fake error to start")
counter <- 1
max_tries <- 10
# Sys.sleep(2*counter)
while(inherits(res, "error") & counter < max_tries) {
res <- tryCatch({ your_fun(...) },
error = function(e) e)
counter <- counter + 1
}
while (!exists("j")) {
i <- 1
repeat {
tryCatch(expr = {
print(i)
raw.result <- evalWithTimeout(Sys.sleep(i), timeout = 3)
if (i == 1) {
j <- i
} else {
j <- c(j, i)
}
i <- i + 1
}, TimeoutException = function(ex) {
rm("j")
})
}
}
The above code is getting stuck at i=4 and keeps executing the function for i=4, however I want it to restart from i=1, whenever there is an error.
Can someone please guide on where am I doing it wrong?
In your codeTimeoutException is unable to find j as it is evaluated in a different environment. Even if it was able to find it, nothing would change. As tryCatch is stopping an error from breaking a repeat loop, thus repeat will continue with the current i. You could explicitly break out from the repeat, but in that case you have deleted j, thus your while will stop.
I am not quite sure why you need while loop here.
Here is a modification of your code that will work as you want.
Fist explicitly set i <- 1, and rest it again to i <<-1 (Note <<- as i is one environment above tryCatch).
i <- 1
repeat {
tryCatch(
expr = {
print(i)
raw.result <- R.utils:evalWithTimeout(Sys.sleep(i), timeout = 3)
if (i == 1) {
j <- i
} else {
j <- c(j, i)
}
i <- i + 1
},
TimeoutException = function(ex) {
i <<- 1
}
)
}
I am trying to build a matrix model which ends if certain conditions are invoked - however for some reason the break() command isn't working, although stop() does. Unfortunately stop() is not what I need as I need to run the model a number of times.
The first break command in the model works, but I have left it in with dth>100 so that you can see for yourselves
n.steps <- 200
ns <- array(0,c(14,n.steps))
ns[13,1]<-rpois(1,3)
ns[14,1] <- 1
k<-0
for (i in 1:n.steps){
k<-k+1
ns[13,1]<-rpois(1,2)
death<-sample(c(replicate(1000,
sample(c(1,0), prob=c(surv.age.a, 1-surv.age.a), size = 1))),1)
ns[14,k] <- death
if (death == 0) {
dth <- sample(1:100, 1)
if (dth > 100) {
ns[14,k]<-0
print("stop.1")
break()
} else {
while (death == 0) {
if (ns[13, k] > 0) {
rep.vec[i]<-ns[13,k]
ns[13, k] <- ns[13, k] - 1
ns[14,k+1]<-1
print("replace")
} else {
if (ns[13, k] == 0) {
print("stop.2")
ns[14,k+1]<-0
break()
}
}
}
}
}
}
Try this (only showing the relevant portions):
for (i in 1:n.steps){
# ...
break.out.of.for <- FALSE
while (death == 0) {
if (ns[13, k-1] > 0) {
# ...
} else {
if (ns[13, k] == 0) {
# ...
break.out.of.for = TRUE
break
}
}
if (break.out.of.for) {
break
}
}
How can I simply tell R to retry a statement a few times if it errors? E.g. I was hoping to do something like:
tryCatch(dbGetQuery(...), # Query database
error = function(e) {
if (is.locking.error(e)) # If database is momentarily locked
retry(times = 3) # retry dbGetQuery(...) 3 more times
else {
# Handle other errors
}
}
)
I usually put the try block in a loop,
and exit the loop when it no longer fails or the maximum number of attempts is reached.
some_function_that_may_fail <- function() {
if( runif(1) < .5 ) stop()
return(1)
}
r <- NULL
attempt <- 1
while( is.null(r) && attempt <= 3 ) {
attempt <- attempt + 1
try(
r <- some_function_that_may_fail()
)
}
I wrote a quick function that allows you to easily retry an operating a configurable number of times, with a configurable wait between attempts:
library(futile.logger)
library(utils)
retry <- function(expr, isError=function(x) "try-error" %in% class(x), maxErrors=5, sleep=0) {
attempts = 0
retval = try(eval(expr))
while (isError(retval)) {
attempts = attempts + 1
if (attempts >= maxErrors) {
msg = sprintf("retry: too many retries [[%s]]", capture.output(str(retval)))
flog.fatal(msg)
stop(msg)
} else {
msg = sprintf("retry: error in attempt %i/%i [[%s]]", attempts, maxErrors,
capture.output(str(retval)))
flog.error(msg)
warning(msg)
}
if (sleep > 0) Sys.sleep(sleep)
retval = try(eval(expr))
}
return(retval)
}
So you can just write val = retry(func_that_might_fail(param1, param2), maxErrors=10, sleep=2) to retry calling that function with those parameters, give up after 10 errors, and sleep 2 seconds between attempts.
Also, you can redefine the meaning of what an error looks like by passing a different function as parameter isError, which by default will catch an error signaled with stop. This is useful if the function being called does something else on error, such as returning FALSE or NULL.
This is the alternative I've found so far that results in clearer, more readable code.
Hope this helps.
A solution without pre-assigning values and using for instead of while:
some_function_that_may_fail <- function(i) {
if( runif(1) < .5 ) stop()
return(i)
}
for(i in 1:10){
try({
r <- some_function_that_may_fail(i)
break #break/exit the for-loop
}, silent = FALSE)
}
r will be equal to the number of tries that were needed. If you dont want the output of the errors set silent to TRUE
Here's a function to generate a custom condition to respond to
locked <- function(message="occurred", ...) {
cond <- simpleCondition(message, ...)
class(cond) <- c("locked", class(cond))
cond
}
and a function implemented to allow (an infinite number of) restarts
f <- function() {
cnt <- 0L
repeat {
again <- FALSE
cnt <- cnt + 1L
withRestarts({
## do work here, and if needed...
signalCondition(locked())
}, retry=function() {
again <<- TRUE
})
if (!again) break
}
cnt
}
and the use of withCallingHandlers (to keep the context where the condition was signaled active unlike tryCatch) to handle the locked condition
withCallingHandlers({
n_tries <- 0L
f()
}, locked=function(e) {
n_tries <<- n_tries + 1L
if (n_retries < 3)
invokeRestart("retry")
})
I have put together the code and make it package: retry
f <- function(x) {
if (runif(1) < 0.9) {
stop("random error")
}
x + 1
}
# keep retring when there is a random error
retry::retry(f(1), when = "random error")
#> [1] 2
# keep retring until a requirement is satisified.
retry::retry(f(1), until = function(val, cnd) val == 2)
#> [1] 2
# or using one sided formula
retry::retry(f(1), until = ~ . == 2, max_tries = 10)
#> [1] 2
I like setting my object as an error from the start, also sometimes useful to add some sleep time if you're having connection problems:
res <- simpleError("Fake error to start")
counter <- 1
max_tries <- 10
# Sys.sleep(2*counter)
while(inherits(res, "error") & counter < max_tries) {
res <- tryCatch({ your_fun(...) },
error = function(e) e)
counter <- counter + 1
}