【问题标题】:Exponential curve fitting in RR中的指数曲线拟合
【发布时间】:2015-10-29 09:01:21
【问题描述】:
time = 1:100  
head(y)  
0.07841589 0.07686316 0.07534116 0.07384931 0.07238699 0.07095363   
plot(time,y)  

这是一条指数曲线。

  1. 如何在不知道公式的情况下在这条曲线上拟合线?我不能使用“nls”,因为公式未知(仅给出数据点)。

  2. 我怎样才能得到这条曲线的方程并确定方程中的常数?
    我试过黄土,但它没有给出截距。

【问题讨论】:

  • 你能发帖y 吗?您需要假设一个模型,并且您说“这是一条指数曲线”。或者没有模型,您可以使用样条线。

标签: r curve-fitting


【解决方案1】:

您需要一个模型来适应数据。 在不知道模型的全部细节的情况下,假设这是一个 exponential growth model, 可以写成:y = a * e r*t

其中 y 是您的测量变量,t 是测量的时间, a 是当 t = 0r 是增长常数时 y 的值。 我们要估计 ar

这是一个非线性问题,因为我们要估计指数,r。 但是,在这种情况下,我们可以使用一些代数并将其转换为线性方程,方法是在两边取对数并求解(记住 logarithmic rules),导致: log(y) = log(a) + r * t

我们可以通过一个例子来可视化这一点,通过从我们的模型生成一条曲线,假设 ar 有一些值:

t <- 1:100      # these are your time points
a <- 10         # assume the size at t = 0 is 10
r <- 0.1        # assume a growth constant
y <- a*exp(r*t) # generate some y observations from our exponential model

# visualise
par(mfrow = c(1, 2))
plot(t, y)      # on the original scale
plot(t, log(y)) # taking the log(y)

因此,对于这种情况,我们可以探索两种可能性:

  • 将我们的非线性模型拟合到原始数据(例如使用nls() 函数)
  • 使我们的“线性化”模型适合对数转换的数据(例如使用 lm() 函数)

选择哪个选项(还有更多选项),取决于我们的想法 (或假设)是我们数据背后的数据生成过程。

