R中的二等分法

Question

I am trying to solve an equation using Bisection method. However, when I try to run this, I get the below error

"Error in if ((fn(kVec, tVec, b) * fn(kVec, tVec, a) > 0) | (b > a)) { : 
  argument is of length zero"

Bisection method routine

bisect<-function(kVec,tVec,fn,b,a,tol=1e-15){
  i<-0
  r<-(b+a)/2
  res<-c(i,r,fn(kVec,tVec,r))
  if ((fn(kVec,tVec,b)*fn(kVec,tVec,a)>0)|(b>a)) {
    return('Improper start values') }
  else
    while (abs(fn(kVec,tVec,r))>tol) {
      i<-i+1
      if (fn(kVec,tVec,b)*fn(kVec,tVec,r)>0) {
        b<-r
        r<-(b+a)/2 
      }
      else {
        a<-r
        r<-(b+a)/2 
      }
      res<-rbind(res,c(i,r,fn(kVec, tVec,r)))  
  }
return(res)
}

Function to define the equation

FCfunc<-function(kVec,tVec,b){
for(i in 1:k){
    ((kVec[i]*(tVec[i]*exp(-tVec[i])-tVec[i-1]*exp(-b*tVec[i-1])))
    }
}

Calling bisection routine with some initial estimates

bisect(kVec,tVec,FCfunc,0.00001,10.00001,tol=10e-16) 

Answer 1

Bisection Method

    rm(list=ls())
    x0<-0
    x1<-1
    e<-0.001 #Error of tolerance
    fun<-function(x)(x^3-9*(x^2)+18*x-6) # An example function
    y0<-fun(x0);y0
    y1<-fun(x1);y1
    x2<-x1
    i<-1
    if(sign(y0)==sign(y1)){

        print("Starting vaules are not suitable")
    }else
    {
        while(fun(x2)!=0){
            x2<-(x0+x1)/2

            y2<-fun(x2)

            if(sign(y1)==sign(y2)){x1<-x2}else{x0<-x2}
                y0<-fun(x0)
                y1<-fun(x1)
                cat(i,x2,"\n") #Print the value obtained in each iteration next line 
                i<-i+1
            }
        }

The above while loop stop for that value of x2 for which the function becomes exactly equal to zero, now if you want to allow error at want the answer at the shortest iteration you can replace the condition while(abs(fun(x2))>0.001) and run the entire program. where 0.001 indicates the margin of error allowed.

Answer 2

#bisection method
a<--give trial value-;a
b<--give trial value;b
f<-function(x){-give function-}
f(a)
f(b)
c<-(a+b)/2;c
while(f(c)!=0&&b-a>.00002)
{
    if(f(c)==0)
    {
        c
    }
    if(f(c)<0)
    {
        a<-c
    }
    else
    {
        b=c
    }
    {
        c<-(a+b)/2;c
    }
}
c

Answer 3

Perhaps you will find my bisection method code in R useful

f.acc <- function(x){
1+1/x-log(x)
}
f.acc(0.5)
f.acc(6)
# since f.acc is continuous, it must have a root between 0.5 and 6.
x.left <- 0.5
x.right <- 6
iter <- 1
tol <- 1e-6
max.iter <- 100
while ((abs(x.right-x.left) > tol) && (iter < max.iter)) {
x.mid <- (x.left+x.right)/2
if (f.acc(x.mid)*f.acc(x.right)<0) {
x.left <- x.mid
} else {
x.right <- x.mid
}
iter <- iter + 1
cat("At iteration", iter, "value of x.mid is:", x.mid, "\n")
}

cat("At iteration", iter, "value of x.mid is:", x.mid, "and the function value is",
f.acc(x.mid),"\n")

x.n.minus.1 <- 0.5
x.n <- 6
iter <- 1
while ((abs(x.n-x.n.minus.1) > tol) && (iter < max.iter)) {
x.n.plus.1 <- x.n - f.acc(x.n)*(x.n-x.n.minus.1)/(f.acc(x.n)-f.acc(x.n.minus.1))
x.n.minus.1 <- x.n
x.n <- x.n.plus.1
iter <- iter + 1
cat("At iteration", iter, "value of x.n is:", x.n, "\n")
}

cat("At iteration", iter, "value of x is:", x.n, "and the function value is",
f.acc(x.n),"\n")