Каков наилучший способ перебора group_by(), суммирования () и уникальных выходных имен на основе имен df?

#r

Вопрос:

Я пытаюсь научиться выполнять итерации без использования циклов, и как apply() семейство пакетов, так и map() семейство пакетов довольно сбивают меня с толку.

Ниже приведен пример кода, представляющий собой обобщенную версию данных, с которыми я работаю. Я начинаю с большого набора данных за многие месяцы или годы. Я должен отфильтровать его до конкретных периодов времени, представляющих интерес, а затем я выкладываю отдельные сводные таблицы на каждую страницу файла .xlsx, чтобы провести сравнение для отчета.

Реальная версия этого кода работает отлично, но мне нужно создать гораздо больше сводных/сравнительных таблиц, чем в этом примере, поэтому я хотел бы выяснить, как лучше всего это сделать функционально. Я работаю с r около полутора лет и могу проделать долгий путь, но сделать код более эффективным все еще немного выше моей головы.

Кроме того, я не совсем понимаю, как перебирать выходные имена для листов…или любую ситуацию, когда я хочу выполнить несколько итераций, которые выводят уникальные имена файлов на основе имени df.

Это мой первый пост здесь, поэтому я заранее приношу извинения за любые проблемы с форматированием/протоколом.

 library(tidyverse)
library(openxlsx)
library(janitor)
library(tibble)
library(tidyr)
library(dplyr)
library(lubridate)


rm(list=ls())

data <- tribble(
  ~Category, ~Date,        ~Area,     ~Count,
  "Fight",   "2021-01-04", "Area 1",  2,
  "Hug",     "2021-02-01", "Area 2",  4,
  "Dance",   "2021-03-21", "Area 3",  6,
  "Sleep",   "2021-04-18", "Area 3",  8,
  "Hug",     "2021-05-06", "Area 2",  2,
  "Dance",   "2021-06-30", "Area 1",  4,
  "Sleep",   "2021-01-29", "Area 1",  6,
  "Fight",   "2021-02-28", "Area 2",  8,
  "Dance",   "2021-03-15", "Area 3",  2,
  "Sleep",   "2021-04-08", "Area 3",  4,
  "Fight",   "2021-05-30", "Area 2",  6,
  "Hug",     "2021-06-10", "Area 1",  8
  
)

# define and order categorical variables

areas <- c("Area 1", "Area 2","Area 3")
cats <- c("Fight", "Hug", "Dance","Sleep")
data$Area <- factor(data$Area, levels = areas, ordered = TRUE)
data$Category <- factor(data$Category, levels = cats, ordered = TRUE)

# Filter and Summarise
this_14 <- filter(data, ymd(data$Date) >= ymd("2021-06-30")-13 amp; ymd(data$Date) <= ymd("2021-06-30")) %>%
  group_by(Category,Area,.drop = FALSE) %>%
  summarise(total = sum(Count)) %>%
  pivot_wider(names_from = `Area`,values_from = total) %>%
  adorn_totals(where=c("row","col"))
this_14[is.na(this_14)] <- 0

last_14 <- filter(data, ymd(data$Date) >= ymd("2021-06-30")-27 amp; ymd(data$Date) <= ymd("2021-06-30")-14) %>%
  group_by(Category,Area,.drop = FALSE) %>%
  summarise(total = sum(Count)) %>%
  pivot_wider(names_from = `Area`,values_from = total) %>%
  adorn_totals(where=c("row","col"))
last_14[is.na(last_14)] <- 0

prev_14 <- filter(data, ymd(data$Date) >= ymd("2021-06-30")-41 amp; ymd(data$Date) <= ymd("2021-06-30")-28) %>%
  group_by(Category,Area,.drop = FALSE) %>%
  summarise(total = sum(Count)) %>%
  pivot_wider(names_from = `Area`,values_from = total) %>%
  adorn_totals(where=c("row","col"))
