swirl - programacion estadistica r

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

Question

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:

1. fn_dt_agg1 (aquí no pude entender cómo parametrizar la función de agregación)
2. fn_dt_agg2 (inspirado en la respuesta de @jangorecki aquí que él llama "computación en el lenguaje")
3. fn_dt_agg3 (inspirado en la respuesta de @Arun aquí que parece ser otro enfoque de la metaprogramación)
4. 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

• Advanced R por Hadley Wickham: Expresiones
• Advanced R por Hadley Wickham: Funciones
• CRAN R Definición del lenguaje: informática en el idioma
• CRAN Evaluación no estándar
• Preguntas frecuentes sobre Data.table: Pasar expresiones de manera programática en j
• Meta-programación de Data.table
• R data.table join: SQL selecciona sintaxis similar en tablas unidas?
• Creación dinámica de llamadas para buscar múltiples columnas
• Asignación rápida de data.table de múltiples columnas por grupo desde la búsqueda
• ¿Cómo se puede trabajar de manera totalmente genérica en data.table en R con nombres de columna en variables?
• Usando get dentro de lapply, dentro de una función

Answer 1

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) .