在R中找到两个根之间的距离

Question

Suppose I have a function f(x) that is well defined on an interval I. I want to find the greatest and smallest roots of f(x), then taking the difference of them. What is a good way to program it?

To be precise, f can at worst be a rational function like (1+x)/(1-x). It should be a (high degree) polynomial most of the times. I only need to know the result numerically to some precision.

I am thinking about the following:

1. Convert f(x) into a form recognizable by R. (I can do)

2. Use R to list all roots of f(x) on I (I found the uniroot function only give me one root)

3. Use R to to find the maximum and minimum elements in the list (should be possible once I converted it to a vector)

4. Taking the difference of the two roots. (should be trivial)

I am stuck on step (2) and I do not know what to do. My professor give a brutal force solution, suggesting me to do:

1. Divide interval I into one million pieces.

2. Evaluate f on each end points, find the end points where f>=0.

3. Choose the maximum and minimum elements from the set formed in step 2.

4. Take the difference between them.

I feel this way is not very efficient and might not work for all f in general, but I am having trouble to implement it even for quadratics. I do not know how to do step (2) as well. So I want to ask for a hint or some toy examples.

---

At this point I am trying to implement the following code:

Y=rep(0,200)
dim(Y)=c(100,2)
for(i in 1:100){
X=rnorm(9,0,1)
Z=rnorm(16,0,1)
a=0.64
b=a*sum(Z^2)/sum(X^2)
root_intervals <- function(f, interval, n = 1e6) {
    xvals <- seq(interval[1], interval[2], length = n)
    yvals <- f(xvals)
    ypos <- yvals > 0
    x1 <- which(tail(ypos, -1) != head(ypos, -1))
    x2 <- x1 + 1
    ## so all the zeroes we can see are between x1 and x2
    return(cbind(xvals[x1], xvals[x2]))
}

at here everything is okay, but when I try to extract the roots to Y[i,1], Y[i,2] by

Y[i,1]=(ri<-root intervals(function(x)(x/(a*x+b))^{9/2}*(1/((1-a)+a*(1-a)/b*x))^4-0.235505, c(0,40),n=1e6)[1]

I found I cannot evaluate it anymore. R keep telling me

Error: unexpected symbol in:
"}
Y[i,1]=(ri<-root intervals"

and I got stuck. I really appreciate everyone's help as I am feeling lost.

I checked the function's expression many times using the plot function and it has no grammar mistakes. Also I believe it is well defined for all X in the interval.

Answer 1

This should give you a good start on the brute force solution. You're right, it's not elegant, but for relatively simple univariate functions, evaluating 1 million points is trivial.

root_intervals <- function(f, interval, n = 1e6) {
    xvals <- seq(interval[1], interval[2], length = n)
    yvals <- f(xvals)
    ypos <- yvals > 0
    x1 <- which(ypos[-1] != head(ypos, -1))
    x2 <- x1 + 1
    ## so all the zeroes we can see are between x1 and x2
    return(cbind(xvals[x1], xvals[x2]))
}

This function returns a two column matrix of x values, where the function changes sign between column 1 and column 2:

f1 <- function (x) 0.05 * x^5 - 2 * x^4 + x^3 - x^2 + 1

> (ri <- root_intervals(f1, c(-10, 10), n = 1e6))
           [,1]       [,2]
[1,] -0.6372706 -0.6372506
[2,]  0.8182708  0.8182908

> f1(ri)
              [,1]          [,2]
[1,] -3.045326e-05  6.163467e-05
[2,]  2.218895e-05 -5.579081e-05

Wolfram Alpha confirms results on the specified interval.

The top and bottom rows will be the min and max intervals found. These intervals (over which the function changes sign) are precisely what uniroot wants for it's interval , so you could use it to solve for the (more) exact roots. Of course, if the function changes sign twice within one interval (or any even number of times), it won't be picked up, so choose a big n !

Response to edited question:

Looks like your trying to define a bunch of functions, but your edits have syntax errors. Here's what I think you're trying to do: (this first part might take some more work to work right)

my_funs <- list()
Y=rep(0,200)
dim(Y)=c(100,2)
for(i in 1:100){
  X=rnorm(9,0,1)
  Z=rnorm(16,0,1)
  a=0.64
  b=a*sum(Z^2)/sum(X^2)
  my_funs[[i]] <- function(x){(x/(a*x+b))^{9/2}*(1/((1-a)+a*(1-a)/b*x))^4-0.235505}
}

Here's using the root_intervals on the first of your generated functions.

> root_intervals(my_funs[[1]], interval = c(0, 40))
           [,1]       [,2]
[1,]  0.8581609  0.8582009
[2,] 11.4401314 11.4401714

Notice the output, a matrix , with the roots of the function being between the first and second columns. Being a matrix, you can't assign it to a vector. If you want a single root, use uniroot using each row to set the upper and lower bounds. This is left as an exercise to the reader.