prev_14[is.na(prev_14)] <- 0  

# Create Workbook
file <- paste("Dev/output_tables_eff.xlsx", sep="/")
wb <- createWorkbook()

# Define Sheets
sheet1 <- addWorksheet(wb, "this_14")
sheet2 <- addWorksheet(wb, "last_14")
sheet3 <- addWorksheet(wb, "prev_14")


# Set Dataframes to export
writeData(wb, sheet = sheet1,this_14)
writeData(wb, sheet = sheet2,last_14)
writeData(wb, sheet = sheet3,prev_14)

saveWorkbook(wb, file = file, overwrite = TRUE)
 

Комментарии:

1. Привет! Добро пожаловать в SO. Было бы полезно, если бы вы могли привести минимальный воспроизводимый пример и показать ожидаемый результат. Твой код взламывается для меня this_14 . Простой способ проверить это-использовать reprex пакет. Скопируйте свой код, а затем запустите reprex::reprex()

2. @nniloc Я использовал reprex для создания этого mre. этот код выполняется без ошибок и создает файл xlsx с тремя листами, каждый из которых содержит другую сводную таблицу

3. @nniloc Я думаю, что ошибки, которые вы получаете, связаны с парой дополнительных необходимых библиотек. Я добавил их выше

Ответ №1:

Вот опция, использующая функцию для создания сводных таблиц и сохранения их в виде вкладок в книге. Я использовал purrr::map2 и предоставил список дат начала (например, 0, -14, -28) и список имен для листов Excel.

 library(tidyverse)
library(openxlsx)
library(janitor)
library(lubridate)

create_table <- function(start_date, sheet_name, df, wb) {
  
  df_out <- df %>%
    mutate(Date = ymd(Date)) %>%
    filter(Date >= ymd("2021-06-30")   (start_date - 13) amp; Date <= ymd("2021-06-30")   start_date) %>%
    group_by(Category, Area) %>%
    summarise(total = sum(Count)) %>%
    pivot_wider(names_from = `Area`, values_from = total) %>%
    adorn_totals(where = c("row", "col")) %>%
    replace(is.na(.), 0)
  
  
  addWorksheet(wb, sheet_name)
  writeData(wb, sheet = sheet_name, df_out)

} 

wb <- createWorkbook()

map2(c(0, -14, -28), # desired start dates
     c('this_14', 'last_14', 'prev_14'), # names for the Excel tabs
     create_table, 
     df = data, 
     wb = wb)

saveWorkbook(wb, file = "output_tables_eff.xlsx", overwrite = TRUE)
 

Данные

 data <- tribble(
  ~Category, ~Date,        ~Area,     ~Count,
  "Fight",   "2021-01-04", "Area 1",  2,
  "Hug",     "2021-02-01", "Area 2",  4,
  "Dance",   "2021-03-21", "Area 3",  6,
  "Sleep",   "2021-04-18", "Area 3",  8,
  "Hug",     "2021-05-06", "Area 2",  2,
  "Dance",   "2021-06-30", "Area 1",  4,
  "Sleep",   "2021-01-29", "Area 1",  6,
  "Fight",   "2021-02-28", "Area 2",  8,
  "Dance",   "2021-03-15", "Area 3",  2,
  "Sleep",   "2021-04-08", "Area 3",  4,
  "Fight",   "2021-05-30", "Area 2",  6,
  "Hug",     "2021-06-10", "Area 1",  8
  
)

# define and order categorical variables

areas <- c("Area 1", "Area 2","Area 3")
cats <- c("Fight", "Hug", "Dance","Sleep")
data$Area <- factor(data$Area, levels = areas, ordered = TRUE)
data$Category <- factor(data$Category, levels = cats, ordered = TRUE)
 

Комментарии:

1. Это потрясающий подход. Спасибо! Именно так я понял, что map() или map2() могут работать, но я не мог понять структуру. Это будет очень полезно для преобразования моего реального сценария.