问题

我试图理解为什么nls()给我这个错误：

Error in nlsModel(formula, mf, start, wts): singular gradient matrix at initial parameter estimates

假设

从我在这里的其他问题中所读到的信息来看，可能是因为：

我的模型不连续，或者
我的模型过高，或者
错误选择起始参数值

因此，我正在寻求有关如何克服此错误的帮助。是否可以更改模型并仍然使用nls()，还是需要使用nls.lm软件包中的minpack.lm？

我的方法

以下是有关该模型的一些详细信息：

模型是一个不连续的函数，是一种 staircase 类型的函数（请参见下图）
通常，模型中步数可以是可变的，但对于特定的拟合事件是固定的

显示问题的MWE

MWE代码的简要说明

step_fn(x, min = 0, max = 1)：在间隔（1，min]和max内返回0的函数；对不起这个名字，我现在知道了并不是一个真正的步进功能...我猜interval_fn()会更合适。
staircase(x, dx, dy)：step_fn()个函数的总和。 dx是 steps 的宽度矢量，即max - min，而dy是每个 step < / em>。

y：生成一个staircase_formula(n = 1L)对象，该对象代表由函数formula（与staircase()函数一起使用）建模的模型。

请注意，在下面的示例中，我使用了nls()和purrr软件包。

代码

glue

step_fn <- function(x, min = 0, max = 1) { y <- x y[x > min & x <= max] <- 1 y[x <= min] <- 0 y[x > max] <- 0 return(y) } staircase <- function(x, dx, dy) { max <- cumsum(dx) min <- c(0, max[1:(length(dx)-1)]) step <- cumsum(dy) purrr::reduce(purrr::pmap(list(min, max, step), ~ ..3 * step_fn(x, min = ..1, max = ..2)), `+`) } staircase_formula <- function(n = 1L) { i <- seq_len(n) dx <- sprintf("dx%d", i) min <- c('0', purrr::accumulate(dx[-n], .f = ~ paste(.x, .y, sep = " + "))) max <- purrr::accumulate(dx, .f = ~ paste(.x, .y, sep = " + ")) lhs <- "y" rhs <- paste(glue::glue('dy{i} * step_fn(x, min = {min}, max = {max})'), collapse = " + ") sc_form <- as.formula(glue::glue("{lhs} ~ {rhs}")) return(sc_form) } x <- seq(0, 10, by = 0.01) y <- staircase(x, c(1,2,2,5), c(2,5,2,1)) + rnorm(length(x), mean = 0, sd = 0.2) plot(x = x, y = y) lines(x = x, y = staircase(x, dx = c(1,2,2,5), dy = c(2,5,2,1)), col="red")

非常感谢您的帮助。

Answer 1

改为尝试DE：

library(NMOF)
 yf= function(params,x){
   dx1 = params[1]; dx2 = params[2]; dx3 = params[3]; dx4 = params[4];
   dy1 = params[5]; dy2 = params[6]; dy3 = params[7]; dy4 = params[8]
   dy1 * step_fn(x, min = 0, max = dx1) + dy2 * step_fn(x, min = dx1, 
               max = dx1 + dx2) + dy3 * step_fn(x, min = dx1 + dx2, max = dx1 + 
               dx2 + dx3) + dy4 * step_fn(x, min = dx1 + dx2 + dx3, max = dx1 + 
               dx2 + dx3 + dx4)
 }

 algo1 <- list(printBar = FALSE,
               nP  = 200L,
               nG  = 1000L,
               F   = 0.50,
               CR  = 0.99,
               min = c(0,1,1,4,1,4,1,0),
               max = c(2,3,3,6,3,6,3,2))

 OF2 <- function(Param, data) { #Param=paramsj data=data2
   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
 }

 data5 <- list(x = x, y = y,  model = yf, ww = 1)
 system.time(sol5 <- DEopt(OF = OF2, algo = algo1, data = data5))
 sol5$xbest
 OF2(sol5$xbest,data5)

 plot(x,y)
 lines(data5$x,data5$model(sol5$xbest, data5$x),col=7,lwd=2)

#>  sol5$xbest
#[1]   1.106396  12.719182  -9.574088  18.017527   3.366852   8.721374 -19.879474   1.090023
#>  OF2(sol5$xbest,data5)
#[1] 1000.424

Answer 2

我假设为您提供了示例中绘制的长度为len的观察值向量，并且您希望标识k的跳跃和k的跳跃大小。（或者也许我误解了您；但是您并未真正说出您想要实现的目标。）下面，我将使用“本地搜索”来草绘解决方案。我从您的示例数据开始：

x <- seq(0, 10, by = 0.01)
y <- staircase(x,
               c(1,2,2,5),
               c(2,5,2,1)) + rnorm(length(x), mean = 0, sd = 0.2)

一种解决方案是列出跳跃的位置和大小。请注意，我使用向量来存储这些数据，例如，当您跳20次时，定义变量将变得很麻烦。

示例（随机）解决方案：

k <- 5   ## number of jumps
len <- length(x)

sol <- list(position = sample(len, size = k),
            size = runif(k))

## $position
## [1]  89 236 859 885 730
## 
## $size
## [1] 0.2377453 0.2108495 0.3404345 0.4626004 0.6944078

我们需要一个目标函数来计算解决方案的质量。我还定义了一个简单的辅助函数stairs，由目标函数使用。目标函数abs_diff计算拟合级数（由解定义）和y之间的平均绝对差。

stairs <- function(len, position, size) {
    ans <- numeric(len)
    ans[position] <- size
    cumsum(ans)
}

abs_diff <- function(sol, y, stairs, ...) {
    yy <- stairs(length(y), sol$position, sol$size)
    sum(abs(y - yy))/length(y)
}

现在是本地搜索的关键组件：用于发展解决方案的邻域函数。邻域函数需要一个解决方案，并对其进行一些更改。在这里，它将选择一个位置或一个 size 并对其进行一些修改。

neighbour <- function(sol, len, ...) {
    p <- sol$position
    s <- sol$size

    if (runif(1) > 0.5) {
        ## either move one of the positions ...
        i <- sample.int(length(p),  size = 1)
        p[i] <- p[i] + sample(-25:25, size = 1)
        p[i] <- min(max(1, p[i]), len)        
    } else {
        ## ... or change a jump size
        i <- sample.int(length(s), size = 1)
        s[i] <- s[i] + runif(1, min = -s[i], max = 1)
    }

    list(position = p, size = s)
}

一个示例调用：这里新解决方案的第一次跳转大小已更改。

## > sol
## $position
## [1]  89 236 859 885 730
## 
## $size
## [1] 0.2377453 0.2108495 0.3404345 0.4626004 0.6944078
## 
## > neighbour(sol, len)
## $position
## [1]  89 236 859 885 730
## 
## $size
## [1] 0.2127044 0.2108495 0.3404345 0.4626004 0.6944078

我仍然要运行本地搜索。

library("NMOF")
sol.ls <- LSopt(abs_diff,
                list(x0 = sol, nI = 50000, neighbour = neighbour),
                stairs = stairs,
                len = len,
                y = y)

我们可以绘制解决方案：拟合线显示为蓝色。

plot(x, y)
lines(x, stairs(len, sol.ls$xbest$position, sol.ls$xbest$size),
      col = "blue", type = "S")

使用nls（）进行非线性拟合会在初始参数估计时给我奇异梯度矩阵。为什么？

问题

假设

我的方法

显示问题的MWE

MWE代码的简要说明

代码

2 个答案: