Carga de datos y limpieza

library(magrittr)
options(dplyr.summarise.inform = FALSE)
flights <- nycflights13::flights
data.table::setDT(flights)
data <- flights[!is.na(dep_delay) & !is.na(arr_delay), 
                .(destino = dest, atraso = arr_delay,
                  aerolinea = carrier)]

destino	atraso	aerolinea
IAH	11	UA
IAH	20	UA
MIA	33	AA
BQN	-18	B6

Problema a resolver:

Para cada combinación de 4 aerolíneas, calcular la varianza y el promedio en el atraso a cada destino.

Un caso de uso para calcular estas combinaciones, sería buscar una diversificación para disminuir riesgos.

Cálculo de combinaciones

Con la función combn, generamos todas las combinaciones de 4 aerolíneas. Obtenemos una lista con 1820 elementos. Con esta estructura podremos apalancarnos de la funciones de purrr (o en R base la familia de funciones *apply)

combinaciones <- combn(x = unique(data$aerolinea), 
                       m = 4,
                       simplify = FALSE)

Ahora, creamos las funciones que reciben una de las combinaciones calculadas y devuelve el resumen deseado para esta combinación. Acá tenemos 2 opciones: un resumen con dplyr y su equivalente en data.table.

dplyr_1 <- function(combinacion){
  data %>%
    dplyr::filter(aerolinea %in% combinacion) %>%
    dplyr::group_by(destino) %>%
    dplyr::summarise(media = mean(atraso),
                     varianza = var(atraso))
}
dt_1 <- function(combinacion){
  data[aerolinea %chin% combinacion,
       .(media = mean(atraso),
         varianza = var(atraso)),
       by = destino]
}

Obtenemos los mismos resultados para ambos casos.

resultados_dplyr <- dplyr_1(combinaciones[[1]]) %>% 
  dplyr::arrange(destino)

resultados_dt <- dt_1(combinaciones[[1]])[
  order(destino)]

kableExtra::kable(head(resultados_dt, 4))

destino	media	varianza
ABQ	4.381890	1762.4346
ACK	4.852273	899.1682
ANC	-2.500000	694.5714
ATL	7.453951	2170.5701

all.equal(data.table::as.data.table(resultados_dplyr),
          resultados_dt)

## [1] TRUE

Calculamos cuánto duran los cálculos hechos de manera secuencial con ambos métodos:

Nota: Todas las mediciones fueron hechas múltiples veces y se verificó la consistencia entre las corridas

Observamos que la opción con data.table es alrededor de 3 veces más rápida para calcular todos nuestros resúmenes.

tictoc::tic()

res_dplyr_1 <- purrr::map(combinaciones, dplyr_1)
tiempo_dplyr <- tictoc::toc(quiet = TRUE)

tictoc::tic()

res_dt_1 <- purrr::map(combinaciones, dt_1)
tiempo_dt <- tictoc::toc(quiet = TRUE)

tiempo_dplyr	tiempo_dt
29.54	12.55

¿Qué está pasando internamente?

Activemos las opción de que data.table nos diga qué está haciendo internamente.

options(datatable.verbose = TRUE)

dt_1(combinaciones[[1]])

En vez de utilizar las funciones \(mean\) y \(var\) de R base, data.table utiliza las funciones \(gmean\) y \(gvar\) que están optimizadas en C++ para resúmenes por grupos.

Funciones que utilizan GForce

Las siguientes funciones están internamente optimizadas:


min	var	first
max	sd	last
mean	sum	head
median	prod	tail
.N

Es importante tomar esto en cuenta, pues esas son las únicas funciones que están optimizadas. Por ejemplo, una suma dentro del cálculo de la varianza apaga GForce

dt_2 <- function(combinacion){
  data[aerolinea %chin% combinacion,
       .(media = mean(atraso),
         varianza = 0 + var(atraso)),
       by = destino]
}

dt_2(combinaciones[[1]])

dplyr tiene su equivalente llamado Hybrid Evaluation, que también optimiza resúmenes por grupo.

¡Resúmenes (más) rápido!

data.table tiene la capacidad de indexar columnas, por lo que los filtros y resúmenes los hace más rápido aún.

dt_3 <- function(combinacion){
  data[.(combinacion), # Filtro a la aerolínea
       .(media = mean(atraso),
         varianza = var(atraso)),
       by = 'destino']
}

tictoc::tic()
data.table::setkey(data, aerolinea)

res_dt_3 <- purrr::map(combinaciones, dt_3)
tiempo_dt_3 <- tictoc::toc(quiet = TRUE)

kableExtra::kable(data.table::data.table(
  tiempo_dt = tiempo_dt$toc -tiempo_dt$tic,
  tiempo_dt_3 = tiempo_dt_3$toc - tiempo_dt_3$tic
))

tiempo_dt	tiempo_dt_3
12.55	10.28

Vemos que hemos optimizado nuestros resúmenes aun más. Además, podríamos paralelizar nuestros resúmenes y hacer millones en poco tiempo.

Referencias

Glasman, Brodie A strategy for faster group statistics https://www.brodieg.com/2019/02/24/a-strategy-for-faster-group-statisitics/

Gorecki, Jan Optimizations in data.table https://jangorecki.gitlab.io/data.table/library/data.table/html/datatable-optimize.html