使用 nlsLM 在函数内使用 combn 进行非线性回归

Question

给定的是几行数据框DATA：

> dput(DATA[c(1,7,20,25,26,53,89),])
structure(list(Lanes = c(3, 3, 3, 3, 3, 3, 3), N_b = c(5, 5, 
5, 5, 5, 5, 5), A = c(-12, -12, -15, -9, -9, -15, -9), x.sqr = 
c(1440, 1440, 2250, 810, 810, 2250, 810), e_1 = c(21.8, 21.8, 
29, 14.6, 14.6, 29, 14.6), e_2 = c(9.8, 9.8, 17, 2.6, 2.6, 17, 
2.6), e_3 = c(-2.2, -2.2, 5, -9.4, -9.4, 5, -9.4), e_4 = 
c(-14.2, -14.2, -7, 0, 0, -7, 0), e_5 = c(0, 0, -19, 0, 0, -19, 0), 
S = c(12, 12, 15, 9, 9, 15, 9), CSi = c(0.59189685884369, 
0.574916237257971, 0.644253184434141, 0.474070747691647, 
0.492033722080107, 0.644904371480046, 0.49900365977452), 
m = c(0.85, 0.85, 0.85, 0.85, 0.85, 0.85, 0.85)), row.names = c(1L, 
7L, 20L, 25L, 26L, 53L, 89L), class = "data.frame")

我用nlsLM写了下面的函数用于非线性回归：

library(minpack.lm)

Prposed <- function(N_b,Lanes,m,A,x.sqr,e_1,e_2,e_3,e_4,e_5,S,a) {
  e <- data.frame(e_1,e_2,e_3,e_4,e_5)
  CSi <- m * ((Lanes/N_b) + (A * combn(e,Lanes,sum) / x.sqr) * (b*S^a))
  return(CSi)
}

nlsLM <- nlsLM(CSi ~ Prposed(N_b,Lanes,m,A,x.sqr,e_1,e_2,e_3,e_4,e_5,S,a,b), 
             data = DATA, 
             start = c(a = 0.01, b = 0.01))

summary(nlsLM)

我不断收到一个错误，它来自我使用 combn 函数定义列 e_1, e_2, etc.. 的方式。

更新

我发现了另一个问题：Error when running nlsLM but works for nls 它在原始函数中使用了一个 for 循环，这似乎与 library(nls2) 中的 nls2 函数配合得很好。我想知道是否可以通过转到 for 循环来完全摆脱 combn 术语。

Answer 1

这不是一个实际的答案，因为它在修复 combn 错误后会生成一个新错误，但这可能会给你一些方向。

我认为您正在尝试为DATA 中的每一行运行nlsLM 函数。您需要在 Prposed 函数中分别传递每一行。另请注意，函数中需要a 和b 才能执行计算，因此它们需要作为函数的参数传递，我认为在nlsLM 中使用start 传递它们是行不通的。

所以把你的函数改成：

library(minpack.lm)

Prposed <- function(N_b,Lanes,m,A,x.sqr,e_1,e_2,e_3,e_4,e_5,S,a, b) {
  e <- data.frame(e_1,e_2,e_3,e_4,e_5)
  CSi <- m * ((Lanes/N_b) + (A * combn(e,Lanes,sum) / x.sqr) * (b*S^a))
  return(CSi)
}

现在让我们为DATA 的第一行运行这个：

x <- DATA[1, ]
Prposed(x[[2]], x[[1]], x[[12]], x[[3]], x[[4]], x[[5]], x[[6]], x[[7]], x[[8]],
        x[[9]],x[[10]],a = 0.01, b = 0.01)

#[1] 0.5078651 0.5087365 0.5077053 0.5096079 0.5085767 0.5094481 0.5104793 
#    0.5094481 0.5103195 0.5111909

我不知道理论，所以我不知道这些数字是否有意义/正确。但是，当您将其插入 nlsLM 函数时，它会报错。

nlsLM(CSi~Prposed(x[[2]],x[[1]],x[[12]], x[[3]],x[[4]],x[[5]],x[[6]],x[[7]],
    x[[8]], x[[9]],x[[10]],a = 0.01, b = 0.01),data = DATA)

getInitial.default(func, data, mCall = as.list(match.call(func, : 找不到“函数”对象的“getInitial”方法

这是因为 nlsLM 需要一个 formula 对象，但我们传递给它的是值吗？我不确定。

---

完成上述步骤后，您可以将其插入apply 并运行为：

apply(DATA, 1, function(x) {
  nlsLM(CSi~Prposed(x[[2]],x[[1]],x[[12]], x[[3]],x[[4]],x[[5]],x[[6]],x[[7]],
    x[[8]], x[[9]],x[[10]],a = 0.01, b = 0.01), data = DATA)
})

它可以在没有nlsLM 函数的情况下工作并生成数字：

apply(DATA, 1, function(x) {
  Prposed(x[[2]],x[[1]],x[[12]], x[[3]],x[[4]],x[[5]],x[[6]],x[[7]],x[[8]], 
         x[[9]],x[[10]],a = 0.01, b = 0.01) 
})

#              1         7        20        25        26        53        89
# [1,] 0.5078651 0.5078651 0.5070307 0.5092470 0.5092470 0.5070307 0.5092470
# [2,] 0.5087365 0.5087365 0.5077293 0.5083395 0.5083395 0.5077293 0.5083395
# [3,] 0.5077053 0.5077053 0.5084280 0.5083395 0.5083395 0.5084280 0.5083395
# [4,] 0.5096079 0.5096079 0.5084280 0.5094980 0.5094980 0.5084280 0.5094980
# [5,] 0.5085767 0.5085767 0.5091267 0.5094980 0.5094980 0.5091267 0.5094980
# [6,] 0.5094481 0.5094481 0.5098253 0.5085905 0.5085905 0.5098253 0.5085905
# [7,] 0.5104793 0.5104793 0.5091267 0.5106565 0.5106565 0.5091267 0.5106565
# [8,] 0.5094481 0.5094481 0.5098253 0.5106565 0.5106565 0.5098253 0.5106565
# [9,] 0.5103195 0.5103195 0.5105240 0.5097490 0.5097490 0.5105240 0.5097490
#[10,] 0.5111909 0.5111909 0.5112227 0.5109075 0.5109075 0.5112227 0.5109075

Answer 2

我必须在原始函数中定义逐行操作

Proposed <- function(N_b,Lanes,m,A,x.sqr,e_1,e_2,e_3,e_4,e_5,S,a,b) {
  e <- data.frame(e_1,e_2,e_3,e_4,e_5)
  CSi <- m * ((Lanes/N_b) + (max(A * combn(seq_along(e), Lanes, FUN = function(i) rowSums(e[i]))) / x.sqr) * (b*S^a))
  return(CSi)
}

nlsLM <- nlsLM(CSi ~ Proposed(N_b,Lanes,m,A,x.sqr,e_1,e_2,e_3,e_4,e_5,S,a,b), 
             data = DATA, 
             start = c(a = 0.01, b = 0.01))

summary(nlsLM)