Bisection method returns "missing value where true false needed", can't replicate error - r

In my bisection algorithm, it says that there's a "missing value where true/false is needed", and it points to this line:
if (sign(f(c)) == sign(f(a)) ) {
a <- c
}
Why? There's nothing wrong with that line, and if I replicate it manually, it works just fine. Yet when I run the function, it produces
Error in if (sign(f(c)) == sign(f(a))) { :
missing value where TRUE/FALSE needed
EDIT: Full code is
Bisection <- function(f, a,b, tol = 0.005, maxiter = 1000) {
i <- 1
while (i < maxiter) {
c <- (a+b)/2
if (f(c) == 0 | (b-a)/2 < tol) { return(c)}
i <- i + 1
if (sign(f(c)) == sign(f(a)) ) {
a <- c
}
else {b <- c}}
return(NA)
}
Always, 0 and 100 are used as a and b.
I'm calling the function on different functions f, that are the same except for a different parameter, and it is only for one very particular parameter that the bisection function fails. For all other parameters, the bisection function works fine.

Generally, the missing value where TRUE/FALSE needed means R is encountering an NA value - in this case, I would expect an NA value in either a, c, or whatever f() returns for these values.
It could be that when you run these lines manually, the values stored in your global environment for a and c are just fine (non-missing), but whatever values are passed into your function (or computed within it) contains missing values. I'd recommend checking that.

Related

How to solve error in while looping EM algorithm in R

my project needs the EM algorithm below, where is all the code. The error is in the while loop, which is where the hope and maximization steps are. The error message is "Error in while (abs (Elogv [r] - Elogv [r - 1])> = 1e-06) {: missing value where TRUE / FALSE needed". How do I resolve this error if the while loop contains no true and false commands, and if I have already checked in detail that there are no errors in the commands and no NA's value? Grateful for the attention, who can save me.
n=100
u<-runif(n)
QUANTIL <- function(u){
Q <- rep(NA, length(u))
for (i in 1:length(u)) {
if(u[i] < 0.2634253829){
Q[i] <- 1*tan(pi*(0.9490353482*u[i]-0.5))+0
}
if(u[i]>=0.2634253829 && u[i] < 0.7365746171){
Q[i] <- 1*qnorm(1.4428629504*u[i]-0.2214315)+0
}
if(u[i]>0.7365746171){
Q[i] <- 1*tan(pi*(0.9490353482*u[i]-0.4490353))+0
}
}
return(Q)
}
x<-QUANTIL(u)
y<-c(sort(x))
i<-seq(1,n)
v<-c(i/(n+1))
t<-QUANTIL(v)
mi<-median(y)
s<-c(y[26:73])
sigma<-sqrt(sum((s-mi)^2)/(n-1))
p=0.4731492342
alpha<-(2*t^3)/(1+t^2)^2
beta<-(1-t^2)/(1+t^2)^2
eta<-(t^4-t^2)/(1+t^2)^2
lambda<-2*t/(1+t^2)^2
gama<-(-t^2)
delta<-2*t
k<-((p*0.6930665173/sigma*sqrt(2*pi))*exp((-1/2*sigma^2)*((y-mi)^2)))/(((p*0.6930665173/sigma*sqrt(2*pi))*exp((-1/2*sigma^2)*(y-mi)^2))+((((1-p)*1.0537015317/sigma*pi))*(1/(1+((y-mi)/sigma)^2))))
r<-2
Elogv<-sum(k*((-1/2)*((y-mi)/sigma)^2))-sum(k*log(sigma*sqrt(2*pi)))-sum((1-k)*log(sigma*pi))-sum((1-k)*log(1+((y-mi)/sigma)^2))+sum(k*log(p))+(n-sum(k))*log(1-p)+log(0.6930665173)*sum(k)+log(1.0537015317)*sum(1-k)
Elogv[1]<-0
while (abs(Elogv[r]-Elogv[r-1])>=0.000001) {
w<-(2*beta-2*k*beta+k)
q<-k*delta+2*lambda*(1-k)
sigma<-(sum(y*w)*sum(q)-sum(w)*sum(y*q))/(-2*sum(alpha*(1-k))*sum(q)+sum(w)*sum(k*gama-1)+2*sum(w)*sum(eta*(1-k)))
mi<-(sum(y*w)+2*sigma*sum(alpha*(1-k)))/sum(w)
k<-((p*0.6930665173/sigma*sqrt(2*pi))*exp((-1/2*sigma^2)*((y-mi)^2)))/(((p*0.6930665173/sigma*sqrt(2*pi))*exp((-1/2*sigma^2)*(y-mi)^2))+((((1-p)*1.0537015317/sigma*pi))*(1/(1+((y-mi)/sigma)^2))))
Elogv[r]<-sum(k*((-1/2)*((y-mi)/sigma)^2))-sum(k*log(sigma*sqrt(2*pi)))-sum((1-k)*log(sigma*pi))-sum((1-k)*log(1+((y-mi)/sigma)^2))+sum(k*log(p))+(n-sum(k))*log(1-p)+log(0.6930665173)*sum(k)+log(1.0537015317)*sum(1-k)
r<-r+1
It looks to me that the length of Elogv is 1? Thus Elogv[r] has no entry (r is 2!), i.e. evaluates to NA, thus the abs(Elogv[r]-Elogv[r-1]) is NA.
You need Elogv[2] <- 0 before starting the loop?

Pythagorean Theorem in R programming

I want write R code for Pythagoras theorem.
The Pythagorean Theorem states that the square of the hypotenuse (the side opposite the right angle) is equal to the sum of the squares of the other two sides.
(sideA)^2+(SideB)^2=hypotenuse^2
Now I wrote the R code as below:
pythag<-function(sidea,sideb){
if (sidea>=0&sideb>=0)
hypoteneuse=sqrt(sidea^2+sideb^2)
else if (sidea<0|sideb<0)
hypoteneuse<-"Values Need to be Positive"
else if (!is.vector(x))
hypoteneuse<-"I need numeric values to make this work"
print(hypoteneuse)
}
pythag(4,5)
pythag("A","B")
pythag(-4,-5)
In case of pythag(4,5) it is ok, also pythag(-4,-5) is giving comment "Values Need to be Positive".
But in case of pythag("A","B") I want comment "I need numeric values to make this work", but unfortunately my code does't work for this.
You can try like this:
get_hypotenuse_length <- function(height, base)
{
sides <- c(height, base)
if(any(sides < 0))
{
message("sides must be positive")
} else if(!is.numeric(x = sides))
{
message("sides can not be non-numeric")
} else
{
sqrt(x = sum(sides ^ 2))
}
}
Here's an annotated version. It is creating the function which takes the values a and b and calculates c. It is first testing if the values are numeric, if they are not numeric it will print your error message, otherwise it will ignore what is within those curly brackets and move on to the next test. The second test is checking that both are greater than zero (seeing as a triangle can't have a side of length zero or negative length). If it satifies the condition that both are >0 then it will calculate c, if not it will give the error stating that there are negative values.
# Feed it the values a and b (length of the two sides)
pythag <- function(a,b){
# Test that both are numeric - return error if either is not numeric
if(is.numeric(a) == FALSE | is.numeric(b) == FALSE){
return('I need numeric values to make this work')}
# Test that both are positive - return length of hypoteneuese if true...
if(a > 0 & b > 0){
return(sqrt((a^2)+(b^2)))
}else{
# ... give an error either is not positive
return('Values Need to be Positive')
}
}
Here's a more streamlined version:
pythag <- function(a,b){
if(is.numeric(a) == FALSE | is.numeric(b) == FALSE){return('I need numeric values to make this work')}
if(a > 0 & b > 0){return(sqrt((a^2)+(b^2)))}
else{return('Values Need to be Positive')}
}
And this is what it returns with your examples:
> pythag(4,5)
[1] 6.403124
> pythag("A","B")
[1] "I need numeric values to make this work"
> pythag(-4,-5)
[1] "Values Need to be Positive"
if x = c("sideA", "sideB"), then it will still be a vector so your test is.vector(x) will return true:
> is.vector(x)
[1] TRUE
But you want to test if it's numbers, so if it's numeric:
> is.numeric(x)
[1] FALSE

Difficulty with recursively adding non-whole number

I am new to R and I am having difficulty with a simple recursion function. I initialize a variable, x to .1 and then make a call to a recursive function in which if x is not equal to the user-input number, it will add .1 to x and recursively call the function again. If x is greater than the input number, the function returns an error message.
I have tried setting x to a whole number, mainly 1 and then trying to evaluate the function. This process works, so I figure that there is an issue of adding decimal numbers to each other and then evaluating their equality with a whole number.
u<-function(a)
{
#Initialize r
x<-.1
#Call to recursive method
v(a, x)
}
#Recursive function
v<-function(a, x)
{
#Check for current value of a and r
print(a)
print(x)
if(a==x) {
return("Yes")
}
else if(a < x) {
return("Error!")
}
else{
x<-x+.1
v(a, x)
}
}
When I set a to 1, I would expect the function to return "Yes" after recursing until x is equal to 1 as well. However, this is not the case. The function then recurses once more, setting x to 1.1 and returns the message "Error!".
I think you are running into issues with floating point precision. If you use a function designed to check equality while accounting for floating point precision, like dplyr::near(), the function gives the expected result:
v<-function(a, x)
{
#Check for current value of a and r
print(a)
print(x)
if(dplyr::near(a, x)) {
return("Yes")
}
else if(a < x) {
return("Error!")
}
else{
x<-x+.1
v(a, x)
}
}

Specify the calling function for an error message in R

I'm working on an R package where the same input-checking functions are called by multiple "actual" functions that are exported to users. If I use a simple stop() call, the error message is going to say that an error occurred in the input-checking function, which is not that useful...
I thought I'd get around this by wrapping the call to the input-checking function inside a tryCatch(), and then handling the error in the outer function. This does mostly what I want, but doesn't quite give the output that I'd like. The closest I've come is the following:
f <- function(i) {
tryCatch({
check_input(i)
}, error = function(e) stop("in f: ", e$message, call. = FALSE)
)
}
check_input <- function(i) {
if(i < 0)
stop("i is negative, value given was ", i)
}
f(-1)
# Error: in f: i is negative, value given was -1
Ideally, I'd like the error message to be
Error in f: i is negative, value given was -1
, which would be the case if stop were called within f() instead of check_input().
Here's how you can grab the name of the function from the call stack and paste it in to the error message
f <- function(i) {
check_input(i)
}
g <- function(i) {
check_input(i)
}
check_input <- function(i, from=deparse(sys.calls()[[sys.nframe()-1]][[1]])) {
getmsg <- function(m) ifelse(!is.null(from), paste0("in ", from, ": ", m), m)
if(i < 0)
stop(getmsg(paste0("i is negative, value given was ", i)), call. = FALSE)
}
f(-1)
# Error: in f: i is negative, value given was -1
g(-1)
# Error: in g: i is negative, value given was -1
You could also call check_input(i, from="otherfunction") to show whatever function name you want or check_input(i, from=NULL) to suppress the function name.

R function length error message

I made a function to to compute the sum of I(Xi
my.ecdf<- function(x,y) {
if(!is.null(dim(y)))
stop("y has more than one dimension")
n<-length(x)
i<-1:n
p<-if(x[i]<y) 1 else {
0
}
(sum(p))/n
}
But when I run it with input (rnorm(11),6), I get this error:
Warning message:
In if (x[i] < y) 1 else { :
the condition has length > 1 and only the first element will be used
Any ideas? I'm new to r so sorry if it's something obvious. (Also I don't want to use the for loop)
There are a number of issues in your code:
1) Whats the point of x[1:length(x)] in the if statement? Right now these are meaningless and can be dropped:
n<-length(x)
i<-1:n
x[i]
2) If statement accepts a logical argument not a vector of logical, you can consider adding all() any() etc like
if(all(x < y)) 1 else {0}
or use ifelse() statement for the assignment
3) Finally from what I can understand you overcomplicate things and the whole thing can be written as one-liner:
sum(x < y)/length(x)
This is a logical vector of the same length as y
is.null(dim(y))
You're using it as a logical test. An object with a length greater than 1 can't be unambiguously interpreted by the if statement. Consider if (TRUE FALSE FALSE TRUE) <do something>. When should you do that thing?
If you want to make sure y doesn't have more than one dimension, do
if(length(dim(y)) > 1){
stop("message")
}

Resources