Подведение итогов на нескольких уровнях иерархии

Question

У меня есть набор данных с четырьмя уровнями: наблюдения (то есть период, в течение которого наблюдается учитель), учителя, школы, школьные подразделения. Наблюдения вложены в учителей, которые вложены в школы и т. Д.

Каждая строка в данных соответствует случаю, когда наблюдается учитель.

На каждом уровне иерархии я хочувычислить mean, sd, min и max для каждой из нескольких переменных (x1, x2 и x3 в смоделированных данных, но в реальных данных ~ 12). И я хочу, чтобы все эти резюме были в одном кадре данных.

Приведенный ниже код сделает это, но мне это кажется неуклюжим. Точнее говоря, несколько вещей, которые меня беспокоят:

1. Я не мог понять, как сделать rename внутри функции, которую я написал, используя значение group_var, поэтому я прибегнул к ручному выполнению этого снаружи. функций.
2. Я заканчиваю тем, что создаю несколько фреймов данных, а затем использую left_join, чтобы соединить их вместе в конце (снова вручную).
3. В конечном счете, я чувствую, что, возможно, есть способ(возможно, используя что-то в purrr, чтобы «отогнать» слои иерархии и агрегирования, но это ускользает от меня.

Любые советы о том, как упростить это, и, в частности, о том, как передать group_varзначения до rename_at, будет высоко ценится!

library(tidyverse)
library(treemap)

df <- random.hierarchical.data(n = 200, depth = 4) %>%
  rename(div = index1,
         sch = index2,
         teacher = index3,
         obs = index4,
         x1 = x) %>%
  mutate(x2 = rlnorm(200),
         x3 = rlnorm(200))

sum_func <- function(data, sum_vars, ...) {
  group_vars <- enquos(...)

  data %>%
    group_by(!!!group_vars) %>%
    summarize_at(vars(sum_vars),
                 list(
                   ~mean(., na.rm = TRUE),
                   ~sd(., na.rm = TRUE),
                   ~min(., na.rm = TRUE),
                   ~max(., na.rm = TRUE)
                 )) %>%
    ungroup()
}

use_vars <- c("x1", "x2", "x3")

teacher_sum <- sum_func(data = df, sum_vars = use_vars, div, sch, teacher) %>%
  rename_at(vars(-c("teacher", "sch", "div")), ~str_replace_all(., "^", "teacher_"))

sch_sum <- sum_func(df, sum_vars = use_vars, div, sch) %>%
  rename_at(vars(-c("sch", "div")), ~str_replace_all(., "^", "sch_"))

div_sum <- sum_func(df, sum_vars = use_vars, div) %>%
  rename_at(vars(-c("div")), ~str_replace_all(., "^", "div_"))

full <- teacher_sum %>%
  left_join(sch_sum, by = c("sch", "div")) %>%
  left_join(div_sum, by = "div")

Answer 1

Вы были довольно близко. Приведенный ниже код работает, но я не уверен, как полностью автоматизировать соединение, так как логика мне не ясна

sum_func <- function(data, sum_vars, replacement, ...) {
  group_vars <- enquos(...)

  data %>%
    group_by(!!!group_vars) %>%
    summarize_at(vars(sum_vars),
                 list(
                   ~mean(., na.rm = TRUE),
                   ~sd(., na.rm = TRUE),
                   ~min(., na.rm = TRUE),
                   ~max(., na.rm = TRUE)
                 )) %>%
    ungroup() %>%
    rename_at(vars(-c(!!!group_vars)), 
              ~str_replace_all(., "^", replacement))
}

use_vars <- c("x1", "x2", "x3")

teacher_sum <- sum_func(data = df, 
                        sum_vars = use_vars, 
                        replacement = "teacher_",
                        div, sch, teacher)

sch_sum <- sum_func(data = df, 
                    sum_vars = use_vars, 
                    replacement = "sch_",
                    div, sch)
div_sum <- sum_func(df, 
                    sum_vars = use_vars, 
                    replacement = "div_",
                    div)