Как совместить lapply с dplyr в функции - PullRequest
Новая
       30

Как совместить lapply с dplyr в функции

2 голосов
/ 20 октября 2019

Ниже приведен пример фрейма данных, который я создал вместе с ожидаемым выводом. 

df = data.frame(color = c("Yellow", "Blue", "Green", "Red", "Magenta"),
                values = c(24, 24, 34, 45, 49),
                Quarter = c("Period1","Period2" , "Period3", "Period3", "Period1"),
                Market = c("Camden", "StreetA", "DansFireplace", "StreetA", "DansFireplace"))


dfXQuarter = df %>% group_by(Quarter) %>% summarise(values = sum(values)) %>%
  mutate(cut = "Quarter") %>% data.frame()

colnames(dfXQuarter)[1] = "Grouping"

dfXMarket = df %>% group_by(Market) %>% summarise(values = sum(values)) %>% 
  mutate(cut = "Market")%>% data.frame()
colnames(dfXMarket)[1] = "Grouping"


df_all = rbind(dfXQuarter, dfXMarket)

Теперь я для краткости хочу скомпилировать это в функцию и использовать lapply. Ниже приведена моя попытка того же самого - 

list = c("Market", "Quarter")


df_all <- do.call(rbind, lapply(list, function(x){
  df_l= df %>% group_by(x) %>% 
    summarise(values = sum(values)) %>% 
    mutate(cut= x) %>% 
    data.frame()
   colnames(df_l)[df_l$x] = "Grouping"
  df_l
}))

Этот блок кода дает мне ошибку.

Мне нужно, чтобы вывод был точной копией вывода 'df_all' для дальнейших операций.

Как правильно написать эту функцию?

Ответы [ 2 ]

3 голосов
/ 20 октября 2019

Мы можем использовать purrr::map_dfr

library(dplyr)
library(purrr) 
#Don't use the R build-in type e.g. list in variables name 
lst <- c("Market", "Quarter")
#Use map if you need the output as a list
map_dfr(lst, ~df %>% group_by("Grouping"=!!sym(.x)) %>% 
                                   summarise(values = sum(values)) %>%
                                   mutate(cut = .x) %>% 
                                   #To avoid the warning massage from bind_rows
                                   mutate_if(is.factor, as.character))

# A tibble: 6 x 3
  Grouping      values cut    
  <chr>          <dbl> <chr>  
1 Camden            24 Market 
2 DansFireplace     83 Market 
3 StreetA           69 Market 
4 Period1           73 Quarter
5 Period2           24 Quarter
6 Period3           79 Quarter

Мы можем исправить первое решение с помощью

  1. , изменив group_by(x) на group_by_at(x), поскольку x здесь является строкой.
  2. Используйте colnames(df_l)[colnames(df_l)==x] <- "Grouping" для именования переменной группировки.
0 голосов
/ 20 октября 2019

Не красиво, но работает и не требует аккуратных функций: 

groupwise_summation <- function(df, grouping_vecs){


  # Split, apply, combine: 

  tmpdf <- do.call(rbind, lapply(split(df, df[,grouping_vecs]), function(x){sum(x$values)}))

  # Clean up the df: 

  data.frame(cbind(cut = row.names(tmpdf), value = as.numeric(tmpdf)), row.names = NULL)


}


# Apply and combine:

df_all <- rbind(groupwise_summation(df, c("Quarter")), groupwise_summation(df, c("Market")))


# Note inside the c(), you can use multiple grouping variables.
...