swirl - programacion estadistica r

Programación/metaprogramación/computación funcional de data.tablets en el lenguaje (1)

Estoy explorando diferentes formas de ajustar una función de agregación (pero realmente podría ser cualquier tipo de función) usando data.table (también se proporciona un ejemplo de dplyr) y me preguntaba sobre las mejores prácticas para la programación / metaprogramación funcional con respecto a

rendimiento (¿Importa la implementación con respecto a la posible optimización que se pueda aplicar a data.table)?
legibilidad (¿existe un estándar comúnmente acordado, por ejemplo, en la mayoría de los paquetes que utilizan data.table)
facilidad de generalización (¿hay diferencias en la forma en que la metaprogramación es "generalizable")?

La aplicación básica es agregar una tabla de forma flexible, es decir, parametrizar las variables a agregar, las dimensiones a agregar por, los respectivos nombres de variables resultantes de ambos y la función de agregación. He implementado (casi) la misma función en tres formas data.table y one dplyr:

fn_dt_agg1 (aquí no pude entender cómo parametrizar la función de agregación)
fn_dt_agg2 (inspirado en la respuesta de @jangorecki aquí que él llama "computación en el lenguaje")
fn_dt_agg3 (inspirado en la respuesta de @Arun aquí que parece ser otro enfoque de la metaprogramación)
fn_df_agg1 (mi humilde acercamiento de lo mismo en dplyr)

bibliotecas

library(data.table) library(dplyr)

datos

n_size <- 1*10^6 sample_metrics <- sample(seq(from = 1, to = 100, by = 1), n_size, rep = T) sample_dimensions <- sample(letters[10:12], n_size, rep = T) df <- data.frame( a = sample_metrics, b = sample_metrics, c = sample_dimensions, d = sample_dimensions, x = sample_metrics, y = sample_dimensions, stringsAsFactors = F) dt <- as.data.table(df)

implementaciones

1. fn_dt_agg1

fn_dt_agg1 <- function(dt, metric, metric_name, dimension, dimension_name) { temp <- dt[, setNames(lapply(.SD, function(x) {sum(x, na.rm = T)}), metric_name), keyby = dimension, .SDcols = metric] temp[] } res_dt1 <- fn_dt_agg1( dt = dt, metric = c("a", "b"), metric_name = c("a", "b"), dimension = c("c", "d"), dimension_name = c("c", "d"))

2. fn_dt_agg2

fn_dt_agg2 <- function(dt, metric, metric_name, dimension, dimension_name, agg_type) { j_call = as.call(c( as.name("."), sapply(setNames(metric, metric_name), function(var) as.call(list(as.name(agg_type), as.name(var), na.rm = T)), simplify = F) )) dt[, eval(j_call), keyby = dimension][] } res_dt2 <- fn_dt_agg2( dt = dt, metric = c("a", "b"), metric_name = c("a", "b"), dimension = c("c", "d"), dimension_name = c("c", "d"), agg_type = c("sum")) all.equal(res_dt1, res_dt2) #TRUE

3. fn_dt_agg3

fn_dt_agg3 <- function(dt, metric, metric_name, dimension, dimension_name, agg_type) { e <- eval(parse(text=paste0("function(x) {", agg_type, "(", "x, na.rm = T)}"))) temp <- dt[, setNames(lapply(.SD, e), metric_name), keyby = dimension, .SDcols = metric] temp[] } res_dt3 <- fn_dt_agg3( dt = dt, metric = c("a", "b"), metric_name = c("a", "b"), dimension = c("c", "d"), dimension_name = c("c", "d"), agg_type = "sum") all.equal(res_dt1, res_dt3) #TRUE

4. fn_df_agg1

fn_df_agg1 <- function(df, metric, metric_name, dimension, dimension_name, agg_type) { all_vars <- c(dimension, metric) all_vars_new <- c(dimension_name, metric_name) dots_group <- lapply(dimension, as.name) e <- eval(parse(text=paste0("function(x) {", agg_type, "(", "x, na.rm = T)}"))) df %>% select_(.dots = all_vars) %>% group_by_(.dots = dots_group) %>% summarise_each_(funs(e), metric) %>% rename_(.dots = setNames(all_vars, all_vars_new)) } res_df1 <- fn_df_agg1( df = df, metric = c("a", "b"), metric_name = c("a", "b"), dimension = c("c", "d"), dimension_name = c("c", "d"), agg_type = "sum") all.equal(res_dt1, as.data.table(res_df1)) #"Datasets has different keys. ''target'': c, d. ''current'' has no key."

benchmarking

Solo por curiosidad y para mi yo futuro y otras partes interesadas, ejecuté un punto de referencia de las 4 implementaciones que potencialmente ya arroja luz sobre el problema de rendimiento (aunque no soy un experto en benchmarking, por favor disculpe si no he aplicado comúnmente mejores prácticas acordadas). Esperaba que fn_dt_agg1 fuera el más rápido, ya que tiene un parámetro menos (función de agregación) pero eso no parece tener un impacto considerable. También me sorprendió la función dplyr relativamente lenta, pero esto puede deberse a una mala elección de diseño en mi extremo.

library(microbenchmark) bench_res <- microbenchmark( fn_dt_agg1 = fn_dt_agg1( dt = dt, metric = c("a", "b"), metric_name = c("a", "b"), dimension = c("c", "d"), dimension_name = c("c", "d")), fn_dt_agg2 = fn_dt_agg2( dt = dt, metric = c("a", "b"), metric_name = c("a", "b"), dimension = c("c", "d"), dimension_name = c("c", "d"), agg_type = c("sum")), fn_dt_agg3 = fn_dt_agg3( dt = dt, metric = c("a", "b"), metric_name = c("a", "b"), dimension = c("c", "d"), dimension_name = c("c", "d"), agg_type = c("sum")), fn_df_agg1 = fn_df_agg1( df = df, metric = c("a", "b"), metric_name = c("a", "b"), dimension = c("c", "d"), dimension_name = c("c", "d"), agg_type = "sum"), times = 100L) bench_res # Unit: milliseconds # expr min lq mean median uq max neval # fn_dt_agg1 28.96324 30.49507 35.60988 32.62860 37.43578 140.32975 100 # fn_dt_agg2 27.51993 28.41329 31.80023 28.93523 33.17064 84.56375 100 # fn_dt_agg3 25.46765 26.04711 30.11860 26.64817 30.28980 153.09715 100 # fn_df_agg1 88.33516 90.23776 97.84826 94.28843 97.97154 172.87838 100

otros recursos

No recomiendo eval(parse()) . Puede lograr lo mismo que en el enfoque tres sin él:

fn_dt_agg4 <- function(dt, metric, metric_name, dimension, dimension_name, agg_type) { e <- function(x) getFunction(agg_type)(x, na.rm = T) temp <- dt[, setNames(lapply(.SD, e), metric_name), keyby = dimension, .SDcols = metric] temp[] }

Esto también evita algunos riesgos de seguridad.

PD: Puede verificar lo que data.table está haciendo con respecto a las optimizaciones configurando options("datatable.verbose" = TRUE) .