在r中的函数内使用nlsLM执行非线性回归

我想在现有方程中添加一个修正因子来拟合数据。原始方程是通过函数定义的，因为变量

N_l

是一个数字向量，函数通过遍历向量

N_l

中的所有可能值来选择方程的最大结果。原始功能定义为：

library(utils)

R <- function(x){
  N_b <- x[1]
  N_l <- x[2]
  A <- x[3]
  x.sqr <- x[4]
  S <- x[10]
  e <- x[grepl("e_\\d",names(x))]
  f <- sapply(seq(N_l),function(k) max(Multi.Presence$m[k] * ((k/N_b) + 
                                       (A * combn(e,k,sum) / x.sqr))))
  c(val = max(f), pos = which.max(f))
}

DATA.GIRDER1 <- cbind(DATA.GIRDER1, vars = t(apply(DATA.GIRDER1, 1, R)))
colnames(DATA.GIRDER1)[12:13] <- c("Proposed.Girder1","Lanes")

拟合方程的理论数据为

CSi.Girder1

。目前，函数的设置方式是，它计算每行dataframe

DATA.GIRDER1

的最大

R

我想在方程的第二部分添加一个基于dataframe

DATA.GIRDER1

中变量S的回归项，以找到参数

a

和

b

，以最适合

CSi.GIRDER1

中的数据。所需输出将实现以下等式：

要使用

nlsLM

我需要为方程定义一个函数，例如：

library(minpack.lm)

Prposed.Girder1 <- function(N_b, N_l,A,x.sqr,e_1,e_2,e_3,e_4,e_5,S,a,b) {
  R <- function(x){
    N_b <- x[1]
    N_l <- x[2]
    A <- x[3]
    x.sqr <- x[4]
    e <- x[grepl("e_\\d",names(x))]
    f <- sapply(seq(N_l),function(k) max(Multi.Presence$m[k] * ((k/N_b) + 
                (A * combn(e,k,sum) / x.sqr) * (b*S^a))))
    c(val = max(f), pos = which.max(f))
  }
  DATA.GIRDER1 <- cbind(DATA.GIRDER1, vars = t(apply(DATA.GIRDER1, 1, R)))
  colnames(DATA.GIRDER1)[12:13] <- c("Proposed.Girder1","Lanes")

  return(R)
}

Girder1_nlsLM <- nlsLM(R ~ Prposed.Girder1(N_b, N_l,A,x.sqr,e_1,e_2,e_3,e_4,e_5,S,a,b), 
                 data = DATA.GIRDER1, 
                 start = c(a = 0.01, b = 0.01))

summary(Girder1_nlsLM)

---

如何在变量

S

中添加此修改因子，以求解参数

a

和

b

您的

CSi.Girder1

是什么样子？

提出。Girder1

从不计算R值。它只定义函数

R

，并返回它

nlsLM

期望公式RHS上的函数调用返回值，而不是函数。

library(minpack.lm)

Prposed.Girder1 <- function(N_b, N_l,A,x.sqr,e_1,e_2,e_3,e_4,e_5,S,a,b) {
  R <- function(x){
    N_b <- x[1]
    N_l <- x[2]
    A <- x[3]
    x.sqr <- x[4]
    e <- x[grepl("e_\\d",names(x))]
    f <- sapply(seq(N_l),function(k) max(Multi.Presence$m[k] * ((k/N_b) + 
                (A * combn(e,k,sum) / x.sqr) * (b*S^a))))
    c(val = max(f), pos = which.max(f))
  }
  DATA.GIRDER1 <- cbind(DATA.GIRDER1, vars = t(apply(DATA.GIRDER1, 1, R)))
  colnames(DATA.GIRDER1)[12:13] <- c("Proposed.Girder1","Lanes")

  return(R)
}

Girder1_nlsLM <- nlsLM(R ~ Prposed.Girder1(N_b, N_l,A,x.sqr,e_1,e_2,e_3,e_4,e_5,S,a,b), 
                 data = DATA.GIRDER1, 
                 start = c(a = 0.01, b = 0.01))

summary(Girder1_nlsLM)

Error in model.frame.default(formula = ~R + N_b + N_l + A + x.sqr + e_1 +  : 
  object is not a matrix