Test if an unevaluated promise exists - r

I has the following function:
f <- function(a, b=list()) {
if(exists("b")) {
if(exists("x",b)){
a+b[["x"]]
} else {
a
}
} else {
-a
}
}
And it's work, except when I put a undefined value for b:
exists("tmp")
# [1] FALSE
f(a = 1, b=tmp)
# Error in exists("x", b) : object 'tmp' not found
Is there a function to check if the promise value exists inside my function f?

What about something like this.
f <- function(a, b=list()) {
tryCatch(force(b), error=function(e) b<<-NULL)
if(!is.null(b)) {
if(exists("x",b)){
a+b[["x"]]
} else {
a
}
} else {
-a
}
}
f(5, tmp)
# [1] -5
f(5, list(x=3))
# [1] 8
f(5, list(z=3))
# [1] 5
Here we force evaluation of the parameter to see if it exists or resolves to something within a tryCatch() expression to handle the case where the variable does not exist. If it doesn't exist, we set it to NULL to make the rest of the function easier to work with.

Related

rlang::duplicate data.table::copy work outside a function but not inside

New to R. I'm trying to conditionally duplicate a function inside another function. I've tried using rlang::duplicate and data.table::copy.
library(rlang)
func1 <- function() {
print("horg1")
}
func2 <- function() {
print("horg2")
}
cond.rename <- function(horg) {
if (horg=="1") {
func<-rlang::duplicate(func1)
}
if (horg=="2") {
func<-rlang::duplicate(func2)
}
func
}
cond.rename("1")
This does not work. No function called "func" is created. However, if I run func<-duplicate(func1) outside of a function it will create the function called "func". What am I doing wrong? If it's not obvious, this is drastically simplified from my actual code so if the purpose of the whole thing isn't clear that is why.
Your rename_*() function can do one of two things. rename_local() returns a function (not a value) that you can then call.
func1 <- function() {
print("horg1")
}
func2 <- function() {
print("horg2")
}
rename_local <- function(horg) {
if (horg == "1") {
func <- rlang::duplicate(func1)
} else if (horg == "2") {
func <- rlang::duplicate(func2)
}
func
}
# Return functions
rename_local("1")
#> function() {
#> print("horg1")
#> }
rename_local("2")
#> function() {
#> print("horg2")
#> }
# Return values
rename_local("1")()
#> [1] "horg1"
rename_local("2")()
#> [1] "horg2"
And rename_global() overwrites the function in the global environment. If you want to (re)define a function in the global environment, use <<- instead of <-. This is sometimes called super assignment
rename_global <- function(horg) {
if (horg == "1") {
func <<- rlang::duplicate(func1)
} else if (horg == "2") {
func <<- rlang::duplicate(func2)
}
}
# Set global function
rename_global("1")
func
#> function() {
#> print("horg1")
#> }
Resources for Environments.
The chapter in Advanced R by Hadley.
The Scope section of the Intro manual is another good source.
How do you use "<<-" (scoping assignment) in R?

If else statement to check if any numbers are negative in R

This is probably very simple, but I am not sure why it's not working.
For input vector b, I want to write a function which begins by checking b for any negative values. If there are any, then the function stops. Otherwise, it continues. What the function is doesn't matter.
Something like this:
F <- function(b) {
if (any(b) < 0) {
warning("error")
} else {
# the function I want to put in
}
}
Edit:
The code that works is
F <- function(b) {
if (any(b < 0)) {
stop("error")
} else {
# the function I want to put in
}
}

IF ELSE function works in simple case, but my expanded function does not

I am trying to create functions that evaluates numbers and adds them to a category dependent on set criteria.
I wrote a "stupid" function with a lot of repetitions and lines, that can solve the job in a simple case:
# Findgroup (Everything manually typed out)
# Purpose of function:
#If 1 or 2: output A
#If 3 or 4: output B
#If 5 or 6: output random A/B (bonus if this can be balanced equally over the dataset)
# Else output "error"
findGroup <- function(x){ if (x == 1) {
"A"
} else if (x == 2) {
"A"
} else if (x == 3) {
"B"
} else if (x == 4) {
"B"
}else if (x == 5) {
sample(c("sA","sB"),1)
}else if (x == 6) {
sample(c("sA","sB"),1)
} else {
"Error"
}}
# Brief test: All matches expectations
findGroup(1) # Returns A
findGroup(3) # Returns B
findGroup(5) # Samples
findGroup(7) # Returns Error
This is okay, if I had to evaluate a few numbers. But what should I do if the list of numbers is much more elaborate? I tried to write a function that solves this in fewer lines, but the result does not work:
# Findgroup new
# Purpose of function:
#If 2:8: output A
#If 10:16: output B
#If 1,9: output random A/B (bonus if this can be balanced equally)
findGroupNew <- function(x){ if (x == 2|3|4|5|6|7|8) {
"A"
} else if (x == 10|11|12|13|14|15|16) {
"B"
} else if (x == 1||9) {
sample(c("sA","sB"),1)
} else {
"Error"
}}
# Brief test: All return A!!!
findGroupNew(1) # Should sample
findGroupNew(3) # Should Return A
findGroupNew(11) # Should Return B
findGroupNew(17) # Should Return Error
It may be a stupid mistake such as not having used the right sign for OR, but having tried solutions such as using || and & has not been successful.
I hope there is a quick fix to this issue and will appreciate your feedback.
Use %in% to check for multiple values.
findGroupNew <- function(x) {
if (x %in% 2:6) {
return("A")
} else if (x %in% 10:16) {
return("B")
} else if (x %in% c(1, 9)) {
return(sample(c("sA","sB"),1))
} else {
return("Error")
}
}
findGroupNew(1)
#[1] "sB"
findGroupNew(3)
#[1] "A"
findGroupNew(11)
#[1] "B"
findGroupNew(7)
#[1] "Error"

Execute an Rscript until it has finished successfully [duplicate]

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
}

Non-execution of statement in function calling

While working on some problem i came across a situation in which i wanted to know if a function was executed when called upon. To do so i put a print statement in the function.
abc = function(x)
if(x > 0) {
return(x)
print("Go")
} else {
return(0)
print("Run")
}
y = abc(3)
y
# [1] 3
Why print statement is not executed while calling abc()?
That is because you are returning before printing. Change the sequence of those two statements and it should print
abc = function(x) {
if(x > 0) {
print("Go")
return(x)
} else {
print("Run")
return(0)
}
}
abc(3)
#[1] "Go"
#[1] 3
abc(-3)
#[1] "Run"
#[1] 0

Resources