在R中面对“nlsLM”错误？

我试图用这个方程拟合一些数据：y=expp1x1+p2x2+p3+p4^p5 以下是一个可复制的示例：

 dat1 <- array(1:60, c(3,5,4));dat1=dat1*2
 dat2 <- array(1:60, c(3,5,4));dat2=dat2*0.5
 dat3 <- array(1:60, c(3,5,4))
 #reorder dimensions 
 dat1 <- aperm(dat1, c(3,1,2));dat2 <- aperm(dat2, c(3,1,2)) 
 dat3 <- aperm(dat3, c(3,1,2))
 #make array a matrix 
 dat1a <- dat1;dim(dat1a) <- c(dim(dat1)[1],prod(dim(dat1)[2:3])) 
 dat2a <- dat2;dim(dat2a) <- c(dim(dat2)[1],prod(dim(dat2)[2:3])) 
 dat3a <- dat3;dim(dat3a) <- c(dim(dat3)[1],prod(dim(dat3)[2:3])) 
 #function for fitting
  fun <- function(x1, x2, y) {
              keep <- !(is.na(x1) | is.na(x2) | is.na(y))
              if (sum(keep) > 1) { 
                 res <- summary(nlsLM(y[keep]~(exp(p1*x1[keep]+p2*x2[keep]+p3)+p4)^p5,  x1=x1,x2=x2,y=y, start=list(p1=4.5,p2=5,p3=3,p4=0,p5=1)))$coefficients[, 1]
              } else { 
                 res <- c(NA, NA, NA,NA,NA)
              } 
              res
          }
  #loop for fitting
  res <- mapply(fun, x1=as.data.frame(dat1a), x2=as.data.frame(dat2a),  y=as.data.frame(dat3a)) 

根据@ahmohamed的答案更新：

---

通过查看nlsLM中提供的参数，可以提供类似的参数，如下所示：

fun <- function(x1, x2, y) {
              keep <- !(is.na(x1) | is.na(x2) | is.na(y))
              if (sum(keep) > 1) { 
                 res <- summary(nlsLM(y~(exp(p1*x1+p2*x2+p3)+p4)^p5,  data = data.frame(x1=x1,x2=x2,y=y)[keep,], start=list(p1=4.5,p2=5,p3=3,p4=0,p5=1)))$coefficients[, 1]
              } else { 
                 res <- c(NA, NA, NA,NA,NA)
              } 
              res
          }

将所有数据分组到单个data.frame中，如文档示例所示。当然，您可以通过[keep，]

现在，mapply将向函数提供数据帧列

使用上述函数运行代码仍将引发错误：

res <- mapply(fun, x1=as.data.frame(dat1a), x2=as.data.frame(dat2a),  y=as.data.frame(dat3a)) 

Error in summary(nlsLM(y ~ (exp(p1 * x1 + p2 * x2 + p3) + p4)^p5, data = data.frame(x1 = x1,  : 
  error in evaluating the argument 'object' in selecting a method for function 'summary': Error in nlsModel(formula, mf, start, wts) : 
  singular gradient matrix at initial parameter estimates

初始参数开始导致矩阵奇异。可通过将初始参数设置为实际参数进行测试： 代码：

您尝试拟合的曲线需要修改。将公式简化为y~expp1*x1+p2*x2+p3将消除所有错误。 作用

结果

---

在哪个包中可以找到nlsLM函数？如果是从程序包minpack.lm传递代码，我不会得到相同的错误，但得到几乎相同的消息，因为nlsLM函数中确实没有x1、x2等参数，然后nlsLM公式，data=parent.frame，start，jac=NULL，algorithm=lm，control=nls.lm.control，lower=NULL，upper=NULL，跟踪=假，子集，权重，na。动作，模型=假，…：无x1，x2。。。参数，因此为error，而不是设置所有x1，x2。。。。在nlsLM函数中，尝试data=listy[keep]，x1[keep]，x2[keep]，并将此数据传递给函数mapply调用中是否仍有x2？答案是否解决了您的问题？我完全同意@ahmohmed。你的梯度是奇异的，可能是因为你的X矩阵的依赖性。问题不在于功能，而在于数据。

fun <- function(x1, x2, y) {
              keep <- !(is.na(x1) | is.na(x2) | is.na(y))
              if (sum(keep) > 1) { 
                 res <- summary(nlsLM(y~(exp(p1*x1+p2*x2+p3)+p4)^p5,  data = data.frame(x1=x1,x2=x2,y=y)[keep,], start=list(p1=4.5,p2=5,p3=3,p4=0,p5=1)))$coefficients[, 1]
              } else { 
                 res <- c(NA, NA, NA,NA,NA)
              } 
              res
          }

nlsLM(y~(exp(p1*x1+p2*x2+p3)+p4)^p5,  
   data = data.frame(x1=x1,x2=x2,y=y)[keep,],
   start=list(p1=4.5,p2=5,p3=3,p4=0,p5=1))

res <- mapply(fun, x1=as.data.frame(dat1a), x2=as.data.frame(dat2a),  y=as.data.frame(dat3a)) 

Error in summary(nlsLM(y ~ (exp(p1 * x1 + p2 * x2 + p3) + p4)^p5, data = data.frame(x1 = x1,  : 
  error in evaluating the argument 'object' in selecting a method for function 'summary': Error in nlsModel(formula, mf, start, wts) : 
  singular gradient matrix at initial parameter estimates

set.seed(123)
x1 = matrix(runif(50), ncol=5)
x2 = matrix(runif(50), ncol=5)
y = (exp(p1*x1+p2*x2+p3)+p4)^p5 #calculate y with known parameters for testing

y = (exp(4.5*x1 + 5*x2 + 3)+0)^1 ## setting p1~p5 similar to our start argument
mapply(fun, x1=as.data.frame(x1), x2=as.data.frame(x2),  y=as.data.frame(y))

fun <- function(x1, x2, y) {
    keep <- !(is.na(x1) | is.na(x2) | is.na(y))
    if (sum(keep) > 1) { 
       res <- summary(nlsLM(y~exp(p1*x1+p2*x2+p3),  
                    data = data.frame(x1=x1,x2=x2,y=y)[keep,], 
                    start=list(p1=4.5,p2=5,p3=3))
            )$coefficients[, 1]
    } else { 
       res <- c(NA, NA, NA,NA,NA)
    } 
    res
}

set.seed(123)
x1 = matrix(runif(50), ncol=5)
x2 = matrix(runif(50), ncol=5)

y = exp(4*x1 + 3*x2 + 3) ## True parameters: p1=4, p2=3, p3=3

mapply(fun, x1=as.data.frame(x1), x2=as.data.frame(x2),  y=as.data.frame(y))

   V1 V2 V3 V4 V5
p1  4  4  4  4  4
p2  3  3  3  3  3
p3  3  3  3  3  3