使用 nls() 进行非线性拟合在初始参数估计时给出奇异梯度矩阵。为什么?

2024-01-20

这是我第一次尝试在 R 中拟合非线性模型,所以请耐心等待。

Problem

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

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

假设

从我在 SO 的其他问题中读到的内容可能是因为:

  • 我的模型是不连续的,或者
  • 我的模型是过度确定的,或者
  • 起始参数值选择错误

所以我请求帮助来解决这个错误。我可以更改型号并仍然使用吗nls(),或者我需要使用nls.lm来自minpack.lm包,正如我在其他地方读过的那样?

我的方法

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

  • 该模型是一个不连续函数,是一种楼梯函数类型(见下图)
  • 一般来说,数量steps模型中的内容可以是可变的,但它们对于特定的拟合事件是固定的

显示问题的 MWE

MWE代码简要说明

  • step_fn(x, min = 0, max = 1): 返回的函数1区间内(min, max] and 0否则;抱歉这个名字,我现在意识到它并不是真正的阶跃函数......interval_fn()我想会更合适。
  • staircase(x, dx, dy): 的总和step_fn()功能。dx是宽度向量steps, i.e. max - min, and dy是增量y对于每个step.
  • staircase_formula(n = 1L):生成一个formula表示由函数建模的模型的对象staircase()(与使用nls()功能)。
  • 请注意,我使用purrr and glue下例中的包。

Code

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")

my_data <- data.frame(x = x, y = y)
my_model <- staircase_formula(4)
params <- list(dx1 = 1, dx2 = 2, dx3 = 2, dx4 = 5,
               dy1 = 2, dy2 = 5, dy3 = 2, dy4 = 1)

m <- nls(formula = my_model, start = params, data = my_data)
#> Error in nlsModel(formula, mf, start, wts): singular gradient matrix at initial parameter estimates

任何帮助是极大的赞赏。


我假设你得到了一个长度为观察值的向量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)

解决方案是一个列表职位 and sizes的跳跃。请注意,我使用向量来存储这些数据,因为当你有 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)
}

现在是本地搜索的关键组件:用于改进解决方案的邻域函数。邻域函数采用一个解决方案并对其进行轻微更改。在这里,它会选择一个position or a 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")
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

