I have written small function but somehow does not work as expected.
I have connection to server and sometime the server is down so I cannot connect. The script is running in batch so I have to have it automatized.
The script should run the conn <- function(..) successfully (it means no error message) if not restart/re-check and restart again in approx. 1min time. This should run in loop until connection is established something like 12 hours. (approx.). The connection should be assigned to conn object so the object must return successful connection. (something like <Connection established, # 20180522 20:43:41 CET>
The function which does not work is here:
connect <- function(c) { message(paste("remaining run", c));
withRestarts(err <- tryCatch({ conn <- server.coonect(settings...) },
error=function(e) { invokeRestart("reconnect") }), reconnect = function() { message("re-connecting");
stopifnot(c > 0); for(i in 1:10) { Sys.sleep(6); cat(i) }; connect(c-1) }) }
connect(1000) # with approx. 1min sleep we get here over 12 hours running..
So the question is what is wrong and how to rewrite the function such it runs as expected. Thanks.
EDIT
It seems that the function should be:
connect <- function(c) { message(paste("remaining run", c));
withRestarts(err <- tryCatch({ server.coonect(settings...) },
error=function(e) { invokeRestart("reconnect") }), reconnect = function() { message("re-connecting");
stopifnot(c > 0); for(i in 1:10) { Sys.sleep(6); cat(i) } }) }
conn <- connect(1000)
EDIT 2
Here is comment for the above function I have tested:
I have tested the EDIT function by simulating the connection by first running the function without internet connection (now the function checks every 1:10 o 6sec, and after the function is running I connect to the internet, now I expect the function in next iteration pics up and connects to server if available...) what happens is that the function does not pick up the later possibility to connect...
If you only want to loop over the connection establishment this will work:
# simulate an instable connection
server.connect <- function(...) {
if (round(as.numeric(Sys.time())) %% 10 != 0) # about 90 % failed connections
stop("Connection error")
return(TRUE) # success
}
connect <- function(attempts = 1, sleep.seconds = 6) {
for (i in 1:attempts) {
res <- try(server.connect("my connection string"), silent = TRUE)
if (!("try-error" %in% class(res))) {
print("Connected...")
return(res)
}
print(paste0("Attempt #", i, " failed"))
Sys.sleep(sleep.seconds)
}
stop("Maximum number of connection attempts exceeded")
}
con <- connect(attempts = 10, sleep = 1)
Example execution log:
[1] "Attempt #1 failed"
[1] "Attempt #2 failed"
[1] "Attempt #3 failed"
[1] "Attempt #4 failed"
[1] "Attempt #5 failed"
[1] "Attempt #6 failed"
[1] "Connected..."
Related
I've read a few other SO questions about tryCatch and cuzzins, as well as the documentation:
Exception handling in R
catching an error and then branching logic
How can I check whether a function call results in a warning?
Problems with Plots in Loop
but I still don't understand.
I'm running a loop and want to skip to next if any of a few kinds of errors occur:
for (i in 1:39487) {
# EXCEPTION HANDLING
this.could.go.wrong <- tryCatch(
attemptsomething(),
error=function(e) next
)
so.could.this <- tryCatch(
doesthisfail(),
error=function(e) next
)
catch.all.errors <- function() { this.could.go.wrong; so.could.this; }
catch.all.errors;
#REAL WORK
useful(i); fun(i); good(i);
} #end for
(by the way, there is no documentation for next that I can find)
When I run this, R honks:
Error in value[[3L]](cond) : no loop for break/next, jumping to top level
What basic point am I missing here? The tryCatch's are clearly within the for loop, so why doesn't R know that?
The key to using tryCatch is realising that it returns an object. If there was an error inside the tryCatch then this object will inherit from class error. You can test for class inheritance with the function inherit.
x <- tryCatch(stop("Error"), error = function(e) e)
class(x)
"simpleError" "error" "condition"
Edit:
What is the meaning of the argument error = function(e) e? This baffled me, and I don't think it's well explained in the documentation. What happens is that this argument catches any error messages that originate in the expression that you are tryCatching. If an error is caught, it gets returned as the value of tryCatch. In the help documentation this is described as a calling handler. The argument e inside error=function(e) is the error message originating in your code.
I come from the old school of procedural programming where using next was a bad thing. So I would rewrite your code something like this. (Note that I removed the next statement inside the tryCatch.):
for (i in 1:39487) {
#ERROR HANDLING
possibleError <- tryCatch(
thing(),
error=function(e) e
)
if(!inherits(possibleError, "error")){
#REAL WORK
useful(i); fun(i); good(i);
}
} #end for
The function next is documented inside ?for`.
If you want to use that instead of having your main working routine inside an if, your code should look something like this:
for (i in 1:39487) {
#ERROR HANDLING
possibleError <- tryCatch(
thing(),
error=function(e) e
)
if(inherits(possibleError, "error")) next
#REAL WORK
useful(i); fun(i); good(i);
} #end for
I found other answers very confusing. Here is an extremely simple implementation for anyone who wants to simply skip to the next loop iteration in the event of an error
for (i in 1:10) {
skip_to_next <- FALSE
# Note that print(b) fails since b doesn't exist
tryCatch(print(b), error = function(e) { skip_to_next <<- TRUE})
if(skip_to_next) { next }
}
for (i in -3:3) {
#ERROR HANDLING
possibleError <- tryCatch({
print(paste("Start Loop ", i ,sep=""))
if(i==0){
stop()
}
}
,
error=function(e) {
e
print(paste("Oops! --> Error in Loop ",i,sep = ""))
}
)
if(inherits(possibleError, "error")) next
print(paste(" End Loop ",i,sep = ""))
}
The only really detailed explanation I have seen can be found here: http://mazamascience.com/WorkingWithData/?p=912
Here is a code clip from that blog post showing how tryCatch works
#!/usr/bin/env Rscript
# tryCatch.r -- experiments with tryCatch
# Get any arguments
arguments <- commandArgs(trailingOnly=TRUE)
a <- arguments[1]
# Define a division function that can issue warnings and errors
myDivide <- function(d, a) {
if (a == 'warning') {
return_value <- 'myDivide warning result'
warning("myDivide warning message")
} else if (a == 'error') {
return_value <- 'myDivide error result'
stop("myDivide error message")
} else {
return_value = d / as.numeric(a)
}
return(return_value)
}
# Evalute the desired series of expressions inside of tryCatch
result <- tryCatch({
b <- 2
c <- b^2
d <- c+2
if (a == 'suppress-warnings') {
e <- suppressWarnings(myDivide(d,a))
} else {
e <- myDivide(d,a) # 6/a
}
f <- e + 100
}, warning = function(war) {
# warning handler picks up where error was generated
print(paste("MY_WARNING: ",war))
b <- "changing 'b' inside the warning handler has no effect"
e <- myDivide(d,0.1) # =60
f <- e + 100
return(f)
}, error = function(err) {
# warning handler picks up where error was generated
print(paste("MY_ERROR: ",err))
b <- "changing 'b' inside the error handler has no effect"
e <- myDivide(d,0.01) # =600
f <- e + 100
return(f)
}, finally = {
print(paste("a =",a))
print(paste("b =",b))
print(paste("c =",c))
print(paste("d =",d))
# NOTE: Finally is evaluated in the context of of the inital
# NOTE: tryCatch block and 'e' will not exist if a warning
# NOTE: or error occurred.
#print(paste("e =",e))
}) # END tryCatch
print(paste("result =",result))
One thing I was missing, which breaking out of for loop when running a function inside a for loop in R makes clear, is this:
next doesn't work inside a function.
You need to send some signal or flag (e.g., Voldemort = TRUE) from inside your function (in my case tryCatch) to the outside.
(this is like modifying a global, public variable inside a local, private function)
Then outside the function, you check to see if the flag was waved (does Voldemort == TRUE). If so you call break or next outside the function.
To handle warnings or errors one can use
result = tryCatch({
expr
}, warning = function(w) {
warning-handler-code
}, error = function(e) {
error-handler-code
}, finally = {
cleanup-code
}
but if expr gives a message through simpleMessage, how can I get it? Is there something like?:
message = function(m) {message-handler-code}
Or another function which allows me to capture the message?
Thank you!
Yes, you can use message = just as you can with warning and error:
result = tryCatch({
message("Hello world")
1 + 1
}, message = function(m) {m}
)
result
#> <simpleMessage in message("Hello world"): Hello world
>
It's more likely however that you would want to capture your result and message separately:
result <- withCallingHandlers({
message("Hello world")
1 + 1
}, message = function(m) {
lastMessage <<- m
invokeRestart("muffleMessage")
})
result
#> [1] 2
if(exists("lastMessage")) message(lastMessage)
#> Hello world
tryCatch is the most commonly useful solution for handling conditions.
However, tryCatch aborts execution and returns the value of the handler, rather than resuming execution of the code. This may not always be what you want; sometimes you want to handle a condition and carry on.
R allows this thanks to its incredibly powerful condition system.
For example, you can choose to silence all messages:
suppressMessages(expr)
The nice thing here is that the suppressMessages isn’t magic — it’s a plain old R function and you could write it yourself (but you do need to understand the condition system, and the price for its versatility is that it’s fairly complicated).
To illustrate this, here’s another way of handling messages — using withCallingHandlers — which suppresses the messages, carries on executing the code it’s called with, but at the same time logs the message in a list:
messages = list()
withCallingHandlers({
message('Hello world')
1 + 1
}, message = function (msg) {
messages <<- c(messages, msg)
tryInvokeRestart('muffleMessage')
})
tryInvokeRestart('muffleMessage') is the same method by which suppressMessages works. The only difference is that we added code to store the message.
As a last step, the above can even be wrapped inside a function:
with_logging = function (expr) {
messages = list()
log_message = function (msg) {
messages <<- c(messages, conditionMessage(msg))
tryInvokeRestart('muffleMessage')
}
result = withCallingHandlers(expr, message = log_message)
list(result = result, messages = messages)
}
And to use it:
with_logging({
message('this is a test')
1 + 1
})
$result
[1] 2
$messages
$messages[[1]]
[1] "this is a test\n"
I am using R package foreach.
When bug exists in foreach block, it's hard to re-occur it and hard to debug.
Take the following script as example.
I want to stop at i=4 to check what's wrong. However, it stops at i=10.
Any solution?
library(foreach)
foreach(i = icount(10)) %do% {
if (i == 4){
e <- simpleError("test error")
stop(e)
}
}
One option to handle this is with a browser() inside a tryCatch as in:
foreach(i = icount(10)) %do% {
tryCatch(
if (i == 4){
e <- simpleError("test error")
stop(e)
},
error = function(e) browser()
)
}
This will produce a browser of the environment at the time of the error, which will allow you to inspect any objects and/or debug your code.
Your console will then look like the following and you can ask what the value of i is. Like this:
Browse[1]> i
[1] 4
I tried to read everything, but i kind of got stuck on one problem.
By using bigrquery I create queries to Google BigQuery to get data - unfortunately sometimes my query doesn't work because of a time-out.
Q is a SQL-Query and BQ is supposed to store the data downloaded from BigQuery.
Does anybody know how to re-do a loop every time tryCatch gives me an error?
I got this so far:
BQ_Foo <- NULL
tryCatch(
{
repeat{
BQ_Foo <- query_exec(Q_foo,"bigquery")
if(is.list(BQ_Foo) == TRUE)break }
}
,error=function(e){cat("ERROR : Query not loaded!", "\n")}
)
EDIT:
I tried my first approach again and this time i received this error message:
Error in curl::curl_fetch_memory(url, handle = handle) :
Operation was aborted by an application callback
Does anybody know how to handle this?
Widely based on r2evans answer, here's how to do the same kind of things with withRestarts, with some helps from This blog post:
set.seed(2)
foo <- NULL
operation <- function(x,tries) {
message(paste("x is",x,"remaining tries",tries))
withRestarts(
tryCatch({
if (runif(1) < x) stop("fail!") else 1
},
error=function(e) { invokeRestart("retry")}),
retry = function() {
message("Retrying")
stopifnot(tries > 0)
operation(x,tries-1)
}
)
}
> operation(0.9,5)
# x is 0.9 remaining tries 5
# Retrying
# x is 0.9 remaining tries 4
# Retrying
# x is 0.9 remaining tries 3
# Retrying
# x is 0.9 remaining tries 2
# Retrying
# x is 0.9 remaining tries 1
[1] 1
It's a kind of recursive call, so you can do whatever you want before calling the function again.
You may do it in the tryCatch error handler the same way, the interest to use restarts handlers is to call a specific function, if you had two tryCatch for which you want nearly same handler behavior then you can add a parameter and use the same handler for each try catch, i.e.:
testfun <- function(x) {
withRestarts({
tryCatch(
{
ifelse(runif(1) < 0.5,stop("Error Message"),warning("Warning message"))
},
warning=function(e) { invokeRestart("logger", level="warning", message=e ) },
error=function(e) { invokeRestart("logger", level="error", message=e ) }
)
},
logger = function(level,message) {
message(date()," [",level,"]: ",message[['message']])
}
)
}
Giving:
> set.seed(2)
> testfun()
Fri Jul 29 14:15:11 2016 [error]: Error Message
> testfun()
Fri Jul 29 14:15:12 2016 [warning]: Warning message
> testfun()
Fri Jul 29 14:15:13 2016 [warning]: Warning message
> testfun()
Fri Jul 29 14:15:13 2016 [error]: Error Message
Main interest here is the factorizing of the logger method and to reduce code duplication.
Naïve Solution
You might start with a mildly naïve attempt of putting the repeat/while outside the tryCatch, something like this:
set.seed(2)
foo <- NULL
while (is.null(foo)) {
foo <- tryCatch({
if (runif(1) < 0.9) stop("fail!") else 1
},
error = function(e) { message("err"); NULL; }
)
}
# err
# err
# err
# err
message("success: ", foo)
# success: 1
Unfortunately you introduce the possibility that the loop will never return. To protect against this, you can try a counter ...
Less-Naïve Solution
set.seed(2)
foo <- NULL
max_attempts <- 3
counter <- 0
while (is.null(foo) && counter < max_attempts) {
counter <- counter + 1
foo <- tryCatch({
if (runif(1) < 0.9) stop("fail!") else 1
},
error = function(e) { message("err"); NULL; }
)
}
# err
# err
# err
if (is.null(foo)) message("final failure") else message("success: ", foo)
# final failure
Now this is better for you, but it may still inadvertently introduce a denial-of-service "attack" on the server. (Consider "why" the query failed: if it is because the server is temporarily inundated, then you are making things worse by clobbering it even for a few limited requests.) Though it slows you down a little, in the case of a busy server, putting in pauses will ease the burden on the server and possibly give you a better chance of a successful query before failing.
Better Solution
In network parlance, small TCP packets can cause congestion when repeated retried (see Nagle's Algorithm for a quick reference). Using some form of exponential backoff is common, and to guard against two (or more) clients doing exactly same backoff simultaneously, some clients jitter slightly (for example, httr::RETRY).
set.seed(2)
foo <- NULL
max_attempts <- 3
# borrowed from hadley/httr::RETRY
pause_cap <- pause_base <- 1
counter <- 0
while (is.null(foo) && counter < max_attempts) {
if (counter > 0L) {
length <- stats::runif(1, max = min(pause_cap, pause_base * (2 ^ counter)))
message("sleeping ", round(length, 1))
Sys.sleep(length)
}
counter <- counter + 1
foo <- tryCatch({
if (runif(1) < 0.9) stop("fail!") else 1
},
error = function(e) { message("err"); NULL; }
)
}
# err
# sleeping 0.7
# err
# sleeping 0.2
if (is.null(foo)) message("final failure") else message("success: ", foo)
# success: 1
Wrap-Up
Somewhat sloppy code, but I hope you get the point. Putting loops on network queries without some form of self-limit can very easily escalate into an inadvertent DOS.
Based on your ideas i created this code, which seems to work - i just need to stresstest it.
QFoo <- paste0('SQL Code', dateBQ, ' ')
BQFoo <- NULL
testfun <- function(QFoo) {
withRestarts({
tryCatch({
query_exec(QFoo, "bigquery")
},
warning = function(e) { invokeRestart("logger", level="warning", message = e) },
error = function(e) { invokeRestart("logger", level="error", message = e) })
},
logger = function(level, message) {
message(date(), " [", level, "]: ", message[['message']])
})
}
testfun(QFoo)
I'm performing thousands of calculations with R and some external software.
To keep track of this, I have constructed a pipeline in R on a SQLite3 database.
To get things done, I've set it up to allow for multiple nodes on our computing cluster to run the R script.
Naturally, we need to keep things atomized so I am actively starting transactions.
To avoid the script from crashing when trying to get a lock on the database, I have the following code that attempts to begin a transaction, and if fails, waits and then retries:
dbBeginTransaction <- function(dbconn, state='DEFERRED', timeout=5, retries=10) {
state <- toupper(state)
if (!state %in% c('DEFERRED','IMMEDIATE','EXCLUSIVE')) stop('Attempt at illegal transaction.')
res <- NULL
exit <- FALSE
for (i in 1:retries) {
try(
res <- dbSendQuery(dbconn, paste('BEGIN',state,'TRANSACTION;'))
, silent=TRUE
)
# res is null if above query fails.
err <- dbGetException(dbconn)
if (err$errorNum == 0) { ## OK
#return(TRUE)
exit <- TRUE
break
} else if (err$errorNum == 5) { ## Database locked.
if (i == retries+1) {
cat('Database still locked after',i,'attempts.\n',file=stderr())
#return(FALSE)
exit <- FALSE
break
} else {
Sys.sleep(timeout)
}
} else {
## errorNum == 1 ## Already within transaction.
cat(err$errorMsg, '\n', file = stderr())
#return(FALSE)
exit <- FALSE
break
}
}
invisible(exit)
}
## Usage:
insert_results <- function(results) {
## Some preparing of results
if (dbBeginTransaction(conn, 'EXCLUSIVE') == FALSE) return(FALSE)
dbSendPreparedQuery(conn, 'INSERT INTO results (...) VALUES (...);', results)
dbCommit(conn)
}
## After a computation:
results <- magic()
if (!insert_results(results)) stop('Could not save results')
When debugging, it works as it should. But every now and then I get this odd error, and the script crashes:
Error in sqliteSendQuery(conn, statement, bind.data) :
rsqlite_query_send: could not execute: database is locked
Calls: dbSendPreparedQuery ... dbSendPreparedQuery -> .local -> sqliteSendQuery -> .Call
Execution halted
I cannot fathom what happens, and I am yet to reproduce the error.
The error is clear, but I would have thought that my routine had prevented it.
Any thoughts on why this is happening?
I'm running R under linux, as seen by:
> sessionInfo()
R version 3.1.2 (2014-10-31)
Platform: x86_64-unknown-linux-gnu (64-bit)
locale:
[1] LC_CTYPE=en_US LC_NUMERIC=C LC_TIME=en_US
[4] LC_COLLATE=en_US LC_MONETARY=en_US LC_MESSAGES=en_US
[7] LC_PAPER=en_US LC_NAME=C LC_ADDRESS=C
[10] LC_TELEPHONE=C LC_MEASUREMENT=en_US LC_IDENTIFICATION=C
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] RSQLite_1.0.0 DBI_0.3.1
Encountered this problem today in the office today. This is the suggestion of my colleague: It can be solved by making sure that every time you do a database connection and make some sort of change to the database you do a dbCommit(con). The new code would look like this:
dbBeginTransaction <- function(dbconn, state='DEFERRED', timeout=5, retries=10) {
state <- toupper(state)
if (!state %in% c('DEFERRED','IMMEDIATE','EXCLUSIVE')) stop('Attempt at illegal transaction.')
res <- NULL
exit <- FALSE
for (i in 1:retries) {
try(
dbBegin(dbconn)
res <- dbSendQuery(dbconn, paste('BEGIN',state,'TRANSACTION;'))
, silent=TRUE
)
# res is null if above query fails.
err <- dbGetException(dbconn)
if (err$errorNum == 0) { ## OK
#return(TRUE)
exit <- TRUE
break
} else if (err$errorNum == 5) { ## Database locked.
if (i == retries+1) {
cat('Database still locked after',i,'attempts.\n',file=stderr())
#return(FALSE)
exit <- FALSE
break
} else {
Sys.sleep(timeout)
}
} else {
## errorNum == 1 ## Already within transaction.
cat(err$errorMsg, '\n', file = stderr())
#return(FALSE)
exit <- FALSE
break
}
}
invisible(exit)
}
## Usage:
insert_results <- function(results) {
## Some preparing of results
if (dbBeginTransaction(conn, 'EXCLUSIVE') == FALSE) return(FALSE)
dbSendPreparedQuery(conn, 'INSERT INTO results (...) VALUES (...);', results)
dbCommit(conn)
}
## After a computation:
results <- magic()
if (!insert_results(results)) stop('Could not save results')
And I solved by adding dbBegin(con) just before your begin any transactions with the database
dbBeginTransaction <- function(dbconn, state='DEFERRED', timeout=5, retries=10) {
state <- toupper(state)
if (!state %in% c('DEFERRED','IMMEDIATE','EXCLUSIVE')) stop('Attempt at illegal transaction.')
res <- NULL
exit <- FALSE
for (i in 1:retries) {
try(
res <- dbSendQuery(dbconn, paste('BEGIN',state,'TRANSACTION;'))
, silent=TRUE
dbCommit(dbconn)
)
# res is null if above query fails.
err <- dbGetException(dbconn)
if (err$errorNum == 0) { ## OK
#return(TRUE)
exit <- TRUE
break
} else if (err$errorNum == 5) { ## Database locked.
if (i == retries+1) {
cat('Database still locked after',i,'attempts.\n',file=stderr())
#return(FALSE)
exit <- FALSE
break
} else {
Sys.sleep(timeout)
}
} else {
## errorNum == 1 ## Already within transaction.
cat(err$errorMsg, '\n', file = stderr())
#return(FALSE)
exit <- FALSE
break
}
}
invisible(exit)
}
## Usage:
insert_results <- function(results) {
## Some preparing of results
if (dbBeginTransaction(conn, 'EXCLUSIVE') == FALSE) return(FALSE)
dbSendPreparedQuery(conn, 'INSERT INTO results (...) VALUES (...);', results)
dbCommit(conn)
}
## After a computation:
results <- magic()
if (!insert_results(results)) stop('Could not save results')