Агрегирование промежуточных и общих итогов с помощью data.table
-
26-10-2019 - |
Вопрос
у меня есть data.table
в Р:
library(data.table)
set.seed(1)
DT = data.table(
group=sample(letters[1:2],100,replace=TRUE),
year=sample(2010:2012,100,replace=TRUE),
v=runif(100))
Агрегировать эти данные в сводную таблицу по группам и годам просто и элегантно:
table <- DT[,mean(v),by='group, year']
Однако агрегировать эти данные в сводную таблицу, включая промежуточные и общие итоги, немного сложнее и гораздо менее элегантно:
library(plyr)
yearTot <- DT[,list(mean(v),year='Total'),by='group']
groupTot <- DT[,list(mean(v),group='Total'),by='year']
Tot <- DT[,list(mean(v), year='Total', group='Total')]
table <- rbind.fill(table,yearTot,groupTot,Tot)
table$group[table$group==1] <- 'Total'
table$year[table$year==1] <- 'Total'
Это дает:
table[order(table$group, table$year), ]
Есть ли простой способ указать промежуточные и общие итоги с помощью data.table, например margins=TRUE
команда для плира?Я бы предпочел использовать data.table вместо plyr в своем наборе данных, поскольку это очень большой набор данных, который у меня уже есть в формате data.table.
Решение
В недавнем Devel Data.table вы можете использовать новую функцию под названием «Наборы группировки» для производства подтоги:
library(data.table)
set.seed(1)
DT = data.table(
group=sample(letters[1:2],100,replace=TRUE),
year=sample(2010:2012,100,replace=TRUE),
v=runif(100))
cube(DT, mean(v), by=c("group","year"))
# group year V1
# 1: a 2011 0.4176346
# 2: b 2010 0.5231845
# 3: b 2012 0.4306871
# 4: b 2011 0.4997119
# 5: a 2012 0.4227796
# 6: a 2010 0.2926945
# 7: NA 2011 0.4463616
# 8: NA 2010 0.4278093
# 9: NA 2012 0.4271160
#10: a NA 0.3901875
#11: b NA 0.4835788
#12: NA NA 0.4350153
cube(DT, mean(v), by=c("group","year"), id=TRUE)
# grouping group year V1
# 1: 0 a 2011 0.4176346
# 2: 0 b 2010 0.5231845
# 3: 0 b 2012 0.4306871
# 4: 0 b 2011 0.4997119
# 5: 0 a 2012 0.4227796
# 6: 0 a 2010 0.2926945
# 7: 2 NA 2011 0.4463616
# 8: 2 NA 2010 0.4278093
# 9: 2 NA 2012 0.4271160
#10: 1 a NA 0.3901875
#11: 1 b NA 0.4835788
#12: 3 NA NA 0.4350153
Другие советы
Я не знаю простого способа. Вот первый удар на реализации. Я не знаю margins=TRUE
В Plyr это то, что это делает?
crossby = function(DT, j, by) {
j = substitute(j)
ans = rbind(
DT[,eval(j),by],
DT[,list("Total",eval(j)),by=by[1]],
cbind("Total",DT[,eval(j),by=by[2]]),
list("Total","Total",DT[,eval(j)]),
use.names=FALSE
# 'use.names' argument added in data.table v1.8.0
)
setkeyv(ans,by)
ans
}
crossby(DT, mean(v), c("group","year"))
group year V1
[1,] a 2010 0.2926945
[2,] a 2011 0.4176346
[3,] a 2012 0.4227796
[4,] a Total 0.3901875
[5,] b 2010 0.5231845
[6,] b 2011 0.4997119
[7,] b 2012 0.4306871
[8,] b Total 0.4835788
[9,] Total 2010 0.4278093
[10,] Total 2011 0.4463616
[11,] Total 2012 0.4271160
[12,] Total Total 0.4350153
См. Ниже для решения - аналогично @Mattdowle's Upe - который занимает любое количество групп.
crossby2 <- function(data, j, by, grand.total = T, total.label = "(all)", value.label = "value") {
j = substitute(j)
# Calculate by each group
lst <- lapply(1:length(by), function(i) {
x <- data[, list(..VALUE.. = eval(j)), by = eval(by[1:i])]
if (i != length(by)) x[, (by[-(1:i)]) := total.label]
return(x)
})
# Grand total
if (grand.total) lst <- c(lst, list(data[, list(..VALUE.. = eval(j))][, (by) := total.label]))
# Combine all tables
res <- rbindlist(lst, use.names = T, fill = F)
# Change value column name
setnames(res, "..VALUE..", value.label)
# Set proper column order
setcolorder(res, c(by, value.label))
# Sort values
setkeyv(res, by)
return(res)
}
Используя текущие ответы, я добавил поддержку для нескольких мер и агрегатных функций и могу добавить индикатор уровня агрегации.
#' @title SQL's ROLLUP function
#' @description Returns data.table of aggregates value for each level of hierarchy provided in `by`.
#' @param x data.table input data.
#' @param j expression to evaluate in `j`, support multiple measures.
#' @param by character a hierarchy level for aggregations.
#' @param level logical, use `TRUE` to add `level` column of sub-aggregation.
#' @seealso [postgres: GROUPING SETS, CUBE, and ROLLUP](http://www.postgresql.org/docs/9.5/static/queries-table-expressions.html#QUERIES-GROUPING-SETS), [SO: Aggregating sub totals and grand totals with data.table](http://stackoverflow.com/a/24828162/2490497)
#' @return data.table
#' @examples
#' set.seed(1)
#' x = data.table(group=sample(letters[1:2],100,replace=TRUE),
#' year=sample(2010:2012,100,replace=TRUE),
#' v=runif(100))
#' rollup(x, .(vmean=mean(v), vsum=sum(v)), by = c("group","year"))
library(data.table)
rollup = function(x, j, by, level=FALSE){
stopifnot(is.data.table(x), is.character(by), length(by) >= 2L, is.logical(level))
j = substitute(j)
aggrs = rbindlist(c(
lapply(1:(length(by)-1L), function(i) x[, eval(j), c(by[1:i])][, (by[-(1:i)]) := NA]), # subtotals
list(x[, eval(j), c(by)]), # leafs aggregations
list(x[, eval(j)][, c(by) := NA]) # grand total
), use.names = TRUE, fill = FALSE)
if(level) aggrs[, c("level") := sum(sapply(.SD, is.na)), 1:nrow(aggrs), .SDcols = by]
setcolorder(aggrs, neworder = c(by, names(aggrs)[!names(aggrs) %in% by]))
setorderv(aggrs, cols = by, order=1L, na.last=TRUE)
return(aggrs[])
}
set.seed(1)
x = data.table(group=sample(letters[1:2],100,replace=TRUE),
year=sample(2010:2012,100,replace=TRUE),
month=sample(1:12,100,replace=TRUE),
v=runif(100))
rollup(x, .(vmean=mean(v), vsum=sum(v)), by = c("group","year","month"), level=TRUE)
Заимствование из этого ответа (https://stackoverflow.com/a/39536828/4241780), ниже представлена сводка всех подмножеств (в отличие от crossby2
, и rollup
которые, похоже, пропускают строки с 9 по 11 желаемого результата ОП).Эту функцию можно расширить до любого количества переменных или агрегатных переменных, хотя в ее текущем состоянии допускается только один тип агрегатной функции.Отлично подходит для расчета промежуточных итогов строк по групповым взаимодействиям (для чего я это использовал).
add_col_sums.data.table <- function(data, aggvars, byvars, FUN = sum, level = "level") {
# Find all possible subsets of your data
subsets <- lapply(0:length(byvars), combn, x = byvars, simplify = FALSE)
subsets <- do.call(c, subsets)
# Calculate summary value by each subset
agg_values <- lapply(subsets, function(x)
data[,lapply(.SD, FUN), by = x, .SDcols = aggvars])
# Pull them all into one dataframe
dat_out <- rbindlist(agg_values, fill = TRUE)
# Order columns and rows
setorderv(dat_out, byvars, na.last = TRUE)
setcolorder(dat_out, c(byvars, aggvars))
# Add level indication
dat_out[, c(level) := Reduce("+", lapply(.SD, is.na))]
# Return data.table
dat_out[]
}
add_col_sums.data.table(DT, "v", c("group", "year"), FUN = mean)