Square root of a vector using tryCatch statement - r

I want to write a function that returns the square root of vector x. I want it to have a tryCatch statement so that when x equals a negative number, it returns x as is and also issues a warning statement that x has negative numbers. The output should say NaN. So far I have this:
sqrt_x<-function(x){
if (x<0){
warning("x is negative")
}
Where do I put the tryCatch statement?
Another attempt at writing this function is here:
sqrt_x<- function(x){
tryCatch(
expr={
sqrt(any(x))
},
warning=function(w){
message("x is negative")
print(w)
}
)
}

Got it! Thank you all for your help
sqrt_x<-function(x){
result <-
tryCatch({
sqrt(x)},
warning = function(w) {
warning('x contains negative numbers')
x
})
return (result)
}

Related

If observe warning, skip iteration in for loop [R]

I have some loop that computes a value. Sometimes that computation triggers a warning. How do I check if the warning is triggered, then skip that iteration? I am using R.
With help from the comments, I found tryCatch() and was able to amend my for loop as the following and work:
for (i in seq(1,100,1)){
x<-sample(1:length(df$values), 1)
input<-copy_df[x:x+5,]
val<-tryCatch(myfunc(input$colA), warning=function(w) w)
if (is(val,warning){
next
}
print(paste0(i))
}
The output of val should be a column of length 5.
Here's a complete example using a test function that randomly generates a warning
set.seed(101)
foo <- function() {
x <- runif(1)
if(x<.9) warning("low x")
x
}
for(i in 1:20) {
didwarn <- tryCatch({x <- foo(); FALSE}, warning = function(w) return(TRUE))
if(didwarn) {
next
}
print(paste("high x", x))
}
You wrap any code that might trigger a warning in a try catch. Here we have each block return TRUE or FALSE depending on whether or not an error was thrown. An easier way to do this without the next would be
for(i in 1:20) {
tryCatch({
x <- foo();
print(paste("high x", x))
},
warning = function(w) {
# do nothing
})
}
When the warning occurs, nothing else in the tryCatch expression will run

Error code Missing value where TRUE/FALSE needed in R

I keep getting this error message when I run my code, and I'm not sure what I need to do to fix it.
My code is as follows:
gwmh<-function(target,N,x,sigmasq){
p<-add.var()
samples<-c(x,p)
for(i in 2:N){
prop<-rnorm(1,0,sqrt(sigmasq))
if(runif(1)<min(1,(target(x+abs(prop)*p))/target(x))){
x<-x+prop
samples<-rbind(samples,c(x,p))} else{
p<--p
samples<-rbind(samples,c(x,p))
}
}
samples[(1:N)] ##delete after testing
}
The error says:
Error in if (runif(1) < min(1, (target(x + abs(prop) * p))/target(x))) { :
missing value where TRUE/FALSE needed
(add.var is a function i created to generate p in {-1,1} randomly)
I tested my comment and feel more comfortable offering it as an answer.
Try the following
if(TRUE){print("Test")}
# prints "Test"
if(FALSE){print("Test")}
# prints nothing
if(NA){print("Test")}
# throws your error
So within this expression:
runif(1)<min(1,(target(x+abs(prop)*p))/target(x))
the result is neither TRUE or FALSE but NAand seeing as runif()should not throw any missings it has to be in the rhs of the comparison.
Assuming that target, x, and sigmasq are all values from a df and not functions there is probably a missing value there. If this is the case and also intended you have to add an exception for catching and handling these missings that might look like this:
# test being your test expression
if(
if(is.na(test) {Do Stuff for missing values}
else {original IF statement}
You need to add na.rm=TRUE to the min function to account for possible NA in x.
Your function will fail if x contains NA.
target <- function(x) dnorm(x, 0, 1)
add.var <- function() runif(1, -1, 1)
gwmh <- function(target,N,x,sigmasq){
p <- add.var()
samples<-c(x,p)
for(i in 2:N){
prop<-rnorm(1,0,sqrt(sigmasq))
if(runif(1) < min(1, (target(x+abs(prop)*p))/target(x), na.rm=TRUE)){ # <- Here
x<-x+prop
samples<-rbind(samples,c(x,p))} else{
p<--p
samples<-rbind(samples,c(x,p))
}
}
samples[(1:N)] ##delete after testing
}
Now try:
gwmh(target, N=2, x=c(1,2,NA,3), sigmasq=2)
# [1] 1.00 3.14

if...else statement runs both parts of the code

I need my code to check a vector to see if any of the values are negative and return an error if one or more are. If none are negative, I need it to find the geometric mean of the values. The problem is when there are negative values my code is giving both the error message and the geometric mean, which I don't want to have happen.
gm=function(x){
n=length(x)
for(i in 1:n){
if(x[i]<0){
cat("ERROR: x value is negative")
break
}else{
y=prod(x)^(1/n)
}
}
y
}
gm(x)
You should avoid looping through a vector and checking a condition. Instead, you could use any to check if the condition holds for any of the elements of the vector:
gm <- function(x) {
if (any(x < 0)) {
stop("x contains a negative element")
} else {
prod(x)^(1/length(x))
}
}
You can see it in action:
gm(c(4, 16))
# [1] 8
gm(c(-4, 16))
# Error in gm(c(-4, 16)) : x contains a negative element

Why would this 'sapply' function in R return an invalid response given my function?

CountNew <- function(x){
if (x==0) y <- 1
return(y)
}
allCF$NewECount >- sapply(allCF$Count, CountNew)
Using the above code, if a value in EquipCount in allCF is currently equal to 0, I want to change it to 1 while keeping the other values the same, then maintain the values of the rest of the values not equal to 0. I made sure these were numbers (not factors) through the str(rawCF) command
But then I get the following error:
Error in FUN(X[[i]], ...) : object 'y' not found
What is causing this problem?
The code logic is wrong.
What if the element does not satisfy x==0? The function will return a y which is not defined. Add one line will solve it:
Solution 1
allCF <- data.frame(Count=c(0,0,-1))
CountNew <- function(x){
y=x
if (x==0) y = 1
return(y);
}
allCF$NewECount <- sapply(allCF$Count, CountNew)
Solution 2: Vectorize your CountNew function
allCF <- data.frame(Count=c(0,0,-1))
CountNew <- Vectorize(function(x){
if (x==0) return(1);
return(x);
}
)
allCF$NewECount <- sapply(allCF$Count, CountNew)
Now you may do CountNew(allCF$Count) directly.

R - How to end function and return NA?

Sorry this seems like a very easy question but I can't figure it out.
I have this small piece of code in the middle of my function:
if(num > length(unique_state)) stop(NA,call. = F)
What I want is if the result of the IF STATEMENT is TRUE, then just stop the function and rerun NA to the user. However, with the above code I also get a message:
Error: NA
How do I end a function and return NA?
have you tried return()?
f=function(x) {
for(i in 1:100){
x=x+i
##interesting part here
if(x>44) return(NA)
}
x }

Resources