dplyr package 中的 lapply 錯誤：group_by

Question

我在 OSF 上找到了一個不錯的 function，我想將其應用於我自己的數據： https://osf.io/huy8b/

但是，如果我嘗試使用 lapply function，我會收到錯誤消息。 我的代碼和示例數據（我自己的數據集要大得多）在這里。

if (!require("devtools")) install.packages("devtools", repos = "http://cran.us.r-project.org")

require(devtools)

if (!require("relativeVariability")) install_github('seanchrismurphy/relativeVariability')
if (!require("emacalc")) install_github('seanchrismurphy/emacalc')
if (!require("Smisc")) install_github('seanchrismurphy/Smisc')


if (!require("pacman")) install.packages("pacman", repos = "http://cran.us.r-project.org")

sessionInfo()

pacman::p_load(Smisc, emacalc, relativeVariability, broom, metafor, gridExtra, psych, apa, knitr, 
               pander, apaTables, lavaan, lme4, tidyr, reshape2, Hmisc, plyr, dplyr, zoo)




final.esm <- data.frame(person_id= c(1,1,1,1,1,1,2,2,2,2,2,2),
                        daynr = c(1,1,1,2,2,2,1,1,1,2,2,2),
                   Beep = c(1,2,3,4,5,6,1,2,3,4,5,6),
                   Emotion1 = c(2,3,4,6,1,2,3,3,4,2,1,2),
                   Emotion2 = c(1,4,5,7,1,2,4,5,3,1,1,2))

#final.esm <- read.csv(file = 'C:/Users/U539194/Desktop/Dataset 10 public.csv')

######################################################


# Here we define functions for calculating MSSD on the day and person level. 
person_mssd <- function (data, variables, person_id) 
{
  if (length(variables) == 1) {
    mydots = setNames(rep("relativeVariability::MSSD(.)", length(variables)), 
                      paste0(variables, "_person_mssd"))
  }
  else {
    mydots = setNames("relativeVariability::MSSD(.)", "person_mssd")
  }
  out <- group_by_(data, .dots = person_id) %>% mutate_at(variables, 
                                                          funs_(mydots)) %>% as.data.frame()
  out
}


day_mssd <- function (data, variables, person_id, day_id) 
{
  if (length(variables) == 1) {
    mydots = setNames(rep("relativeVariability::MSSD(.)", length(variables)), 
                      paste0(variables, "_day_mssd"))
  }
  else {
    mydots = setNames("relativeVariability::MSSD(.)", "day_mssd")
  }
  out <- group_by_(data, .dots = c(person_id, day_id)) %>% 
    mutate_at(variables, funs_(mydots)) %>% as.data.frame()
  out
}

# Trimming to valid obs.
final.esm <- lapply(final.esm, function(x) trim_min_valid_obs(x, variables = c('Emotion1', 'Emotion2'), grouping = c('person_id', 'daynr'), min.obs = 4))

# After we've calculated the basic person stuff for esm, we add in the buffer row and then calculate MSSD.
final.esm <- lapply(final.esm, function(x) {x <- x %>% group_by(person_id, daynr) %>% do(add_row(.)); return(x)})

# We need to fill the NA rows with the right person id otherwise all the processes that group by person ID (like MSSD person calc) will ignore them and it'll 
# be as if we did nothing. 
final.esm <- lapply(final.esm, function(x) x %>% ungroup() %>% mutate(person_id = zoo::na.locf(person_id)))
final.esm <- lapply(final.esm, function(x) person_mssd(x, variables = c('Emotion2', 'Emotion1'), person_id = c('person_id')))

# And now, to be extra safe, we get rid of all those empty rows we just made. This removes rows with NA cols 5 less than the total number of cols (since we 
# filled in person_id and also it'll have mssd and relmssd for posemo and negemo. )
final.esm <- lapply(final.esm, function(x) x[apply(x, 1, function(x) sum(is.na(x))) < (ncol(x) - 5), ])

# Since daily is intrinsically looking at fluctuation across days, we don't worry about padding since we couldn't. 
final.daily <- lapply(final.daily, function(x) person_mssd(x, variables = c('Emotion2', 'Emotion1'), person_id = c('person_id')))

final.esm <- lapply(final.esm, function(x) day_mssd(x, variables = c('Emotion2', 'Emotion1'), person_id = c('person_id'), day_id = 'daynr'))

我的 output 如下所示：

