使用purrr :: map从自定义函数中的列表数据框输入列参数

时间:2018-01-28 20:15:48

标签: r tidyverse purrr lmertest

我正在编写一个自定义函数,在purrr::map的帮助下为列表的每个元素执行线性混合效果模型。代码块工作得非常好,但当我把它变成一个自定义函数时,我不清楚我应该如何输入与列表元素中各列相对应的参数。

如果我让自定义函数工作,我可以根据需要使用它。否则,我必须为不同的变量保留复制粘贴相同的代码。

# libraries needed
library(purrr)
library(lmerTest)
data(mtcars)

# create a list of dataframes from mtcars based on a split
group_list <- split(mtcars, mtcars$am)

# goal: to do linear mixed effects model for each dataframe and combining the results neatly in a dataframe

# achieving this outside of a custom function
group_list %>%
  purrr::map(.x = (.),
             .f = ~ lmerTest::lmer(
               scale(mpg) ~ scale(wt) + (wt | cyl),
               data = (.),
               REML = FALSE
             )) %>%
  purrr::map(.f = ~ coef(summary(.))[-c(1),]) %>%
  base::do.call(what = cbind.data.frame, args = .) %>%
  tibble::rownames_to_column(df = ., var = "Effect")
#>       Effect          0             1
#> 1   Estimate -0.3318711 -9.089148e-01
#> 2 Std. Error  0.2104268  1.156500e-01
#> 3         df  0.6084658  1.300000e+01
#> 4    t value -1.5771334 -7.859187e+00
#> 5   Pr(>|t|)  0.4558206  2.714599e-06

# preparing the custom function to do the same
lmer_group <- function(list, x, y) {
  list %>%
    purrr::map(
      .x = (.),
      .f = ~ lmerTest::lmer(
        scale(y) ~ scale(x) + (x | cyl),
        data = (.),
        REML = FALSE
      )
    ) %>%
    purrr::map(.f = ~ coef(summary(.))[-c(1),]) %>%
    base::do.call(what = cbind.data.frame, args = .) %>%
    tibble::rownames_to_column(df = ., var = "Effect")
}

# doing the same analysis with a custom function
lmer_group(list = group_list, x = wt, y = mpg) # attempt 1
#> Error in scale(y): object 'mpg' not found
lmer_group(list = group_list, x = 'wt', y = 'mpg') # attempt 2
#> Error in colMeans(x, na.rm = TRUE): 'x' must be numeric
lmer_group(
  list = group_list,
  x = lapply(group_list, `[`, 'wt'),
  y = lapply(group_list, `[`, 'mpg')
) # attempt 3
#> Error in colMeans(x, na.rm = TRUE): 'x' must be numeric

reprex package(v0.1.1.9000)于2018-01-28创建。

2 个答案:

答案 0 :(得分:1)

所有间接都发生在公式中,所以现在我根本不认为rlang是必需的。

您可以传递所需变量的字符串,并将它们粘贴在一起作为lmer函数的字符串。然后使用stats::as.formula()将其转换为适合lmer的公式。

lmer_group <- function(l, x_name, y_name) {
  fx <- paste0("scale(", y_name, ") ~ scale(", x_name, ") + (", x_name," | cyl)")
  print(paste("Evaluating: ", fx))

  l %>% 
    purrr::map(
      .f = ~ lmerTest::lmer(
        as.formula(fx),
        data = (.),
        REML = FALSE
      )
    ) %>%
    purrr::map(.f = ~ coef(summary(.))[-c(1),]) %>%
    base::do.call(what = cbind.data.frame, args = .) %>%
    tibble::rownames_to_column(df = ., var = "Effect")
}

lmer_group(l = group_list, x = 'wt', y = 'mpg') # attempt 2

结果

[1] "Evaluating:  scale(mpg) ~ scale(wt) + (wt | cyl)"
      Effect          0             1
1   Estimate -0.3318712 -9.089148e-01
2 Std. Error  0.2104267  1.156500e-01
3         df  0.6084632  1.300000e+01
4    t value -1.5771343 -7.859187e+00
5   Pr(>|t|)  0.4558213  2.714599e-06

我打赌quo()方法gulp.task('default', gulp.series('serve','sass','js')); 。如果您采用此解决方案,它基本上是rlang的副本。

答案 1 :(得分:1)

这是一种类似的方法,其结果被转置。我认为如果所有 t 值都在同一列中而不是在同一行中,那将会更有用。它使查询和操作更容易。

lmer_group <- function(l, x_name, y_name) {
  fx <- glue::glue("scale({y_name}) ~ scale({x_name}) + ({x_name} | cyl)")
  cat(paste("Evaluating: ", fx, "\n"))

  filter_name  <- glue::glue("scale({x_name})")

  l %>% 
    purrr::map(
      .f = ~ lmerTest::lmer(
        as.formula(fx),
        data = (.),
        REML = FALSE
      )
    ) %>%
    purrr::map_dfr(.f = ~ broom::tidy(.), .id = "am") %>% 
    dplyr::filter(term==!!filter_name) %>% 
    dplyr::select(
      am, 
      estimate,
      std.error,
      t           = statistic
    )
}

lmer_group(l = group_list, x = 'wt', y = 'mpg') # attempt 2

df p 值未出现,因为我不认为这些值已写入lme4 tidyer 。这可能是一个交易破坏者。

Evaluating:  scale(mpg) ~ scale(wt) + (wt | cyl)
  am   estimate std.error         t
1  0 -0.3318712 0.2104267 -1.577134
2  1 -0.9089148 0.1156500 -7.859187

为了多样化,我使用glue代替paste0()