为列表中各数据框设置不同nls初始值时遇报错问题排查

问题概述 #

尝试用split-apply-combine方法为不同分组拟合nls模型，参考的旧代码5年前可正常运行，现在执行时出现报错。

初始代码及首次报错 #

初始代码如下：

library(tidyverse)

df <- data.frame(Group = c(rep("A", 7), rep("B", 7), rep("C", 7)),
                 Time = c(rep(c(1:7), 3)),
                 Result = c(100, 96.9, 85.1, 62.0, 30.7, 15.2, 9.6, 
                            ## 替换了数值！
                            ## B组初始值不是问题所在
                            105, 90, 82, 55, 40, 23, 7, 
                            100, 55.61, 3.26, -4.77, -7.21, -3.2, -5.6))

## ggplot(df, aes(x = Time, y = Result, group = Group)) + geom_line()

df_p <-
  df %>%
  group_by(Group) %>%
  nest() %>% 
  ## 初始值暂设为相同，此处仅展示设置不同初始值的方式
  mutate(start = list(
    list(a = -3, b = 85, c = 4, d = 10),
    list(a = -3, b = 85, c = 4, d = 10),
    list(a = -3, b = 85, c = 4, d = 10))
)

运行后报错：

Error in `mutate()`:
! Problem while computing `start = list(...)`.
✖ `start` must be size 1, not 3.
ℹ The error occurred in group 1: Group = "A".
Backtrace:
 1. df %>% dplyr::group_by(Group) %>% nest() %>% ...
 3. dplyr:::mutate.data.frame(...)

无效尝试及对应报错 #

• 尝试将mutate()替换为dplyr:::mutate.data.frame()，报错：

Error: 'mutate.data.frame' is not an exported object from 'namespace:dplyr'

• 尝试改用nest(cols = -Group)，代码如下：

df %>% 
   nest(cols = -Group) %>% 
   mutate(start = list(list(a = -3, b = 85, c = 4, d = 10),
    list(a = -3, b = 85, c = 4, d = 10),
    list(a = -3, b = 85, c = 4, d = 10))) %>%
  mutate(model = map2(data, start,
                       ~ nls(Result ~ a+(b-a)/(1+(Time/c)^d),
                             data = .x, start = .y)),
    # 模型质量评估指标
    glance = map(model, broom::glance),
    # 模型参数
    tidy = map(model, broom::tidy),
    # 拟合值与残差等
    augment = map(model, broom::augment) )

报错信息：

Error in `mutate()`:
! Problem while computing `model = map2(...)`.
Caused by error in `purrr:::stop_bad_type()`:
! `.x` must be a vector, not a function
Backtrace:
 1. ... %>% ...
 8. purrr:::stop_bad_type(...)
 Error in mutate(., model = map2(data, start, ~nls(Result ~ a + (b - a)/(1 + : 

Caused by error in `purrr:::stop_bad_type()`:
! `.x` must be a vector, not a function

最终解决方案 #

在nest()之后添加ungroup()，取消分组状态后即可正常运行。完整代码如下：

df %>%
  dplyr::group_by(Group) %>%
  nest() %>% 
  ungroup %>%
  ## 初始值可设置为不同，此处示例调整了d值
 dplyr::mutate(start = list(
    list(a = -3, b = 85, c = 4, d = 10),
     list(a = -3, b = 85, c = 4, d = 15),
     list(a = -3, b = 85, c = 4, d = 13)),
   model = map2(data, start,
                       ~ nls(Result ~ a+(b-a)/(1+(Time/c)^d),
                             data = .x, start = .y)),
    # 模型质量评估指标
    glance = map(model, broom::glance),
    # 模型参数
    tidy = map(model, broom::tidy),
    # 拟合值与残差等
    augment = map(model, broom::augment))

运行结果：

# A tibble: 3 × 7
  Group data             start            model  glance           tidy             augment         
  <chr> <list>           <list>           <list> <list>           <list>           <list>          
1 A     <tibble [7 × 2]> <named list [4]> <nls>  <tibble [1 × 9]> <tibble [4 × 5]> <tibble [7 × 4]>
2 B     <tibble [7 × 2]> <named list [4]> <nls>  <tibble [1 × 9]> <tibble [4 × 5]> <tibble [7 × 4]>
3 C     <tibble [7 × 2]> <named list [4]> <nls>  <tibble [1 × 9]> <tibble [4 × 5]> <tibble [7 × 4]>

内容的提问来源于stack exchange，提问作者hnguyen