> if (!require("devtools")) install.packages("devtools", repos = "http://cran.us.r-project.org")
> 
> require(devtools)
> 
> if (!require("relativeVariability")) install_github('seanchrismurphy/relativeVariability')
> if (!require("emacalc")) install_github('seanchrismurphy/emacalc')
> if (!require("Smisc")) install_github('seanchrismurphy/Smisc')
> 
> 
> if (!require("pacman")) install.packages("pacman", repos = "http://cran.us.r-project.org")
> 
> pacman::p_load(Smisc, emacalc, relativeVariability, broom, metafor, gridExtra, psych, apa, knitr, 
+                pander, apaTables, lavaan, lme4, tidyr, reshape2, Hmisc, plyr, dplyr, zoo)
> 
> sessionInfo()
R version 4.0.2 (2020-06-22)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 17763)

Matrix products: default

locale:
[1] LC_COLLATE=Dutch_Netherlands.1252 
[2] LC_CTYPE=Dutch_Netherlands.1252   
[3] LC_MONETARY=Dutch_Netherlands.1252
[4] LC_NUMERIC=C                      
[5] LC_TIME=Dutch_Netherlands.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods  
[7] base     

other attached packages:
 [1] devtools_2.3.2          usethis_1.6.3          
 [3] pacman_0.5.1            zoo_1.8-9              
 [5] dplyr_1.0.2             plyr_1.8.6             
 [7] Hmisc_4.4-1             ggplot2_3.3.2          
 [9] Formula_1.2-3           survival_3.1-12        
[11] lattice_0.20-41         reshape2_1.4.4         
[13] tidyr_1.1.2             lme4_1.1-23            
[15] lavaan_0.6-7            apaTables_2.0.8        
[17] pander_0.6.3            knitr_1.29             
[19] apa_0.3.3               psych_2.0.9            
[21] gridExtra_2.3           metafor_2.4-0          
[23] Matrix_1.2-18           broom_0.7.5            
[25] relativeVariability_1.1 emacalc_0.0.0.9000     
[27] Smisc_1.0              

loaded via a namespace (and not attached):
 [1] nlme_3.1-148        fs_1.5.0            MBESS_4.8.0        
 [4] RColorBrewer_1.1-2  rprojroot_2.0.2     tools_4.0.2        
 [7] backports_1.1.9     utf8_1.1.4          R6_2.4.1           
[10] rpart_4.1-15        colorspace_1.4-1    nnet_7.3-14        
[13] withr_2.4.1         prettyunits_1.1.1   processx_3.4.3     
[16] tidyselect_1.1.0    mnormt_2.0.1        compiler_4.0.2     
[19] cli_2.0.2           htmlTable_2.0.1     desc_1.2.0         
[22] scales_1.1.1        checkmate_2.0.0     callr_3.4.4        
[25] stringr_1.4.0       digest_0.6.25       pbivnorm_0.6.0     
[28] foreign_0.8-80      minqa_1.2.4         rmarkdown_2.3      
[31] base64enc_0.1-3     jpeg_0.1-8.1        pkgconfig_2.0.3    
[34] htmltools_0.5.0     sessioninfo_1.1.1   htmlwidgets_1.5.1  
[37] rlang_0.4.10        rstudioapi_0.11     generics_0.0.2     
[40] magrittr_1.5        Rcpp_1.0.5          munsell_0.5.0      
[43] fansi_0.4.1         lifecycle_1.0.0     stringi_1.4.6      
[46] MASS_7.3-51.6       pkgbuild_1.1.0      grid_4.0.2         
[49] parallel_4.0.2      crayon_1.3.4        splines_4.0.2      
[52] tmvnsim_1.0-2       ps_1.3.4            pillar_1.5.1       
[55] boot_1.3-25         pkgload_1.1.0       stats4_4.0.2       
[58] glue_1.4.2          evaluate_0.14       latticeExtra_0.6-29
[61] remotes_2.2.0       data.table_1.13.0   png_0.1-7          
[64] vctrs_0.3.6         nloptr_1.2.2.2      testthat_2.3.2     
[67] gtable_0.3.0        purrr_0.3.4         assertthat_0.2.1   
[70] xfun_0.16           tibble_3.0.5        memoise_1.1.0      
[73] tinytex_0.25        cluster_2.1.0       statmod_1.4.34     
[76] ellipsis_0.3.1     
> 
> 
> 
> 
> 
> final.esm <- data.frame(person_id= c(1,1,1,1,1,1,2,2,2,2,2,2),
+                         daynr = c(1,1,1,2,2,2,1,1,1,2,2,2),
+                    Beep = c(1,2,3,4,5,6,1,2,3,4,5,6),
+                    Emotion1 = c(2,3,4,6,1,2,3,3,4,2,1,2),
+                    Emotion2 = c(1,4,5,7,1,2,4,5,3,1,1,2))
> 
> #final.esm <- read.csv(file = 'C:/Users/U539194/Desktop/Dataset 10 public.csv')
> 
> ######################################################
> 
> 
> # Here we define functions for calculating MSSD on the day and person level. 
> person_mssd <- function (data, variables, person_id) 
+ {
+   if (length(variables) == 1) {
+     mydots = setNames(rep("relativeVariability::MSSD(.)", length(variables)), 
+                       paste0(variables, "_person_mssd"))
+   }
+   else {
+     mydots = setNames("relativeVariability::MSSD(.)", "person_mssd")
+   }
+   out <- group_by_(data, .dots = person_id) %>% mutate_at(variables, 
+                                                           funs_(mydots)) %>% as.data.frame()
+   out
+ }
> 
> 
> day_mssd <- function (data, variables, person_id, day_id) 
+ {
+   if (length(variables) == 1) {
+     mydots = setNames(rep("relativeVariability::MSSD(.)", length(variables)), 
+                       paste0(variables, "_day_mssd"))
+   }
+   else {
+     mydots = setNames("relativeVariability::MSSD(.)", "day_mssd")
+   }
+   out <- group_by_(data, .dots = c(person_id, day_id)) %>% 
+     mutate_at(variables, funs_(mydots)) %>% as.data.frame()
+   out
+ }
> 
> # Trimming to valid obs.
> final.esm <- lapply(final.esm, function(x) trim_min_valid_obs(x, variables = c('Emotion1', 'Emotion2'), grouping = c('person_id', 'daynr'), min.obs = 1))
 Error in UseMethod("group_by_") : 
  no applicable method for 'group_by_' applied to an object of class "c('double', 'numeric')" > 
