r - 如何延迟评估作为参数传递给 purrr::pmap 的函数

Question

我正在尝试使用嵌套数据框 ( https://r4ds.had.co.nz/many-models.html ) 方法使用 lcmm::lcmm() 来拟合多个潜在类增长曲线和 purrr::pmap() .

此过程需要使用 lcmm() 将模型拟合为一个类别 (k = 1)，然后将此模型用作 lcmm::gridsearch() 的输入，它将此 k = 1 模型的起始值输入到 k = 2+ 类模型中。 gridsearch()还需要对 k = 2+ 模型(加上其他两个参数)的模型调用，它作为对 lcmm() 的调用传递在通话中 gridsearch() .我通常的做法是使用 pmap()将参数列表传递给 gridsearch() ，但是list()立即评估对 lcmm() 的模型调用并尝试拟合模型而不是将模型调用传递给 gridsearch() (参见 confusing behavior of purrr::pmap with rlang; "to quote" or not to quote argument that is the Q)。

注意使用 RStudio 的函数查看器 (F2)，似乎 lcmm::gridsearch()使用 match.call()使用用户定义的随机起始值数量调整 k = 2+ 模型调用，然后遍历这些值以找到首选的 k = 2+ 解决方案。

我在下面包含了一个代表。在 pmap 中包装对 gridsearch 的调用时，命令失败并显示“mutate_impl(.data, dots) 错误:评估错误:参数长度为零。” - 我认为这是因为 R 正在尝试评估对 lcmm() 的调用对于 k = 2+ 模型，但我可能是错的。

如何延迟对 lcmm() 的评估？当作为参数传递给 pmap() 时？

下面的代表:

library(lcmm)
#> Warning: package 'lcmm' was built under R version 3.5.2
#> Loading required package: survival
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(tidyr)
library(purrr)

# load lcmm example data

data("data_lcmm")

# take sample

set.seed(123)

data_lcmm <-
  data_lcmm %>%
  sample_frac(0.1)




# NB grouping variable is needed to reproduce desired data structure 

data_lcmm <-
  data_lcmm %>%
  mutate(group_var = sample(c(0, 1),
    size = nrow(data_lcmm),
    replace = TRUE
  ))



data_lcmm_nest <-
  data_lcmm %>%
  group_by(group_var) %>%
  nest() %>% 
  mutate(data= map(data, as.data.frame))


# lcmm call from ?lcmm

lcmm_k1 <- function(df) {
  lcmm(Ydep2 ~ Time + I(Time^2),
    random = ~Time, subject = "ID", ng = 1,
    data = data_lcmm_nest$data[[1]], link = "linear"
  )
}


# fit k = 1 models
data_lcmm_nest <-
  data_lcmm_nest %>%
  mutate(lcgm = map(data, lcmm_k1))
#> Be patient, lcmm is running ... 
#> The program took 0.18 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.19 seconds

# this works for a single row
desired_result <-
  gridsearch(
    m = lcmm(Ydep2 ~ Time + I(Time^2),
      mixture = ~Time,
      random = ~Time, subject = "ID", ng = 2,
      data = data_lcmm_nest$data[[1]], link = "linear"
    ),
    rep = 5,
    maxiter = 2,
    minit = data_lcmm_nest$lcgm[[1]]
  )
#> Be patient, lcmm is running ... 
#> The program took 0.45 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.45 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.45 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.45 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.47 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.61 seconds


# this fails with Error in mutate_impl(.data, dots) :
# Evaluation error: argument is of length zero.

data_lcmm_nest %>%
  mutate(lcgm_2 = pmap(
    list(
      m = lcmm(Ydep2 ~ Time + I(Time^2),
        mixture = ~Time,
        random = ~Time, subject = "ID", ng = 2,
        data = data, link = "linear"
      ),
      rep = 5,
      maxiter = 2,
      minit = lcgm
    ), gridsearch
  ))
#> Error in mutate_impl(.data, dots): Evaluation error: argument is of length zero.


# wrapping gridsearch in helper also fails

grid_search_helper <- function(g_rep, g_maxiter, g_minit, g_m) {
  gridsearch(
    m = lcmm(Ydep2 ~ Time + I(Time^2),
      mixture = ~Time,
      random = ~Time, subject = "ID", ng = 2,
      data = g_m, link = "linear"
    ),
    rep = g_rep,
    maxiter = g_maxiter,
    minit = g_minit
  )
}


data_lcmm_nest %>%
  mutate(lcgm_2 = pmap(
    list(
      5,
      2,
      lcgm,
      data
    ), grid_search_helper
  ))
#> Error in mutate_impl(.data, dots): Evaluation error: object 'g_m' not found.

^{由 reprex package 创建于 2019-01-24 (v0.2.1)}

Answer 1

使用 purrr，我相信下面会创建您想要的输出，即拟合模型对象列表。

它通过在 前面的匿名函数中使用 ..n 语法引用从 data_lcmm_nest 提供给 purrr 的参数来工作~，其中 n 指的是参数在提供的数据帧或列表列表中的位置。

library(lcmm)
#> Warning: package 'lcmm' was built under R version 4.0.5
#> Loading required package: survival
#> Loading required package: parallel
#> Loading required package: mvtnorm
#> Loading required package: randtoolbox
#> Loading required package: rngWELL
#> Warning: package 'rngWELL' was built under R version 4.0.5
#> This is randtoolbox. For an overview, type 'help("randtoolbox")'.
#> 
#> Attaching package: 'lcmm'
#> The following object is masked from 'package:randtoolbox':
#> 
#>     permut
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(tidyr)
library(purrr)

# load lcmm example data

data("data_lcmm")

# take sample

set.seed(123)

data_lcmm <-
  data_lcmm %>%
  sample_frac(0.1)

# NB grouping variable is needed to reproduce desired data structure 

data_lcmm <-
  data_lcmm %>%
  mutate(group_var = sample(c(0, 1),
                            size = nrow(data_lcmm),
                            replace = TRUE
  ))

data_lcmm_nest <-
  data_lcmm %>%
  group_by(group_var) %>%
  nest() %>% 
  mutate(data= map(data, as.data.frame))


# lcmm call from ?lcmm

lcmm_k1 <- function(df) {
  lcmm(Ydep2 ~ Time + I(Time^2),
       random = ~Time, subject = "ID", ng = 1,
       data = data_lcmm_nest$data[[1]], link = "linear"
  )
}

# fit k = 1 models
data_lcmm_nest <-
  data_lcmm_nest %>%
  mutate(lcgm = map(data, lcmm_k1))
#> Be patient, lcmm is running ... 
#> The program took 0.18 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.17 seconds

# this works for n rows
desired_result_list <- pmap(
    data_lcmm_nest,
    ~ gridsearch(
      m = lcmm(Ydep2 ~ Time + I(Time^2),
               mixture = ~Time,
               random = ~Time, subject = "ID", ng = 2,
               data = ..2, link = "linear"
      ),
      rep = 5,
      maxiter = 2,
      minit = ..3
    )
  )
#> Be patient, lcmm is running ... 
#> The program took 0.38 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.41 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.41 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.43 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.44 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.46 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.33 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.33 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.31 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.31 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.31 seconds 
#> Be patient, lcmm is running ... 
#> The program took 0.37 seconds
Created on 2022-04-28 by the reprex package (v2.0.0)