初始参数估计处的奇异梯度矩阵答案

【问题标题】：singular gradient matrix at initial parameter estimates初始参数估计处的奇异梯度矩阵
【发布时间】：2017-08-29 07:13:16
【问题描述】：

我正在为一些数据拟合 Lotka-Volterra 模型，我的简单代码是：

    LCC<-c(11953.36,27413.50, 54823.75,  90904.73, 119250.34, 137679.14, 137750.79, 141107.43, 146356.56, 179280.00, 213037.07, 286138.03, 373380.14, 483474.16, 561950.42, 644919.07) 
AAR<-c(476068.4, 468621.0, 459684.1, 439587.9, 433429.0, 423889.7, 430239.4, 436614.3, 467925.9, 477742.2, 479049.2, 446933.5, 440711.2, 431425.5, 426563.1, 408660.5)
KAL<-c(888507, 887066, 875788, 872448, 855472, 817319, 787635, 793101, 800911, 787032, 763142, 733607, 706539, 673969, 656770, 672431)
PA<-c(457695.9,476068.4, 468621.0, 459684.1, 439587.9, 433429.0, 423889.7, 430239.4, 436614.3, 467925.9, 477742.2, 479049.2, 446933.5, 440711.2, 431425.5, 426563.1)
PK<-c(893515.0,888507, 887066, 875788, 872448, 855472, 817319, 787635, 793101, 800911, 787032, 763142, 733607, 706539, 673969, 656770)
PL<-c(11953.36,11953.36,27413.50, 54823.75,  90904.73, 119250.34, 137679.14, 137750.79, 141107.43, 146356.56, 179280.00, 213037.07, 286138.03, 373380.14, 483474.16, 561950.42)






LCCmodel<-nls(LCC~a1*PL/1+b1*PL+c1*PA+d1*PK, start=list(a1=-4.132e+05,b1=1.251e+00,c1=7.470e-01,d1=8.771e-02))

但它会返回：

"Error in nls(LCC ~ a1 * PL/1 + b1 * PL + c1 * PA + d1 * PK, start = list(a1 = 122400,  :

奇异梯度”

如果我从公式中删除与 a1 相乘的“PL”，那么它可以工作。我不能跳过它请帮助

【问题讨论】：

请查看stackoverflow.com/questions/5963269/…，然后使用适当的数据等编辑您的帖子。
谢谢你威廉姆斯我是一个新手...我已经编辑了我的帖子并添加了输入数据..
你能提供确切的公式吗？另外你的起始a1值是不是太高了？
L_(t+1)=(α * L_t)/(1+β *L_t+γ *A_t+δ *K_t ) 这是精确的公式 Prem.. 我只是把这个值从分子中省略 PL 并运行代码...我找不到任何其他方法来猜测初始值..

标签： r nonlinear-optimization nls

【解决方案1】：

公式有误。这也可以用 DE 解决：

xd=data.frame(PL,PA,PK)
library(NMOF)
yf= function(params,x){
  a1=params[1];b1=params[2];c1=params[3];d1=params[4]
  a1*x$PL/(1+b1*x$PL+c1*x$PA+d1*x$PK)
}

yf(rep(4,4),xd)

algo1 <- list(printBar = FALSE,
              nP  = 200L,
              nG  = 1000L,
              F   = 0.50,
              CR  = 0.99,
              min = rep(-5,4),
              max = rep(5,4))

OF1 <- function(Param, data) { 
  x <- data$x
  y <- data$y
  ye <- data$model(Param,x)
  aux <- y - ye; aux <- sum(aux^2)
  if (is.na(aux)) aux <- 1e10
  aux
}


data1 <- list(x = xd, y = LCC,  model = yf, ww = 1)
system.time(sol1 <- DEopt(OF = OF1, algo = algo1, data = data1))
sol1$xbest
OF1(sol1$xbest,data1)

plot(PL, LCC, pch=16, cex=0.8) 
lines(data1$x$PL,data1$model(sol1$xbest, data1$x),col=7,lwd=2)

#> sol1$xbest
#[1]  8.387138e-01  2.042065e-07 -2.004656e-06  7.055385e-07

【讨论】：