更新 do() 函数时遇到问题

时间:2020-12-28 23:20:39

标签: r function dplyr tidyverse plyr

我正在尝试使用新版本的 dplyr 更新我的函数。 首先,我有这个功能(旧版本):

slope.k <- function(data, Treatment, Replicate, Day, Ln.AFDMrem){
  fitted_models <- data  %>% group_by(Treatment, Replicate) %>% 
    do(model = lm(Ln.AFDMrem ~ Day, data = .)) 
  broom::tidy(fitted_models,model) %>% print(n = Inf) 
}

然而,do() 函数已被取代。现在,我正在尝试使用此(新)版本进行更新:

slope.k <- function(data, Treatment, Replicate, Day, Ln.AFDMrem){
  mod_t <- data %>% nest_by(Treatment, Replicate) %>%
    mutate(model = list(lm(Ln.AFDMrem ~ Day, data = data))) %>%
    summarise(tidy_out = list(tidy(model)))
  unnest(select(mod_t, Treatment, tidy_out)) %>% print(n = Inf)
}

但是,它不能正常工作,因为我有以下警告:

Warning messages:
1: `cols` is now required when using unnest().
Please use `cols = c(tidy_out)` 
2: `...` is not empty.

We detected these problematic arguments:
* `needs_dots`

These dots only exist to allow future extensions and should be empty.
Did you misspecify an argument? 

提前致谢!!!

1 个答案:

答案 0 :(得分:2)

问题在于将 selectunnest 一起使用。可以通过将 select 更改为 c

来重现
libary(dplyr)
library(broom)
library(tidyr)
mtcars %>%
     nest_by(carb, gear) %>%
     mutate(model = list(lm(mpg ~ disp + drat, data = data))) %>% 
     summarise(tidy_out = list(tidy(model)), .groups = 'drop') %>% 
     unnest(c(tidy_out))

-输出

# A tibble: 33 x 7
#    carb  gear term        estimate std.error statistic p.value
#   <dbl> <dbl> <chr>          <dbl>     <dbl>     <dbl>   <dbl>
# 1     1     3 (Intercept)  -8.50    NaN       NaN      NaN    
# 2     1     3 disp          0.0312  NaN       NaN      NaN    
# 3     1     3 drat          7.10    NaN       NaN      NaN    
# 4     1     4 (Intercept) -70.5     302.       -0.234    0.854
# 5     1     4 disp         -0.0445    0.587    -0.0757   0.952
# 6     1     4 drat         25.5      62.4       0.408    0.753
# 7     2     3 (Intercept)  -3.72      8.57     -0.434    0.739
# 8     2     3 disp          0.0437    0.0123    3.54     0.175
# 9     2     3 drat          1.90      2.88      0.661    0.628
#10     2     4 (Intercept) -10.0     226.       -0.0443   0.972
# … with 23 more rows

另外,在mutate,步骤之后,我们可以直接使用'tidy_out'列上的unnest


如果我们作为函数使用,假设不带引号的参数作为列名传递

slope.k <- function(data, Treatment, Replicate, Day, Ln.AFDMrem){
  ln_col <- rlang::as_string(ensym(Ln.AFDMrem))
  day_col <- rlang::as_string(ensym(Day))
  data %>% 
     nest_by({{Treatment}}, {{Replicate}}) %>%
    mutate(model = list(lm(reformulate(day_col, ln_col), data = data))) %>%
    summarise(tidy_out = list(tidy(model)), .groups = 'drop') %>%
    unnest(tidy_out) 
 }



slope.k(mtcars, carb, gear, disp, mpg)
# A tibble: 22 x 7
    carb  gear term        estimate std.error statistic  p.value
   <dbl> <dbl> <chr>          <dbl>     <dbl>     <dbl>    <dbl>
 1     1     3 (Intercept) 22.0        5.35       4.12    0.152 
 2     1     3 disp        -0.00841    0.0255    -0.329   0.797 
 3     1     4 (Intercept) 52.6        8.32       6.32    0.0242
 4     1     4 disp        -0.279      0.0975    -2.86    0.104 
 5     2     3 (Intercept)  1.25       3.49       0.357   0.755 
 6     2     3 disp         0.0460     0.0100     4.59    0.0443
 7     2     4 (Intercept) 36.6        6.57       5.57    0.0308
 8     2     4 disp        -0.0978     0.0529    -1.85    0.206 
 9     2     5 (Intercept) 47.0      NaN        NaN     NaN     
10     2     5 disp        -0.175    NaN        NaN     NaN     
# … with 12 more rows
相关问题