studio - Concatenación rápida de columnas data.table en una columna de cadena
dt:: datatable r (3)
Esto utiliza unite desde el paquete tidyr . Puede que no sea el más rápido, pero probablemente sea más rápido que el código R codificado a mano.
library(tidyr)
system.time(
DNew <- DT %>% unite(State, ConcatCols, sep = "", remove = FALSE)
)
# user system elapsed
# 14.974 0.183 15.343
DNew[1:10]
# State x y a b c d e f
# 1: foo211621bar foo bar 2 1 1 6 2 1
# 2: foo532735bar foo bar 5 3 2 7 3 5
# 3: foo965776bar foo bar 9 6 5 7 7 6
# 4: foo221284bar foo bar 2 2 1 2 8 4
# 5: foo485976bar foo bar 4 8 5 9 7 6
# 6: foo566778bar foo bar 5 6 6 7 7 8
# 7: foo892636bar foo bar 8 9 2 6 3 6
# 8: foo836672bar foo bar 8 3 6 6 7 2
# 9: foo963926bar foo bar 9 6 3 9 2 6
# 10: foo385216bar foo bar 3 8 5 2 1 6
Dada una lista arbitraria de nombres de columnas en una data.table , quiero concatenar el contenido de esas columnas en una sola cadena almacenada en una nueva columna. Las columnas que necesito para concatenar no siempre son las mismas, por lo que debo generar la expresión para hacerlo sobre la marcha.
Tengo la sospecha de que estoy usando la llamada eval(parse(...)) para ser reemplazado por algo un poco más elegante, pero el método a continuación es el más rápido que he podido obtener hasta ahora.
Con 10 millones de filas, esto toma aproximadamente 21.7 segundos en esta muestra de datos (base R paste0 toma un poco más de tiempo - 23.6 segundos) . Mis datos reales tienen 18-20 columnas concatenadas y hasta 100 millones de filas, por lo que la desaceleración se vuelve un poco más impráctica.
¿Alguna idea para acelerar esto?
Metodos actuales
library(data.table)
library(stringi)
RowCount <- 1e7
DT <- data.table(x = "foo",
y = "bar",
a = sample.int(9, RowCount, TRUE),
b = sample.int(9, RowCount, TRUE),
c = sample.int(9, RowCount, TRUE),
d = sample.int(9, RowCount, TRUE),
e = sample.int(9, RowCount, TRUE),
f = sample.int(9, RowCount, TRUE))
## Generate an expression to paste an arbitrary list of columns together
ConcatCols <- c("x","a","b","c","d","e","f","y")
PasteStatement <- stri_c(''stri_c('',stri_c(ConcatCols,collapse = ","),'')'')
print(PasteStatement)
da
[1] "stri_c(x,a,b,c,d,e,f,y)"
que luego se usa para concatenar las columnas con la siguiente expresión:
DT[,State := eval(parse(text = PasteStatement))]
Muestra de salida:
x y a b c d e f State
1: foo bar 4 8 3 6 9 2 foo483692bar
2: foo bar 8 4 8 7 8 4 foo848784bar
3: foo bar 2 6 2 4 3 5 foo262435bar
4: foo bar 2 4 2 4 9 9 foo242499bar
5: foo bar 5 9 8 7 2 7 foo598727bar
Resultados de perfiles
Actualización 1: fread , fwrite y sed
Siguiendo la sugerencia de @Gregor, intente usar sed para hacer la concatenación en el disco. Gracias a las funciones rápidas y rápidas de fread , pude escribir las columnas en el disco, eliminar los delimitadores de comas que usan sed y luego volver a leer en la salida posprocesada en aproximadamente 18.3 segundos , lo que no es lo suficientemente rápido para ¡Haga el cambio, pero una tangente interesante no obstante!
ConcatCols <- c("x","a","b","c","d","e","f","y")
fwrite(DT[,..ConcatCols],"/home/xxx/DT.csv")
system("sed ''s/,//g'' /home/xxx/DT.csv > /home/xxx/DT_Post.csv ")
Post <- fread("/home/xxx/DT_Post.csv")
DT[,State := Post[[1]]]
Desglose de los 18.3 segundos generales (no se puede usar profvis ya que sed es invisible para el perfilador R)
-
data.table::fwrite()- 0.5 segundos -
sed- 14.8 segundos -
data.table::fread()- 3.0 segundos -
:=- 0.0 segundos
Si nada más, esto es un testimonio del extenso trabajo de los autores de data.table sobre las optimizaciones de rendimiento para la E / S de disco. (Estoy usando la versión de desarrollo 1.10.5 que agrega multihilo a fread , fwrite ha sido multihilo durante algún tiempo).
Una advertencia: si existe una solución alternativa para escribir el archivo usando fwrite y un separador en blanco como lo sugiere @Gregor en otro comentario a continuación, ¡este método podría reducirse a ~ 3.5 segundos!
Actualice esta tangente: datos de la tabla bifurcada y comentó la línea que requiere un separador mayor que la longitud 0, ¿tiene misteriosamente algunos espacios en su lugar? Después de causar un puñado de segfaults tratando de meterse con las partes internas de C , puse esta en hielo por el momento. La solución ideal no requeriría escribir en el disco y mantendría todo en la memoria.
Actualización 2: sprintf para casos específicos de enteros
Una segunda actualización aquí: aunque incluí cadenas en mi ejemplo de uso original, mi caso de uso real concatena exclusivamente valores enteros (que siempre se pueden asumir como no nulos en función de los pasos de limpieza en sentido ascendente).
Dado que el caso de uso es muy específico y difiere de la pregunta original, no compararé directamente los tiempos con los publicados anteriormente. Sin embargo, una stringi es que si bien el stringi maneja muy bien muchos formatos de codificación de caracteres, tipos de vectores mixtos sin necesidad de especificarlos, y hace un montón de manejo de errores fuera de la caja, esto agrega algo de tiempo (lo que probablemente vale la pena para la mayoría de los casos). ) .
Al utilizar la función sprintf la base R e informarle por adelantado que todas las entradas serán enteros, podemos recortar aproximadamente el 30% del tiempo de ejecución para 5 millones de filas con 18 columnas de enteros para calcular. (20.3 segundos en lugar de 28.9)
library(data.table)
library(stringi)
RowCount <- 5e6
DT <- data.table(x = "foo",
y = "bar",
a = sample.int(9, RowCount, TRUE),
b = sample.int(9, RowCount, TRUE),
c = sample.int(9, RowCount, TRUE),
d = sample.int(9, RowCount, TRUE),
e = sample.int(9, RowCount, TRUE),
f = sample.int(9, RowCount, TRUE))
## Generate an expression to paste an arbitrary list of columns together
ConcatCols <- list("a","b","c","d","e","f")
## Do it 3x as many times
ConcatCols <- c(ConcatCols,ConcatCols,ConcatCols)
## Using stringi::stri_c ---------------------------------------------------
stri_joinStatement <- stri_c(''stri_join('',stri_c(ConcatCols,collapse = ","),'', sep="", collapse=NULL, ignore_null=TRUE)'')
DT[, State := eval(parse(text = stri_joinStatement))]
## Using sprintf -----------------------------------------------------------
sprintfStatement <- stri_c("sprintf(''",stri_flatten(rep("%i",length(ConcatCols))),"'', ",stri_c(ConcatCols,collapse = ","),")")
DT[,State_sprintf_i := eval(parse(text = sprintfStatement))]
Las declaraciones generadas son las siguientes:
> cat(stri_joinStatement)
stri_join(a,b,c,d,e,f,a,b,c,d,e,f,a,b,c,d,e,f, sep="", collapse=NULL, ignore_null=TRUE)
> cat(sprintfStatement)
sprintf(''%i%i%i%i%i%i%i%i%i%i%i%i%i%i%i%i%i%i'', a,b,c,d,e,f,a,b,c,d,e,f,a,b,c,d,e,f)
Actualización 3: R no tiene que ser lento.
Basándome en la respuesta de @Martin Modrák, armé un paquete de pony de un solo truco basado en algunos datos de data.table internas especializados para el caso especializado de "entero de un solo dígito": fastConcat . (No lo busque en CRAN pronto, pero puede usarlo bajo su propio riesgo si lo instala desde github repo, msummersgill/fastConcat ).
Probablemente, alguien que entienda mejor a c podría mejorarlo mucho más, pero por ahora, está ejecutando el mismo caso que en la Actualización 2 en 2,5 segundos , aproximadamente 8 veces más rápido que sprintf() y 11,5 veces más rápido que stringi::stri_c() Método que estaba usando originalmente.
Para mí, esto resalta la gran oportunidad de mejoras de rendimiento en algunas de las operaciones más simples en R como la concatenación rudimentaria de cadenas de vectores con una mejor sintonía c . Supongo que personas como @Matt Dowle han visto esto durante años, si tan solo tuviera tiempo para reescribir toda R , no solo el cuadro de datos.
No sé qué tan representativos son los datos de muestra para sus datos reales, pero en el caso de sus datos muestreados, puede lograr una mejora sustancial en el rendimiento concatenando cada combinación única de ConcatCols una vez en lugar de varias veces.
Eso significa que para los datos de muestra, estarías viendo ~ 500k concatenaciones frente a 10 millones si haces todos los duplicados también.
Vea el siguiente código y ejemplo de tiempo:
system.time({
setkeyv(DT, ConcatCols)
DTunique <- unique(DT[, ConcatCols, with=FALSE], by = key(DT))
DTunique[, State := do.call(paste, c(DTunique, sep = ""))]
DT[DTunique, State := i.State, on = ConcatCols]
})
# user system elapsed
# 7.448 0.462 4.618
Aproximadamente la mitad del tiempo se gasta en la parte setkey . En caso de que sus datos ya estén ingresados, el tiempo se reduce aún más a un poco más de 2 segundos.
setkeyv(DT, ConcatCols)
system.time({
DTunique <- unique(DT[, ConcatCols, with=FALSE], by = key(DT))
DTunique[, State := do.call(paste, c(DTunique, sep = ""))]
DT[DTunique, State := i.State, on = ConcatCols]
})
# user system elapsed
# 2.526 0.280 2.181
C al rescate!
Robando algo de código de data.table, podemos escribir una función en C que funciona mucho más rápido (y podría ser paralelizada para ser incluso más rápida).
Primero asegúrese de tener una cadena de herramientas de C ++ que funcione con:
library(inline)
fx <- inline::cfunction( signature(x = "integer", y = "numeric" ) , ''
return ScalarReal( INTEGER(x)[0] * REAL(y)[0] ) ;
'' )
fx( 2L, 5 ) #Should return 10
Entonces esto debería funcionar (asumiendo datos de solo enteros, pero el código puede extenderse a otros tipos):
library(inline)
library(data.table)
library(stringi)
header <- "
//Taken from https://github.com/Rdatatable/data.table/blob/master/src/fwrite.c
static inline void reverse(char *upp, char *low)
{
upp--;
while (upp>low) {
char tmp = *upp;
*upp = *low;
*low = tmp;
upp--;
low++;
}
}
void writeInt32(int *col, size_t row, char **pch)
{
char *ch = *pch;
int x = col[row];
if (x == INT_MIN) {
*ch++ = ''N'';
*ch++ = ''A'';
} else {
if (x<0) { *ch++ = ''-''; x=-x; }
// Avoid log() for speed. Write backwards then reverse when we know how long.
char *low = ch;
do { *ch++ = ''0''+x%10; x/=10; } while (x>0);
reverse(ch, low);
}
*pch = ch;
}
//end of copied code
"
worker_fun <- inline::cfunction( signature(x = "list", preallocated_target = "character", columns = "integer", start_row = "integer", end_row = "integer"), includes = header , "
const size_t _start_row = INTEGER(start_row)[0] - 1;
const size_t _end_row = INTEGER(end_row)[0];
const int max_out_len = 256 * 256; //max length of the final string
char buffer[max_out_len];
const size_t num_elements = _end_row - _start_row;
const size_t num_columns = LENGTH(columns);
const int * _columns = INTEGER(columns);
for(size_t i = _start_row; i < _end_row; ++i) {
char *buf_pos = buffer;
for(size_t c = 0; c < num_columns; ++c) {
if(c > 0) {
buf_pos[0] = '','';
++buf_pos;
}
writeInt32(INTEGER(VECTOR_ELT(x, _columns[c] - 1)), i, &buf_pos);
}
SET_STRING_ELT(preallocated_target,i, mkCharLen(buffer, buf_pos - buffer));
}
return preallocated_target;
" )
#Test with the same data
RowCount <- 5e6
DT <- data.table(x = "foo",
y = "bar",
a = sample.int(9, RowCount, TRUE),
b = sample.int(9, RowCount, TRUE),
c = sample.int(9, RowCount, TRUE),
d = sample.int(9, RowCount, TRUE),
e = sample.int(9, RowCount, TRUE),
f = sample.int(9, RowCount, TRUE))
## Generate an expression to paste an arbitrary list of columns together
ConcatCols <- list("a","b","c","d","e","f")
## Do it 3x as many times
ConcatCols <- c(ConcatCols,ConcatCols,ConcatCols)
ptm <- proc.time()
preallocated_target <- character(RowCount)
column_indices <- sapply(ConcatCols, FUN = function(x) { which(colnames(DT) == x )})
x <- worker_fun(DT, preallocated_target, column_indices, as.integer(1), as.integer(RowCount))
DT[, State := preallocated_target]
proc.time() - ptm
Si bien su ejemplo (solo entero) se ejecuta en aproximadamente 20 segundos en mi PC, esto se ejecuta en ~ 5 y se puede paralelizar fácilmente.
Algunas cosas a tener en cuenta:
- El código no está listo para la producción: se deben realizar muchas comprobaciones de integridad en las entradas de la función (especialmente si se comprueba si todas las columnas tienen la misma longitud, se verifican los tipos de columnas, el tamaño del objetivo preallocated, etc.)
- La función coloca su salida en un vector de caracteres preasignado, esto no es estándar y es feo (R generalmente no tiene semántica de paso por referencia) pero permite la paralelización (ver más abajo).
- Los dos últimos parámetros son las filas de inicio y finalización que se procesarán, una vez más, esto es para paralelización
- La función acepta índices de columna, no nombres de columna. Todas las columnas deben ser de tipo entero.
- A excepción de la entrada data.table y preallocated_target, las entradas deben ser enteros
- El tiempo de compilación para la función no está incluido (ya que debe compilarlo de antemano, tal vez incluso hacer un paquete)
Paralelización
EDITAR: El enfoque a continuación realmente fallaría debido a la forma en que clusterExport y R string storage. Por lo tanto, es probable que la paralelización también deba realizarse en C, de manera similar a como se logra en la tabla de datos.
Dado que no puede pasar funciones compiladas en línea a través de procesos R, la paralelización requiere un poco más de trabajo. Para poder usar la función anterior en paralelo, debe compilarlo por separado con el compilador R y usar dyn.load O envolverlo en un paquete O usar un backend de forking para paralelo (no tengo uno, solo funciona para forking en UNIX).
Ejecutar en paralelo se vería como (no probado):
no_cores <- detectCores()
# Initiate cluster
cl <- makeCluster(no_cores)
#Preallocated target and prepare params
num_elements <- length(DT[[1]])
preallocated_target <- character(num_elements)
block_size <- 4096 #No of rows processed at once. Adjust for best performance
column_indices <- sapply(ConcatCols, FUN = function(x) { which(colnames(DT) == x )})
num_blocks <- ceiling(num_elements / block_size)
clusterExport(cl,
c("DT","preallocated_target","column_indices","num_elements", "block_size"))
clusterEvalQ(cl, <CODE TO LOAD THE NATIVE FUNCTION HERE>)
parLapply(cl, 1:num_blocks ,
function(block_id)
{
throw_away <-
worker_fun(DT, preallocated_target, columns,
(block_id - 1) * block_size + 1, min(num_elements, block_id * block_size - 1))
return(NULL)
})
stopCluster(cl)