Question

我对插值函数的一般根查找问题感兴趣。

假设我有以下(x, y)数据：

set.seed(0)
x <- 1:10 + runif(10, -0.1, 0.1)
y <- rnorm(10, 3, 1)

以及线性插值和三次样条插值：

f1 <- approxfun(x, y)
f3 <- splinefun(x, y, method = "fmm")

如何找到这些插值函数与水平线x交叉的y = y0值？以下是带有y0 = 2.85的图形显示。

par(mfrow = c(1, 2))
curve(f1, from = x[1], to = x[10]); abline(h = 2.85, lty = 2)
curve(f3, from = x[1], to = x[10]); abline(h = 2.85, lty = 2)

我知道有关该主题的一些先前主题，例如

建议我们简单地反转x和y，对(y, x)进行插值，然后计算在y = y0处的插值。

但是，这是个虚假的想法。假设y = f(x)是(x, y)的插值函数，则此想法仅在f(x)是x的单调函数时有效，因此f是可逆的。否则x不是y的函数，并且对(y, x)进行插值是没有意义的。

用我的示例数据进行线性插值，这个假的想法给出了

fake_root <- approx(y, x, 2.85)[[2]]
# [1] 6.565559

首先，根数不正确。我们从图中看到了两个根（在左侧），但是代码仅返回一个。其次，它不是正确的根，

f1(fake_root)
#[1] 2.906103

不是2.85。

我已经在How to estimate x value from y value input after approxfun() in R上首次尝试了这个一般性问题。该解决方案对于线性插值来说是稳定的，但对于非线性插值来说不一定是稳定的。我现在正在寻找一种稳定的解决方案，特别是对于三次插值样条曲线。

解决方案在实际中如何有用？

有时在单变量线性回归y ~ x或单变量非线性回归y ~ f(x)之后，我们需要对x进行反求解目标y。此问答示例是一个示例，并吸引了许多答案：Solve best fit polynomial and plot drop-down lines，但没有一个是真正的自适应性或易于在实践中使用。

使用polyroot接受的答案仅适用于简单的多项式回归；
将二次公式用于解析解的答案仅适用于二次多项式；
我使用predict和uniroot进行的回答通常可以使用，但并不方便，因为实际上使用uniroot需要与用户进行互动（有关{的更多信息，请参见Uniroot solution in R {1}}。

如果有一个自适应且易于使用的解决方案，那将是非常好的。

Answer 1

首先，让我复制my previous answer中提出的线性插值的稳定解。

## given (x, y) data, find x where the linear interpolation crosses y = y0
## the default value y0 = 0 implies root finding
## since linear interpolation is just a linear spline interpolation
## the function is named RootSpline1
RootSpline1 <- function (x, y, y0 = 0, verbose = TRUE) {
  if (is.unsorted(x)) {
     ind <- order(x)
     x <- x[ind]; y <- y[ind]
     }
  z <- y - y0
  ## which piecewise linear segment crosses zero?
  k <- which(z[-1] * z[-length(z)] <= 0)
  ## analytical root finding
  xr <- x[k] - z[k] * (x[k + 1] - x[k]) / (z[k + 1] - z[k])
  ## make a plot?
  if (verbose) {
    plot(x, y, "l"); abline(h = y0, lty = 2)
    points(xr, rep.int(y0, length(xr)))
    }
  ## return roots
  xr
  }

对于stats::splinefun使用方法"fmm"，"natrual"，"periodic"和"hyman"返回的三次插值样条线，以下函数提供了稳定的数值解。 / p>

RootSpline3 <- function (f, y0 = 0, verbose = TRUE) {
  ## extract piecewise construction info
  info <- environment(f)$z
  n_pieces <- info$n - 1L
  x <- info$x; y <- info$y
  b <- info$b; c <- info$c; d <- info$d
  ## list of roots on each piece
  xr <- vector("list", n_pieces)
  ## loop through pieces
  i <- 1L
  while (i <= n_pieces) {
    ## complex roots
    croots <- polyroot(c(y[i] - y0, b[i], c[i], d[i]))
    ## real roots (be careful when testing 0 for floating point numbers)
    rroots <- Re(croots)[round(Im(croots), 10) == 0]
    ## the parametrization is for (x - x[i]), so need to shift the roots
    rroots <- rroots + x[i]
    ## real roots in (x[i], x[i + 1])
    xr[[i]] <- rroots[(rroots >= x[i]) & (rroots <= x[i + 1])]
    ## next piece
    i <- i + 1L
    }
  ## collapse list to atomic vector
  xr <- unlist(xr)
  ## make a plot?
  if (verbose) {
    curve(f, from = x[1], to = x[n_pieces + 1], xlab = "x", ylab = "f(x)")
    abline(h = y0, lty = 2)
    points(xr, rep.int(y0, length(xr)))
    }
  ## return roots
  xr
  }

它分段使用polyroot，首先在 complex 字段中找到所有根，然后在分段间隔中仅保留 real 个根。这是有效的，因为三次插值样条曲线只是许多分段三次多项式。我在How to save and load spline interpolation functions in R?的答案已经说明了如何获取分段多项式系数，因此使用polyroot很简单。

使用问题中的示例数据，RootSpline1和RootSpline3都可以正确识别所有根。

par(mfrow = c(1, 2))
RootSpline1(x, y, 2.85)
#[1] 3.495375 6.606465
RootSpline3(f3, 2.85)
#[1] 3.924512 6.435812 9.207171 9.886640

Answer 2

鉴于上述数据点和样条函数，只需从 pracma 包中应用findzeros()。

library(pracma)
xs <- findzeros(function(x) f3(x) - 2.85,min(x), max(x))

xs  # [1] 3.924513 6.435812 9.207169 9.886618
points(xs, f3(xs))

在给定y值的情况下获得x值：线性/非线性插值函数的一般根查找

解决方案在实际中如何有用？

2 个答案: