Meta-programación de Data.table

Question

Creo que la meta-programación es el término correcto aquí.

Quiero ser capaz de usar data.table de manera similar a como usaría MySQL en decir una aplicación web. Es decir, los usuarios de la web usan algún front-end web (como el servidor Shiny, por ejemplo) para seleccionar una base de datos, seleccionar columnas para filtrar, seleccionar columnas para agrupar, seleccionar columnas para agregar y funciones de agregación. Quiero usar R y data.table como un back-end para consultas, agregación, etc. Supongamos que el front-end existe y R tiene estas variables como cadenas de caracteres y están validados, etc.

Escribí la siguiente función para compilar la expresión data.table y usar la funcionalidad de meta-programación parse / eval de R para ejecutarla. ¿Es esta una manera razonable de hacer esto?

I incluye todo el código relevante para probar esto. Fuente este código (después de leerlo por seguridad!) Y ejecutar test_agg_meta () para probarlo. Es solo un comienzo. Podría agregar más funcionalidad.

Pero mi pregunta principal es si estoy demasiado pensando en esto. ¿Existe una forma más directa de utilizar data.table cuando todas las entradas son indeterminadas de antemano sin recurrir a la metaprogramación parse / eval?

También conozco la declaración "con" y algunos de los otros métodos funcionales sin azúcar, pero no sé si pueden encargarse de todos los casos.

require(data.table)
fake_data<-function(num=12){
#make some fake data
x=1:num
lets=letters[1:num]
data=data.table(
u=rep(c("A","B","C"),floor(num/3)),
v=x %%2, w=lets, x=x, y=x^2, z=1-x)
return(data)
}
data_table_meta<-function(
#aggregate a data.table meta-programmatically
data_in=fake_data(),
filter_cols=NULL,
filter_min=NULL,
filter_max=NULL,
groupby_cols=NULL,
agg_cols=setdiff(names(data_in),groupby_cols),
agg_funcs=NULL,
verbose=F,
validate=T,
jsep="_"
){
all_cols=names(data_in)
if (validate) {
stopifnot(length(filter_cols) == length(filter_min))
stopifnot(length(filter_cols) == length(filter_max))
stopifnot(filter_cols %in% all_cols)
stopifnot(groupby_cols %in% all_cols)
stopifnot(length(intersect(agg_cols,groupby_cols)) == 0)
stopifnot((length(agg_cols) == length(agg_funcs)) | (length(agg_funcs)==1) | (length(agg_funcs)==0))
}
#build the command
#defaults
i_filter=""
j_select=""
n_agg_funcs=length(agg_funcs)
n_agg_cols=length(agg_cols)
n_groupby_cols=length(groupby_cols)
if (n_agg_funcs == 0) {
#NULL
print("NULL")
j_select=paste(agg_cols,collapse=",")
j_select=paste("list(",j_select,")")
} else {
agg_names=paste(agg_funcs,agg_cols,sep=jsep)
jsels=paste(agg_names,"=",agg_funcs,"(",agg_cols,")",sep="")
if (n_groupby_cols>0) jsels=c(jsels,"N_Rows_Aggregated=.N")
j_select=paste(jsels,collapse=",")
j_select=paste("list(",j_select,")")
}
groupby=""
if (n_groupby_cols>0) {
groupby=paste(groupby_cols,collapse=",")
groupby=paste("by=list(",groupby,")",sep="")
}
n_filter_cols=length(filter_cols)
if (n_filter_cols > 0) {
i_filters=rep("",n_filter_cols)
for (i in 1:n_filter_cols) {
i_filters[i]=paste(" (",filter_cols[i]," >= ",filter_min[i]," & ",filter_cols[i]," <= ",filter_max[i],") ",sep="")
}
i_filter=paste(i_filters,collapse="&")
}
command=paste("data_in[",i_filter,",",j_select,",",groupby,"]",sep="")
if (verbose == 2) {
print("all_cols:")
print(all_cols)
print("filter_cols:")
print(filter_cols)
print("agg_cols:")
print(agg_cols)
print("filter_min:")
print(filter_min)
print("filter_max:")
print(filter_max)
print("groupby_cols:")
print(groupby_cols)
print("agg_cols:")
print(agg_cols)
print("agg_funcs:")
print(agg_funcs)
print("i_filter")
print(i_filter)
print("j_select")
print(j_select)
print("groupby")
print(groupby)
print("command")
print(command)
}
print(paste("evaluating command:",command))
eval(parse(text=command))
}
my_agg<-function(data=fake_data()){
data_out=data[
i=x<=5,
j=list(
mean_x=mean(x),
mean_y=mean(y),
sum_z=sum(z),
N_Rows_Aggregated=.N
),
by=list(u,v)]
return(data_out)
}
my_agg_meta<-function(data=fake_data()){
#should give same results as my_agg
data_out=data_table_meta(data,
filter_cols=c("x"),
filter_min=c(-10000),
filter_max=c(5),
groupby_cols=c("u","v"),
agg_cols=c("x","y","z"),
agg_funcs=c("mean","mean","sum"),
verbose=T,
validate=T,
jsep="_")
return(data_out)
}
test_agg_meta<-function(){
stopifnot(all(my_agg()==my_agg_meta()))
print("Congrats, you passed the test")
}

Answer 1

Si bien sus funciones ciertamente parecen interesantes, creo que está preguntando si hay otras formas de hacerlo.
Personalmente, me gusta usar algo como esto:

## SAMPLE DATA
DT1 <- data.table(id=sample(LETTERS[1:4], 20, TRUE), Col1=1:20, Col2=rnorm(20))
DT2 <- data.table(id=sample(LETTERS[3:8], 20, TRUE), Col1=sample(100:500, 20), Col2=rnorm(20))
DT3 <- data.table(id=sample(LETTERS[19:20], 20, TRUE), Col1=sample(100:500, 20), Col2=rnorm(20))