让我们用一些包含添加噪声的模拟来说明(从 正态分布),以模拟真实数据。请看这个 StackExchange post 关于这个模拟背后的原因(Alejo Bernardin's comment 指出)。

set.seed(12) # for reproducible results

# errors constant across time - additive
y_add <- a*exp(r*t) + rnorm(length(t), sd = 5000) # or: rnorm(length(t), mean = a*exp(r*t), sd = 5000)

# errors grow as y grows - multiplicative (constant on the log-scale)
y_mult <- a*exp(r*t + rnorm(length(t), sd = 1))  # or: rlnorm(length(t), mean = log(a) + r*t, sd = 1)

# visualise
par(mfrow = c(1, 2))
plot(t, y_add, main = "additive error")
lines(t, a*exp(t*r), col = "red") 
plot(t, y_mult, main = "multiplicative error")
lines(t, a*exp(t*r), col = "red")

对于加法模型,我们可以使用nls(),因为误差是恒定的 t。使用nls() 时,我们需要为优化算法指定一些起始值(尝试“猜测”这些值,因为nls() 经常难以收敛到一个解决方案)。

add_nls <- nls(y_add ~ a*exp(r*t), 
               start = list(a = 0.5, r = 0.2))
coef(add_nls)

#           a           r 
# 11.30876845  0.09867135 

使用coef() 函数,我们可以获得两个参数的估计值。 这给了我们很好的估计,接近我们模拟的结果(a = 10 和 r = 0.1)。

通过绘制模型的残差,您可以看到误差方差在整个数据范围内相当恒定:

plot(t, resid(add_nls))
abline(h = 0, lty = 2)

对于乘法错误情况(我们的y_mult 模拟值),我们应该在对数转换的数据上使用lm(),因为 取而代之的是,该误差是恒定的。

mult_lm <- lm(log(y_mult) ~ t)
coef(mult_lm)

# (Intercept)           t 
#  2.39448488  0.09837215 

为了解释这个输出,再次记住我们的线性化模型是 log(y) = log(a) + r*t,它等价于 Y 形式的线性模型= β0 + β1 * X,其中 β0 是我们的截距,β1 是我们的斜率。

因此,在此输出中,(Intercept) 等价于我们模型的 log(a)t 是时间变量的系数,因此等价于我们的 r时间>。 为了有意义地解释 (Intercept),我们可以取它的指数 (exp(2.39448488)),得到 ~10.96,这与我们的模拟值非常接近。

值得注意的是,如果我们拟合误差为乘法的数据会发生什么 改用nls 函数:

mult_nls <- nls(y_mult ~ a*exp(r*t), start = list(a = 0.5, r = 0.2))
coef(mult_nls)

#            a            r 
# 281.06913343   0.06955642 

现在我们高估了 a 而低估了 r (Mario Reutter 在他的评论中强调了这一点)。我们可以想象使用错误的方法来拟合我们的模型的后果:

# get the model's coefficients
lm_coef <- coef(mult_lm)
nls_coef <- coef(mult_nls)

# make the plot
plot(t, y_mult)
lines(t, a*exp(r*t), col = "brown", lwd = 5)
lines(t, exp(lm_coef[1])*exp(lm_coef[2]*t), col = "dodgerblue", lwd = 2)
lines(t, nls_coef[1]*exp(nls_coef[2]*t), col = "orange2", lwd = 2)
legend("topleft", col = c("brown", "dodgerblue", "orange2"), 
       legend = c("known model", "nls fit", "lm fit"), lwd = 3)

我们可以看到lm() 与对数转换数据的拟合效果明显优于nls() 在原始数据上的拟合效果。

您可以再次绘制此模型的残差,以查看方差在数据范围内不是恒定的(我们也可以在上图中看到这一点,其中数据的散布随着 t):

plot(t, resid(mult_nls))
abline(h = 0, lty = 2)

【讨论】:

  • 如果有人想知道更多关于何时使用lm()nls(),这里有一个很好的讨论stats.stackexchange.com/questions/61747/…
  • 将线性模型拟合到对数值(使用lm)与拟合非线性模型(使用nls)产生不同的结果,因为不同的距离被最小化。对于对数线性模型,对数残差被最小化,从而产生远离较大剩余残差的偏差。因此,增长的开始将更容易被错误估计。
  • @wpkzz 是的,原来的答案是根本错误的。我现在完全重写了它,希望它是准确的。感谢您强调这个问题(5 年后回到它是相当谦卑的......)
【解决方案2】:

不幸的是,取对数并拟合线性模型并不是最优的。 原因是大 y 值的误差远大于那些 对于小的 y 值,当应用指数函数返回 原始模型。 这是一个例子:

f <- function(x){exp(0.3*x+5)}

squaredError <- function(a,b,x,y) {sum((exp(a*x+b)-f(x))^2)}

x <- 0:12
y <- f(x) * ( 1 + sample(-300:300,length(x),replace=TRUE)/10000 )
x
y   
#--------------------------------------------------------------------

M <- lm(log(y)~x)
a <- unlist(M[1])[2]
b <- unlist(M[1])[1]
print(c(a,b))

squaredError(a,b,x,y)

approxPartAbl_a <- (squaredError(a+1e-8,b,x,y) - squaredError(a,b,x,y))/1e-8

for ( i in 0:10 )
{
  eps <- -i*sign(approxPartAbl_a)*1e-5
  print(c(eps,squaredError(a+eps,b,x,y)))
}

结果:

> f <- function(x){exp(0.3*x+5)}

> squaredError <- function(a,b,x,y) {sum((exp(a*x+b)-f(x))^2)}

> x <- 0:12

> y <- f(x) * ( 1 + sample(-300:300,length(x),replace=TRUE)/10000 )

> x
 [1]  0  1  2  3  4  5  6  7  8  9 10 11 12

> y
 [1]  151.2182  203.4020  278.3769  366.8992  503.5895  682.4353  880.1597 1186.5158 1630.9129 2238.1607 3035.8076 4094.6925 5559.3036

> #--------------------------------------------------------------------
> 
> M <- lm(log(y)~x)

> a <- unlist(M[1])[2]

> b <- unlist(M[1])[1]

> print(c(a,b))
          coefficients.x coefficients.(Intercept) 
               0.2995808                5.0135529 

> squaredError(a,b,x,y)
[1] 5409.752

> approxPartAbl_a <- (squaredError(a+1e-8,b,x,y) - squaredError(a,b,x,y))/1e-8

> for ( i in 0:10 )
+ {
+   eps <- -i*sign(approxPartAbl_a)*1e-5
+   print(c(eps,squaredError(a+eps,b,x,y)))
+ }
[1]    0.000 5409.752
[1]   -0.00001 5282.91927
[1]   -0.00002 5157.68422
[1]   -0.00003 5034.04589
[1]   -0.00004 4912.00375
[1]   -0.00005 4791.55728
[1]   -0.00006 4672.70592
[1]   -0.00007 4555.44917
[1]   -0.00008 4439.78647
[1]   -0.00009 4325.71730
[1]   -0.0001 4213.2411
> 

也许可以尝试一些数值方法,即梯度搜索,来找到 平方误差函数的最小值。

【讨论】:

  • 图表会大大增强您的答案。
【解决方案3】:

如果它真的是指数的,您可以尝试取变量的对数并拟合线性模型。

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2016-02-13
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2018-11-13
    • 1970-01-01
    相关资源
    最近更新 更多