多项式近似的比率

Question

我正在尝试将多项式拟合到我的数据集中，看起来像那样（完整数据集位于帖子的末尾）：

该理论预测曲线的表述为：

看起来像这样（对于x在0和1之间）：

当我尝试通过执行以下操作在R中创建线性模型时：

mod <- lm(y ~ poly(x, 2, raw=TRUE)/poly(x, 2))

我得到以下曲线：

这与我的期望大不相同。您是否知道如何根据这些数据拟合一条新曲线，以便它与理论预测的曲线类似？此外，它应该只有一个最小值。

完整数据集：

x值向量：

x <- c(0.02, 0.03, 0.04, 0.05, 0.06, 0.07, 0.08, 0.09, 0.10, 0.11, 0.12,
 0.13, 0.14, 0.15, 0.16, 0.17, 0.18, 0.19, 0.20, 0.21, 0.22, 0.23, 0.24, 0.25,
 0.26, 0.27, 0.28, 0.29, 0.30, 0.31, 0.32, 0.33, 0.34, 0.35, 0.36, 0.37, 0.38,
 0.39, 0.40, 0.41, 0.42, 0.43, 0.44, 0.45, 0.46, 0.47, 0.48, 0.49, 0.50, 0.51,
 0.52, 0.53, 0.54, 0.55, 0.56, 0.57, 0.58, 0.59, 0.60, 0.61, 0.62, 0.63, 0.64,
 0.65, 0.66, 0.67, 0.68, 0.69, 0.70, 0.71, 0.72, 0.73, 0.74, 0.75, 0.76, 0.77,
 0.78, 0.79, 0.80, 0.81, 0.82, 0.83, 0.84, 0.85, 0.86, 0.87, 0.88, 0.89, 0.90,
 0.91, 0.92, 0.93, 0.94, 0.95)

y值的向量：

y <- c(4.104,  4.444,  4.432,  4.334,  4.285,  4.058,  3.901,  4.382,
  4.258,  4.158,  3.688,  3.826,  3.724,  3.867,  3.811,  3.550,  3.736, 3.591,
  3.566,  3.566,  3.518,  3.581,  3.505,  3.454,  3.529,  3.444,  3.501,  3.493,
  3.362,  3.504,  3.365,  3.348,  3.371,  3.389,  3.506,  3.310,  3.578,  3.497,
  3.302,  3.530,  3.593,  3.630,  3.420,  3.467,  3.656,  3.644,  3.715,  3.698,
  3.807,  3.836,  3.826,  4.017,  3.942,  4.208,  3.959,  3.856,  4.157,  4.312,
  4.349,  4.286,  4.483,  4.599,  4.395,  4.811,  4.887,  4.885,  5.286,  5.422,
  5.527,  5.467,  5.749,  5.980,  6.242,  6.314,  6.587,  6.790,  7.183,  7.450,
  7.487,  8.566,  7.946,  9.078,  9.308, 10.267, 10.738, 11.922, 12.178, 13.243,
  15.627, 16.308, 19.246, 22.022, 25.223, 29.752)

Answer 1

使用nls拟合非线性模型。请注意，模型公式未在问题中显示唯一定义，因为如果我们将所有系数乘以任意数字，结果仍将给出相同的预测。为避免这种情况，我们需要修复一个系数。第一次尝试使用问题中显示的系数作为起始值（除了固定一个）但是失败了，因此尝试丢弃C并且将得到的系数与C = 1进行第二次拟合。

 st <- list(a = 43, b = -14, c = 25, B = 18)
 fm <- nls(y ~ (a + b * x + c * x^2) / (9 + B * x), start = st)
 fm2 <- nls(y ~ (a + b * x + c * x^2) / (9 + B * x + C * x^2), start = c(coef(fm), C = 1))

 plot(y ~ x)
 lines(fitted(fm2) ~ x, col = "red")

（图表后继续）

注意：以下是使用nls2通过随机搜索获取起始值的示例。我们假设每个系数介于-50和50之间。

library(nls2)

set.seed(123) # for reproducibility
v <- c(a = 50, b = 50, c = 50, B = 50, C = 50)
st0 <- as.data.frame(rbind(-v, v))
fm0 <- nls2(y ~ (a + b * x + c * x^2) / (9 + B * x + C * x^2), start = st0,
   alg = "random", control = list(maxiter = 1000))

fm3 <- nls(y ~ (a + b * x + c * x^2) / (9 + B * x + C * x^2), st = coef(fm0))

Answer 2

既然您已经有了理论预测，那么您似乎不需要新模型，而且它实际上只是一个绘图任务：

 png(); plot(y~x)
 lines(x,mod,col="blue")
 dev.off()

您不能指望lm能够很好地逼近非线性问题。在该理论表达式中涉及x的分母使其具有固有的非线性。