ACCEDER A UNA TABLA POR REFERENCIA AL NOMBRE DE LA MESA:

Esto es sencillo, muy parecido a cualquier objeto en R

# use strings to select the table
tablesSelected <- "DT3"
# use get to access them
get(tablesSelected)
# and we can perform operations:
get(tablesSelected)[, list(C1mean=mean(Col1), C2mean=mean(Col2))]

SELECCIONANDO COLUMNAS POR REFERENCIA

Para seleccionar columnas por referencia a sus nombres, use el argumento .SDcols . Dado un vector de nombres de columna:

columnsSelected <- c("Col1", "Col2")

Asigna ese vector al argumento .SDcols:

## Here we are simply accessing those columns
DT3[, .SD, .SDcols = columnsSelected]

También podemos aplicar una función a cada columna nombrada en el vector de cadena:

## apply a function to each column
DT3[, lapply(.SD, mean), .SDcols = columnsSelected]

Tenga en cuenta que si nuestro objetivo es simplemente dar salida a las columnas, podemos desactivarlo with :

# This works for displaying
DT3[, columnsSelected, with=FALSE]

Sin embargo, si se usa with=FALSE , no podemos operar directamente en las columnas de la manera habitual

## This does NOT work:
DT3[, someFunc(columnsSelected), with=FALSE]
## This DOES work:
DT3[, someFunc(.SD), .SDcols=columnsSelected]
## This also works, but is less ideal, ie assigning to new columns is more cumbersome
DT3[, columnsSelected, with=FALSE][, someFunc(.SD)]

También podemos usar get , pero es un poco más complicado. Lo dejo aquí para referencia, pero .SDcols es el camino a seguir

## we need to use `get`, but inside `j`
## AND IN A WRAPPER FUNCTION <~~~~~ THIS IS VITAL
DT3[, lapply(columnsSelected, function(.col) get(.col))]
## We can execute functions on the columns:
DT3[, lapply(columnsSelected, function(.col) mean( get(.col) ))]
## And of course, we can use more involved-functions, much like any *ply call:
# using .SDcols
DT3[, lapply(.SD, function(.col) c(mean(.col) + 2*sd(.col), mean(.col) - 2*sd(.col))), .SDcols = columnsSelected]
# using `get` and assigning the value to a var.
# Note that this method has memory drawbacks, so using .SDcols is preferred
DT3[, lapply(columnsSelected, function(.col) {TheCol <- get(.col); c(mean(TheCol) + 2*sd(TheCol), mean(TheCol) - 2*sd(TheCol))})]

Como referencia, si prueba lo siguiente, notará que no producen los resultados que buscamos.

 ## this DOES NOT work
DT3[, columnsSelected]
## netiher does this
DT3[, eval(columnsSelected)]
## still does not work:
DT3[, lapply(columnsSelected, get)]

Si desea cambiar el nombre de las columnas:

# Using the `.SDcols` method: change names using `setnames` (lowercase "n")
DT3[, setnames(.SD, c("new.Name1", "new.Name2")), .SDcols =columnsSelected]
# Using the `get` method:
## The names of the new columns will be the names of the `columnsSelected` vector
## Thus, if we want to preserve the names, use the following:
names(columnsSelected) <- columnsSelected
DT3[, lapply(columnsSelected, function(.col) get(.col))]
## we can also use this trick to give the columns new names
names(columnsSelected) <- c("new.Name1", "new.Name2")
DT3[, lapply(columnsSelected, function(.col) get(.col))]

Claramente, usar .SDcols es más fácil y más elegante.

¿Qué tal?

# `by` is straight forward, you can use a vector of strings in the `by` argument.
# lets add another column to show how to use two columns in `by`
DT3[, secondID := sample(letters[1:2], 20, TRUE)]
# here is our string vector:
byCols <- c("id", "secondID")
# and here is our call
DT3[, lapply(columnsSelected, function(.col) mean(get(.col))), by=byCols]

PONIENDOLO TODO JUNTO

Podemos acceder a data.table por referencia a su nombre y luego seleccionar sus columnas también por su nombre:

get(tablesSelected)[, .SD, .SDcols=columnsSelected]
## OR WITH MULTIPLE TABLES
tablesSelected <- c("DT1", "DT3")
lapply(tablesSelected, function(.T) get(.T)[, .SD, .SDcols=columnsSelected])
# we may want to name the vector for neatness, since
# the resulting list inherits the names.
names(tablesSelected) <- tablesSelected

ESTA ES LA MEJOR PARTE:

Dado que tanto en data.table es pass-by-reference, es fácil tener una lista de tablas, una lista separada de columnas para agregar y otra lista de columnas para operar, y poner todas juntas para agregar realizar operaciones similares. - pero con diferentes entradas - en todas sus tablas. A diferencia de hacer algo similar con data.frame , no hay necesidad de reasignar el resultado final.

newColumnsToAdd <- c("UpperBound", "LowerBound")
FunctionToExecute <- function(vec) c(mean(vec) - 2*sd(vec), mean(vec) + 2*sd(vec))
# note the list of column names per table!
columnsUsingPerTable <- list("DT1" = "Col1", DT2 = "Col2", DT3 = "Col1")
tablesSelected <- names(columnsUsingPerTable)
byCols <- c("id")
# TADA:
dummyVar <- # I use `dummyVar` because I do not want to display the output
lapply(tablesSelected, function(.T)
get(.T)[, c(newColumnsToAdd) := lapply(.SD, FunctionToExecute), .SDcols=columnsUsingPerTable[[.T]], by=byCols ] )
# Take a look at the tables now:
DT1
DT2
DT3