> # After we've calculated the basic person stuff for esm, we add in the buffer row and then calculate MSSD.
> final.esm <- lapply(final.esm, function(x) {x <- x %>% group_by(person_id, daynr) %>% do(add_row(.)); return(x)})
 Error in UseMethod("group_by_") : 
  no applicable method for 'group_by_' applied to an object of class "c('double', 'numeric')" > 
> # We need to fill the NA rows with the right person id otherwise all the processes that group by person ID (like MSSD person calc) will ignore them and it'll 
> # be as if we did nothing. 
> final.esm <- lapply(final.esm, function(x) x %>% ungroup() %>% mutate(person_id = zoo::na.locf(person_id)))
 Error in UseMethod("ungroup") : 
  no applicable method for 'ungroup' applied to an object of class "c('double', 'numeric')" > final.esm <- lapply(final.esm, function(x) person_mssd(x, variables = c('Emotion2', 'Emotion1'), person_id = c('person_id')))
 Error in UseMethod("group_by_") : 
  no applicable method for 'group_by_' applied to an object of class "c('double', 'numeric')" > 
> # And now, to be extra safe, we get rid of all those empty rows we just made. This removes rows with NA cols 5 less than the total number of cols (since we 
> # filled in person_id and also it'll have mssd and relmssd for posemo and negemo. )
> final.esm <- lapply(final.esm, function(x) x[apply(x, 1, function(x) sum(is.na(x))) < (ncol(x) - 5), ])
 Error in apply(x, 1, function(x) sum(is.na(x))) : 
  dim(X) must have a positive length > 
> # Since daily is intrinsically looking at fluctuation across days, we don't worry about padding since we couldn't. 
> final.daily <- lapply(final.daily, function(x) person_mssd(x, variables = c('Emotion2', 'Emotion1'), person_id = c('person_id')))
Error in lapply(final.daily, function(x) person_mssd(x, variables = c("Emotion2",  : 
  object 'final.daily' not found
> 
> final.esm <- lapply(final.esm, function(x) day_mssd(x, variables = c('Emotion2', 'Emotion1'), person_id = c('person_id'), day_id = 'daynr'))
 Error in UseMethod("group_by_") : 
  no applicable method for 'group_by_' applied to an object of class "c('double', 'numeric')" 

我真的不明白錯誤no applicable method for 'group_by_' applied to an object of class "c('double', 'numeric')"意思。

我對 R 比較陌生，因此感謝您的幫助！

問候，多米尼克

Answer 1

這些地方都不適合使用lapply 。 這些函數只是將數據幀作為輸入，所以你可以只使用這些函數。 例如：

final.esm <- trim_min_valid_obs(final.esm, variables = c('Emotion1', 'Emotion2'), grouping = c('person_id', 'daynr'), min.obs = 4)

（請注意，上面的代碼將返回一個空數據框，這是預期的，因為min.obs設置為 4）