在R中找到兩個根之間的距離

Question

假設我有一個在間隔I上定義好的函數f（x）。我想找到f（x）的最大和最小根，然后取它們的差。 有什么好的編程方法？

確切地說，f在最壞的情況下可能是一個有理函數，如（1 + x）/（1-x）。 大多數時候，它應該是（高次）多項式。 我只需要在某種程度上精確地知道結果。

我在考慮以下方面：

1. 將f（x）轉換為R可以識別的形式。（我可以）

2. 使用R列出I上f（x）的所有根（我發現uniroot函數僅給我一個根）

3. 使用R查找列表中的最大和最小元素（將其轉換為向量后應該可以）

4. 取二根之差。 （應該是微不足道的）

我被困在步驟（2）上，我不知道該怎么辦。 我的教授給出了一種殘酷的解決方案，建議我這樣做：

1. 將間隔I分為一百萬個。

2. 在每個端點上評估f，找到f> = 0的端點。

3. 從步驟2中形成的集合中選擇最大和最小元素。

4. 拿他們之間的區別。

我覺得這種方法效率不高，一般來說可能不適用於所有f，但是即使對於二次運算，我也難以實現。 我也不知道如何執行步驟（2）。 所以我想問一個提示或一些玩具的例子。

---

此時，我正在嘗試實現以下代碼：

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]))
}

在這里一切正常，但是當我嘗試通過以下方式將根提取到Y [i，1]，Y [i，2]時：

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]

我發現我無法對其進行評估。 R不斷告訴我

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

我被卡住了。 當我感到迷茫時，我非常感謝大家的幫助。

我使用plot函數多次檢查了函數的表達式，並且沒有語法錯誤。 我也相信間隔中所有X的定義都很好。

Answer 1

這應該為您提供蠻力解決方案的良好開端。 沒錯，這並不優雅，但是對於相對簡單的單變量函數而言，評估一百萬點是微不足道的。

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]))
}

此函數返回x值的兩列矩陣，其中該函數在第1列和第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按指定的時間間隔確認結果。

頂部和底部將是找到的最小和最大間隔。 這些間隔（函數改變符號的interval ）正是uniroot想要的interval ，因此您可以使用它來求解（更多）確切的根。 當然，如果函數在一個時間間隔（或任何偶數次）內兩次更改符號，它將不會被拾取，因此請選擇大n ！

對已編輯問題的答復：

看起來您試圖定義一堆函數，但是您的編輯存在語法錯誤。 這是我認為您要嘗試執行的操作：（第一部分可能需要更多工作才能正常工作）

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}
}

這是在您生成的第一個函數上使用root_intervals。

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

注意輸出矩陣 ，函數的根在第一和第二列之間。 作為矩陣，您不能將其分配給向量。 如果要使用單個根， uniroot每行中使用uniroot設置上限和下限。 這留給讀者練習。