R 数据表元编程

我认为元编程在这里是正确的术语

我希望能够像在webapp中使用MySQL一样使用data.table。也就是说，web用户使用一些web前端（例如Shiny server）来选择数据库、选择要筛选的列、选择要分组的列、选择要聚合的列和聚合函数。我想使用R和data.table作为查询、聚合等的后端。假设前端存在，R将这些变量作为字符串，并对它们进行验证等

我编写了以下函数来构建data.table表达式，并使用R的parse/eval元编程功能来运行它。这样做合理吗

我包括所有相关的代码来测试这一点。源代码（为了安全起见阅读后！）和 运行test_agg_meta（）对其进行测试。这只是一个开始。我可以添加更多功能

但我的主要问题是我是否过度思考了这个问题。当所有输入都未事先确定而不诉诸解析/评估元编程时，是否有更直接的方法使用data.table

我也知道“with”语句和其他一些无糖功能方法，但不知道它们是否能处理所有情况

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")
}

require（data.table）
假数据（0）{
groupby=粘贴（groupby_cols，collapse=“，”）
groupby=paste（“by=list（“，groupby，”）”，sep=“”）
}
n_filter_cols=长度（filter_cols）
如果（n_filter_cols>0）{
i\u filters=rep（“，n\u filter\u cols）
用于（1:n过滤器中的i）{
i_filters[i]=粘贴（“（”，filter_cols[i]，“>=”，filter_min[i]，“&”，filter_cols[i]，“虽然您的函数看起来确实很有趣，但我相信您会问是否还有其他方法可以实现此功能。

就我个人而言，我喜欢这样使用：

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

按引用选择列
要通过引用列的名称来选择列，请使用
.SDcols
参数。
给定一个列名称向量：

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

我们还可以对字符串向量中命名的每个列应用一个函数：

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

请注意，如果我们的目标只是输出列，则可以使用

关闭

：

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

注意：更“现代”的方法是使用
。
快捷方式访问从“上一级”选择的
列：

但是，如果使用
with=FALSE
，则不能以通常的方式直接对列进行操作

## 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)]

我们也可以使用
get
，但它有点棘手。
我把它留在这里作为参考，但是
.SDcols
是一条路要走

如果要更改列的名称，请执行以下操作：

# 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))]


把它们放在一起
我们可以通过引用data.table的名称来访问它，然后还可以通过名称来选择它的列：

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

你想为你的内存数据帧寻找类似SQL的接口吗？那么看看吧，是的，我用过。但是，在一些方面，我更喜欢data.table。我发现它更快。谢谢。这看起来很有趣。让我考虑一下。哇！谢谢你花时间。这看起来很棒，比我目前的方法好得多。我会尝试一下然后对它进行一点测试。关于
with=FALSE
以及
.SDcols
？
lappy（使用
get
选择的列
最好使用
lappy（.SD，
和setting
.SDcols=columnselected
例如。@Dave31415，完全披露：我实际上已经将其中的大部分内容作为内部文档打印出来了。我只是复制并粘贴了其中的一部分：）@MatthewDowle，你完全正确。我需要更新我的文档和这个答案。
## 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)]

## 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))})]

    ## this DOES NOT work (need ..columnsSelected)
    DT3[, columnsSelected]

    ## netiher does this
    DT3[, eval(columnsSelected)]

    ## still does not work: 
    DT3[, lapply(columnsSelected, get)]

# 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))]

# `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]

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

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