使用 nls() 进行非线性拟合在初始参数估计时给出奇异梯度矩阵。为什么? 的相关文章

  • 如何在 R 中执行近似(模糊)名称匹配

    我有一个专门用于生物学期刊的大型数据集 该数据集是由不同的人长时间编写的 因此 数据不采用单一格式 例如 在 作者 栏中我可以找到John Smith Smith John Smith J等 但它们是同一个人 我连最简单的动作都做不了 例如
  • 多个动态滤镜更新闪亮

    我希望能够让 UI 输入闪亮 并根据用户之前的选择进行自我更新 因此 在下面的示例中 预期的行为是用户选择cyl vsor carb那么这将 过滤数据集mtcars用于创建绘图 即用户根据过滤条件调整绘图并 更新其他过滤器中的剩余输入选择
  • 在 R 中提取 data.frames 列表的名称以及 data.frame 中的值

    在下面的代码中 j是 data frames 的命名列表 我想知道是否有办法 a 提取变量的数值 即one short and one long 在 data frames 内并附加它们的相关名称 即 AAA or BBB or CCC 到
  • 使用选定因子水平的值向 ggplot-barchart 添加水平线

    在这个情节中 df lt data frame factor as factor c rep A 3 rep B 3 Treatment c rep c A B C 2 values runif 6 0 1 ggplot df aes Tr
  • 从数据框中绘制多条平滑线

    我对 R 比较陌生 我正在尝试绘制从 csv 文件加载的数据框 数据由 6 列组成 如下所示 xval col1 col2 col3 col4 col5 第一列 xval 由一系列单调递增的正整数 例如 10 40 60 等 组成 其他列
  • 增加雷达图中长轴标签的空间

    我想创建一个雷达图ggirahExtra ggRadar 问题是我的标签很长并且被剪掉了 我想我可以通过添加在标签和绘图之间创建更多空间margin margin 0 0 2 0 cm to element text in axis tex
  • 需要在R中跳过不同数量的行

    我正在使用以下代码来处理我的数据 但最近我意识到使用skip 27 在数据开始之前跳过存储在我的文件中的信息 不是一个好的选择 因为每个文件中要跳过的行数不同我的目标是读取存储在多个文件夹中的各种txt文件 并非所有文件都有相同的列数 列的
  • case_when 与部分字符串匹配和 contains()

    我正在使用一个数据集 其中有许多名为 status1 status2 等的列 在这些列中 它表示某人是否豁免 完整 注册等 不幸的是 豁免投入并不一致 这是一个示例 library dplyr problem lt tibble perso
  • 如何在 R 中的 dygraph 标题中使用 UTF-8 字符

    使用 Rstudio Windows8 当我使用 dygraph 函数绘制时间序列时 在尝试在主标题中使用 UTF 8 字符时遇到问题 library dygraphs dygraph AirPassengers main T tulo 这
  • 如何在Rstudio中快速给几个单词加上引号?

    如何将 MI ID FL 转换为 MI ID FL 而无需键入每个双引号 Hmisc 包有一个函数 Cs 它将评估逗号分隔的文本是否带有引号 Cs MI ID FL becomes MI ID FL
  • R 中 SVG 图形的最佳设备? [关闭]

    Closed 这个问题不符合堆栈溢出指南 help closed questions 目前不接受答案 我想从 R 导出 SVG 图形 似乎有两种选择 RSvgDevice 和 Cairo 有人可以对这些包发表评论吗 是默认的还是明显比另一个
  • rvest 函数 html_nodes 返回 {xml_nodeset (0)}

    我正在尝试抓取以下网站的数据框 http stats nba com game 0041700404 playbyplay http stats nba com game 0041700404 playbyplay 我想创建一个表格 其中包
  • 在 Google Colab 上的 R 笔记本中安装 python 库

    我正在尝试在 Google Colab 上的 R 笔记本中安装 python 库 为此我使用 reticulate 包 library reticulate py install pandas 但我得到的结果是这个错误 Error coul
  • 无法将“gather”输出的列名称更改为默认名称以外的任何名称

    我正在尝试使用gather in the tidyr包 但我无法更改默认名称的输出列名称 例如 df data frame time 1 100 a 1 100 b 101 200 df long df gt gather foo bar
  • 更改 R 中 ggplot geom_polygon 的颜色方案

    我正在使用地图库和 ggplot 的 geom polygon 创建地图 我只是想将默认的蓝色 红色 紫色配色方案更改为其他颜色 我对 ggplot 非常陌生 所以如果我没有使用正确的数据类型 请原谅 我使用的数据如下所示 gt head
  • 是否有weighted.median()函数?

    我正在寻找类似形式的东西weighted mean 我通过搜索找到了一些解决方案 这些解决方案写出了整个函数 但希望有一些更用户友好的解决方案 以下软件包都有计算加权中位数的函数 aroma light isotone limma cwhm
  • R:改变堆积条形图的颜色

    library ggplot2 df2 lt data frame supp rep c VC OJ each 3 dose rep c D0 5 D1 D2 2 len c 6 8 15 33 4 2 10 29 5 head df2 g
  • 安装 2.15 后 ggplot2 中的 alpha 通道不起作用

    更新到 R 2 15 后 ggplot 中的 alpha 通道似乎不再起作用 plot rnorm 100 rnorm 100 bg cc000055 pch 21 工作得很好但是 qplot rnorm 100 rnorm 100 col
  • 将 Excel 文件读入 R 并锁定单元格

    我有一个 Excel 电子表格要读入 R 它受密码保护并锁定了单元格 我可以使用 excel link 导入受密码保护的文件 但我不知道如何解锁 取消保护单元格 excel link 给了我这个错误 gt
  • 斯皮尔曼相关性和联系

    我正在一小组配对排名上计算斯皮尔曼的 rho 斯皮尔曼因处理领带不当而闻名 例如 取2组8个排名 即使两组中有6个是平局 相关性仍然很高 gt cor test c 1 2 3 4 5 6 7 8 c 0 0 0 0 0 0 7 8 met

随机推荐