I want to generate a function with some conditions. If those conditions are TRUE then those will be used for further execution. But my problem is that R is not finding that even that is TRUE. Following is my R code;
require(KernSmooth)
require(kerdiest)
mini<-function(y,k,h1=TRUE, h2=TRUE, h3=TRUE,type){
n <- length(y)
x <- seq(min(y) + 0.05, max(y), length = k)
if(h1==TRUE){
h1 <- abs(dpik(y) )
} else { print("DPI is not selected")
}
if(h2==TRUE){
h2<-abs(ALbw(vec_data=y))
} else { print("AL is not selected")
}
if(h3==TRUE){
h3 <-abs(1.06*sd(y)*(n^(-1/5)))
} else { print("NSR is not selected")
}
ftrue<-switch(type,
Exp = dexp(x,(1/mean(x))),
Gamma = dgamma(x,(mean(x)/(var(x)/mean(x))),(var(x)/mean(x)))
)
dpi<-h1-sum(ftrue)
AL<-h2*3
nsr<-h3*4
v<-c("DPI"=dpi, "Altaman"=AL, "NSR"=nsr)
v[which.min(v)]
}#function end
y<-rexp(100,1)
mini(y,200,h1,h2,h3,"exp")
but there is error:
Error in mini(y, 200, h1, h2, h3, "exp") : object 'h1' not found
I am getting any clue what is my mistake here. Please help me in this problem.
Related
I'm trying to write a function to compute sample sizes in R.
The function uses a couple of smaller functions. I'd like to pass arguments into the smaller functions using the dots. Here is my function so far:
log_reg_var<-function(p){
if(p<=0|p>=1) stop('p must be between 0 and 1')
var<-1/(p*(1-p))
return(var)
}
samplesize<-function(method_name, beta, sigma_x, mult_cor, power= 0.8,fpr = 0.05,...){
if(method_name=='linear regression'){
var_func <- lin_reg_var
}
else if(method_name=='logistic regression'){
var_func <- log_reg_var
}
else if(method_name=='cox regression'){
var_func <- cox_reg_var
}
else if(method_name=='poisson regression'){
var_func <- pois_reg_var
}
else{
stop('method_name not recognized. method_name accepts one of: "linear regression",
"logistic regression","cox regression", or "poisson regression"')
}
top = (qnorm(1-fpr/2) + qnorm(power))^2
bottom = (beta*sigma_x)^2*(1-mult_cor)
n = (top/bottom)*var_func(...)
return(ceiling(n))
}
I should be able to do
samplesize(method_name = 'logreg',1,1,0,p=0.5)
>>>32
But instead I am thrown the following error:
Error in var_func(...) : argument "p" is missing, with no default
Clearly there is something wrong with me passing p through the dots, but I'm not sure what is wrong.
What is my problem here?
You need to add the additional parameter p as an argument and you need to pass it into your log_reg_var() function. You also have to be careful with some other syntax:
log_reg_var<-function(p){
if(p<=0|p>=1) stop('p must be between 0 and 1')
var<-1/(p*(1-p))
return(var)
}
# specify that you pass a parameter `p`
samplesize<-function(method_name, beta, sigma_x, mult_cor, power= 0.8,fpr = 0.05, p, ...){
# Initialize `var_func` to a NULL value
var_func = NULL
if(method_name=='linear regression'){
var_func <- lin_reg_var(p)
}
else if(method_name=='logistic regression'){
# pass parameter `p` into log_reg_var since there is no default
var_func <- log_reg_var(p)
}
else if(method_name=='cox regression'){
var_func <- cox_reg_var(p)
}
else if(method_name=='poisson regression'){
var_func <- pois_reg_var(p)
}
else{
stop('method_name not recognized. method_name accepts one of: "linear regression",
"logistic regression","cox regression", or "poisson regression"')
}
top = (qnorm(1-fpr/2) + qnorm(power))^2
bottom = (beta*sigma_x)^2*(1-mult_cor)
n = (top/bottom)*var_func
return(ceiling(n))
}
> samplesize(method_name ='logistic regression', 1, 1, 0, p=0.5)
[1] 32
IS <- function(N,K,sigma,t,r,S_0,a,b,tol){
funct_1 <- function(x){
return((S_0*(exp(-0.5*(sigma^2)*t+sigma*sqrt(t)*x))*(sigma*sqrt(t)-x))+
(exp(-r*t))*K*x)
}
bisection_method <- function(a, b, tol, f = funct_1){
if (f(a)*f(b) > 0){
print("No root found.")
} else
while ((b - a)/2.0 > tol){
midpt= (a + b)/2.0
if (f(midpt) == 0){
return(midpt)
} else if (f(a)*f(midpt) < 0){
b = midpt
} else
a = midpt
}
return(midpt)
}
}
The above function will produce nothing for you. My goal that to input the values of "N,K,sigma,t,r,S_0, a,b" and somehow return "midpt" for me. I have searched a lot but could not come up with anything that makes sense. I have many problems, assume that I input everything things, then how the function "funct_1" will output expression, this expression needs to be recalled to the next function "bisection_method} along with the value of a and b then finally obtain the "midpt" value. Any suggestions are really appreciated. Please let me know if there is anything not clear to you at all.
Your main function doesn't return anything. It just creates the auxiliary functions and then do nothing. That's why you're getting no output.
Try returning the bisection method with appropriate parameters in your main function instead. I also edited so you get NULL output when no root is found.
IS <- function(N,K,sigma,t,r,S_0,a,b,tol){
funct_1 <- function(x){
return((S_0*(exp(-0.5*(sigma^2)*t+sigma*sqrt(t)*x))*(sigma*sqrt(t)-x))+
(exp(-r*t))*K*x)
}
bisection_method <- function(a, b, tol, f = funct_1){
if (f(a)*f(b) > 0){
print("No root found."); return(NULL)
} else
while ((b - a)/2.0 > tol){
midpt= (a + b)/2.0
if (f(midpt) == 0){
return(midpt)
} else if (f(a)*f(midpt) < 0){
b = midpt
} else
a = midpt
}
return(midpt)
}
return(bisection_method(a,b,tol,funct_1))
}
Figured out some parameter combination that makes sense:
IS(1,1,1,4,5,1,.1,9,10^-4)
[1] 2.000023
I have the code below, which seems to accomplish what I'm trying to do but also throws the error output shown below the code. What I'm trying to do, is run through the loop the first time with x = 1, then for each time the loop runs after that I want x = y, the result of the previous loop. I always fumble with loops so any tips are greatly appreciated.
Code:
for(i in 1:5)
{
if(i=1)
{
x<-1
}
else
{
x<-y
}
y<-x*i
y
}
ERRORS:
for(i in 1:5)
+ {
+ if(i=1)
Error: unexpected '=' in:
"{
if(i="
> {
+ x<-1
+ }
> else
Error: unexpected 'else' in " else"
> {
+ x<-y
+ }
> y<-x*i
> y
[1] 25
> }
Error: unexpected '}' in "}"
Here is your code re-written with slightly clearer syntax
for (i in 1:5) {
if (i == 1) {
x <- 1
} else {
x <- y
}
y <- x * i
}
Or even better syntax.
for (i in 1:5) {
x <- ifelse(i == 1, 1, y)
y <- x * i
}
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
}
)
}
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
}