R中具有任意数量的拟合参数的非线性最小二乘

Question

我想拟合一个模型，该模型包括可变系数个数之和，例如这里

模型

我想编写代码，以便潜在的用户可以在运行拟合例程时指定系数的数量（即，将i设置为任何正整数值），但是我什至不知道如何开始对此进行编码。 当然，我可以简单地写出大量潜在变量的结果方程式（例如1 <i <10 ），并在开始时切换到指定的方程式，但是我更喜欢“更漂亮”的解决方案（即更少行）（如果R中完全可用）。我目前正在使用nls ，但是我当然会对任何解决方案感到满意。

到目前为止，这是我尝试过的方法：

Model <- function(X0, t, X, tau){X0+((X*tau*(exp(1/tau)-1))*exp(-t/tau))}

set.seed(1)
df <- data.frame(t=sort(sample(1:100,50)))
df$P <- jitter(with(df, Model(X0=0.1, t=t, X=0.2, tau=5)), 1000)

Model_fit <- nls(P ~ Model(X0=0.1, t=t, X=X1_fit, tau=5)
                  , start = list(X1_fit=c(0.1)), data=df, trace = F)

plot(df$t,df$P)
lines(df$t, predict(Model_fit, list(P = df$P)))

效果很好。 只需将向量传递给X1_fit ，即可轻松拟合多个系数。 但是，我现在正在努力的是如何在公式中正确地计算总和。 我不能只用

X=c(0.2,5)
Model <- function(X0, t, X, tau){X0+sum((X*tau*(exp(1/tau)-1))*exp(-t/tau))}

因为这当然会返回单个值，即对t的依赖关系会丢失。 取而代之的是，该代码仅需要为每个t单独值取和，以便该函数仍返回长度为t的向量。 但是，我正在努力弄清楚如何在不恢复循环的情况下执行此操作，这可能也很难通过nls来适应？

干杯!

编辑

@G。 Grothendieck的答案很好用，但是我意识到拟合过程对方程中的微小修改非常敏感，尤其是当需要拟合多个常数时。 例如

set.seed(1)
Model <- function(X0, t, X, tau) {
  res <- X0 + rowSums(sapply(seq_along(X), function(i) 
(X[i]*tau[i]/5*(exp(5/tau[i])-1))*exp(-t/tau[i])))}

df <- data.frame(t=sort(sample(1:100,50)))
df$P <- jitter(with(df, Model(X0=0.1, t=t, X=c(0.2, 2), tau=c(4, 7))),     1000)

Model_fit <- nls(P ~ Model(X0=0.1, t=t, X=X1_fit, tau=tau_fit)
             , start = list(X1_fit=c(0.1, 1), tau_fit=5:6), data=df)

不运行

Error in nls(P ~ Model(X0 = 0.1, t = t, X = X1_fit, tau = tau_fit), start = list(X1_fit = c(0.1,  : 
  step factor 0.000488281 reduced below 'minFactor' of 0.000976562

（即使在减小步长和增加迭代次数的情况下，我在两个位置都添加了常数5 ，现在也尝试拟合tau ）。 原则上，我理解拟合4个系数很容易变得不稳定，但是我在Matlab中拥有的替代代码似乎可以很好地处理（就此而言，甚至可以拟合更多的系数）。 也许在一个单独的问题中会更好，但是由于该线程指的是“任意数量的拟合参数”，我认为此后续操作最好作为编辑来完成。

Answer 1

sapply对i创建2D矩阵和使用rowSums执行求和：

set.seed(1)
Model <- function(X0, t, X, tau) {
  res <- X0 + rowSums(sapply(seq_along(X), function(i) 
     (X[i]*tau[i]*(exp(1/tau[i])-1))*exp(-t/tau[i])))
}

df <- data.frame(t=sort(sample(1:100,50)))
df$P <- jitter(with(df, Model(X0=0.1, t=t, X=c(0.2, 2), tau=c(4, 7))), 1000)



Model_fit <- nls(P ~ Model(X0=0.1, t=t, X=X1_fit, tau=5:6)
                  , start = list(X1_fit=c(0.1, 1)), data=df, trace = F)

plot(df)
lines(fitted(Model_fit) ~ t, df, col = "red")

给予：

> Model_fit
Nonlinear regression model
  model: P ~ Model(X0 = 0.1, t = t, X = X1_fit, tau = 5:6)
   data: df
X1_fit1 X1_fit2 
 0.2107  2.0849 
 residual sum-of-squares: 0.5175

Number of iterations to convergence: 1 
Achieved convergence tolerance: 1.511e-07