Как можно полностью работать в data.table в R с именами столбцов в переменных

Ответ 1

Проблема, которую вы описываете, не связана строго с data.table.
Сложные запросы не могут быть легко переведены в код, который может анализировать машина, поэтому мы не можем избежать сложности при написании запроса для сложных операций.
Только представьте, как программно построить запрос для следующего запроса data.table

DT[, c(f1(v1, v2, opt=TRUE),
       f2(v3, v4, v5, opt1=FALSE, opt2=TRUE),
       lapply(.SD, f3, opt1=TRUE, opt2=FALSE))
   , by=.(id1, id2)]

с использованием dplyr или SQL - при условии, что все столбцы (id1, id2, v1... v5) или даже опции (opt, opt1, opt2) должны быть переданы как переменные.

Из-за вышесказанного я не думаю, что вы могли бы легко выполнить требование, изложенное в вашем вопросе:

Проще, изящнее, короче или проще в разработке, реализации или понимании, чем приведенный выше или другие, которые требуют частых quote -ing и eval -ing.

Хотя, по сравнению с другими языками программирования, база R предоставляет очень полезные инструменты для решения таких проблем.

Вы уже нашли предложения использовать get, mget, DT[[col_name]], parse, quote, eval.

• Как вы упомянули, DT[[col_name]] может не очень хорошо работать с оптимизацией data.table, поэтому здесь это не очень полезно.
• parse, вероятно, самый простой способ построения сложных запросов, поскольку вы можете просто работать со строками, но он не обеспечивает базовую проверку синтаксиса языка. Таким образом, вы можете попытаться разобрать строку, которую R parser не принимает. Кроме того, существует проблема безопасности, представленная в 2655 # issuecomment-376781159.
• get/mget - наиболее часто предлагаемые для решения таких проблем. get и mget внутренне улавливаются [.data.table и переводятся в ожидаемые столбцы. Таким образом, вы предполагаете, что ваш произвольный сложный запрос сможет быть разложен [.data.table и ожидаемые столбцы будут правильно введены.
• Поскольку вы задавали этот вопрос несколько лет назад, недавно появилась новая функция - префикс точка-точка. Вы префикс имени переменной, используя точку-точку, чтобы ссылаться на переменную вне области текущего data.table. Аналогично тому, как вы ссылаетесь на родительский каталог в файловой системе. Внутренние элементы за точкой-точкой будут очень похожи на get, переменные с префиксом будут разыменовываться внутри [.data.table., В будущих выпусках префикс точка-точка может разрешать такие вызовы, как:

col1="a"; col2="b"; col3="g"; col4="x"; col5="y"
DT[..col4==..col5, .(s1=sum(..col1), s2=sum(..col2)), by=..col3]

• Лично я предпочитаю quote и eval вместо этого. quote и eval интерпретируются почти как написанные от руки с нуля. Этот метод не использует возможности data.table для управления ссылками на столбцы. Мы можем ожидать, что все оптимизации будут работать так же, как если бы вы писали эти запросы вручную. Я также обнаружил, что отладку проще, поскольку в любой момент вы можете просто напечатать выражение в кавычках, чтобы увидеть, что фактически передается в запрос data.table. Кроме того, есть меньше места для ошибок. Построение сложных запросов с использованием объекта языка R иногда бывает сложным, легко обернуть процедуру в функцию, чтобы ее можно было применять в различных случаях и легко использовать повторно. Важно отметить, что этот метод не зависит от data.table. Он использует языковые конструкции R. Вы можете найти более подробную информацию об этом в официальном R Language Definition в разделе "Компьютеры на языке".
• Что еще? Я представил предложение новой концепции под названием макрос в # 1579. Короче говоря, это оболочка для DT[eval(qi), eval(qj), eval(qby)], поэтому вам все равно придется работать с объектами языка R. Вы можете оставить свой комментарий там.

Переходя к примеру. Я заверну всю логику в функцию do_vars. Вызов do_vars(donot=TRUE) напечатает выражения для вычисления на data.table вместо eval. Код ниже должен быть запущен сразу после кода OP.

expected = copy(new.table)
new.table = the.table[, list(asofdate=seq(from=ymd((year)*10^4+101), length.out=12, by="1 month")), by=year]

do_vars = function(x, y, vars, donot=FALSE) {
  name.suffix = function(x, suffix) as.name(paste(x, suffix, sep="."))
  do_var = function(var, x, y) {
    substitute({
      x[, .anntot := y[, rep(.var, each=12)]]
      x[, .monthly := y[, rep(.var/12, each=12)]]
      x[, .rolling := rollapply(.monthly, mean, width=12, fill=c(head(.monthly,1), tail(.monthly,1)))]
      x[, .scaled := .anntot/sum(.rolling)*.rolling, by=year]
    }, list(
      .var=as.name(var),
      .anntot=name.suffix(var, "annual.total"),
      .monthly=name.suffix(var, "monthly"),
      .rolling=name.suffix(var, "rolling"),
      .scaled=name.suffix(var, "scaled")
    ))
  }
  ql = lapply(setNames(nm=vars), do_var, x, y)
  if (donot) return(ql)
  lapply(ql, eval.parent)
  invisible(x)
}
do_vars(new.table, the.table, c("var1","var2","var3"))
all.equal(expected, new.table)
#[1] TRUE

do_vars(new.table, the.table, c("var1","var2","var3"), donot=TRUE)
#$var1
#{
#    x[, ':='(var1.annual.total, y[, rep(var1, each = 12)])]
#    x[, ':='(var1.monthly, y[, rep(var1/12, each = 12)])]
#    x[, ':='(var1.rolling, rollapply(var1.monthly, mean, width = 12, 
#        fill = c(head(var1.monthly, 1), tail(var1.monthly, 1))))]
#    x[, ':='(var1.scaled, var1.annual.total/sum(var1.rolling) * 
#        var1.rolling), by = year]
#}
#
#$var2
#{
#    x[, ':='(var2.annual.total, y[, rep(var2, each = 12)])]
#    x[, ':='(var2.monthly, y[, rep(var2/12, each = 12)])]
#    x[, ':='(var2.rolling, rollapply(var2.monthly, mean, width = 12, 
#        fill = c(head(var2.monthly, 1), tail(var2.monthly, 1))))]
#    x[, ':='(var2.scaled, var2.annual.total/sum(var2.rolling) * 
#        var2.rolling), by = year]
#}
#
#$var3
#{
#    x[, ':='(var3.annual.total, y[, rep(var3, each = 12)])]
#    x[, ':='(var3.monthly, y[, rep(var3/12, each = 12)])]
#    x[, ':='(var3.rolling, rollapply(var3.monthly, mean, width = 12, 
#        fill = c(head(var3.monthly, 1), tail(var3.monthly, 1))))]
#    x[, ':='(var3.scaled, var3.annual.total/sum(var3.rolling) * 
#        var3.rolling), by = year]
#}
#

Ответ 2

Я попытался сделать это в data.table мышления "это не так уж плохо"... но после неловкого времени я сдался. Мэтт говорит что-то вроде "делай по частям, а затем присоединяйся", но я не мог найти элегантных способов сделать эти штуки, особенно потому, что последний зависит от предыдущих шагов.

Я должен сказать, что это довольно блестящий вопрос, и я часто сталкиваюсь с подобными проблемами. Мне нравится data.table, но я по-прежнему иногда борюсь. Я не знаю, боюсь ли я с data.table или сложностью проблемы.

Вот неполный подход, который я принял.

Реально я могу представить, что в обычном процессе у вас будет храниться более промежуточных переменных, которые были бы полезны для вычисления этих значений.

library(data.table)
library(zoo)

## Example yearly data
set.seed(27)
DT <- data.table(year=1991:1996,
                 var1=floor(runif(6,400,1400)))
DT[ , var2 := var1 / floor(runif(6,2,5))]
DT[ , var3 := var1 / floor(runif(6,2,5))]
setkeyv(DT,colnames(DT)[1])
DT

## Convenience function
nonkey <- function(dt){colnames(dt)[!colnames(dt)%in%key(dt)]}

## Annual data expressed monthly
NewDT <- DT[, j=list(asofdate=as.IDate(paste(year, 1:12, 1, sep="-"))), by=year]
setkeyv(NewDT, colnames(NewDT)[1:2])

## Create annual data
NewDT_Annual <- NewDT[DT]
setnames(NewDT_Annual, 
         nonkey(NewDT_Annual), 
         paste0(nonkey(NewDT_Annual), ".annual.total"))

## Compute monthly data
NewDT_Monthly <- NewDT[DT[ , .SD / 12, keyby=list(year)]]
setnames(NewDT_Monthly, 
         nonkey(NewDT_Monthly), 
         paste0(nonkey(NewDT_Monthly), ".monthly"))

## Compute rolling stats
NewDT_roll <- NewDT_Monthly[j = lapply(.SD, rollapply, mean, width=12, 
                                       fill=c(.SD[1],tail(.SD, 1))),
                            .SDcols=nonkey(NewDT_Monthly)]
NewDT_roll <- cbind(NewDT_Monthly[,1:2,with=F], NewDT_roll)
setkeyv(NewDT_roll, colnames(NewDT_roll)[1:2])
setnames(NewDT_roll, 
         nonkey(NewDT_roll), 
         gsub(".monthly$",".rolling",nonkey(NewDT_roll)))

## Compute normalized values

## Compute "adjustment" table which is 
## total of each variable, by year for rolling
## divided by
## original annual totals

## merge "adjustment values" in with monthly data, and then 
## make a modified data.table which is each varaible * annual adjustment factor

## Merge everything
NewDT_Combined <- NewDT_Annual[NewDT_roll][NewDT_Monthly]

Ответ 3

Спасибо за вопрос. Ваш первоначальный подход имеет большое значение для решения большинства проблем.

Здесь я немного изменил функцию кавычек и изменил подход к анализу и оценил все выражение RHS как строку вместо отдельных переменных.

Обоснование:

• Вы, вероятно, не хотите повторять себя, объявляя каждую переменную, которую вы должны использовать в начале цикла.
• Строки будут лучше масштабироваться, поскольку они могут быть сгенерированы программно. Я добавил пример ниже, который вычисляет процентные доли по строке, чтобы проиллюстрировать это.

library(data.table)
library(lubridate)
library(zoo)

set.seed(1)
the.table <- data.table(year=1991:1996,var1=floor(runif(6,400,1400)))
the.table[,`:=`(var2=var1/floor(runif(6,2,5)),
                var3=var1/floor(runif(6,2,5)))]

# Replicate data across months
new.table <- the.table[, list(asofdate=seq(from=ymd((year)*10^4+101),
                                           length.out=12,
                                           by="1 month")),by=year]
# function to paste, parse & evaluate arguments
evalp <- function(..., envir=parent.frame()) {eval(parse(text=paste0(...)), envir=envir)}

# Do a complicated procedure to each variable in some group.
var.names <- c("var1","var2","var3")

for(varname in var.names) {

  # 1. For LHS, use paste0 to generate new column name as string (from @eddi comment)
  # 2. For RHS, use evalp
  new.table[, paste0(varname, '.annual.total') := evalp(
    'the.table[,rep(', varname, ',each=12)]'
  )]

  new.table[, paste0(varname, '.monthly') := evalp(
    'the.table[,rep(', varname, '/12,each=12)]'
  )]

  # Need to add envir=.SD when working within the table
  new.table[, paste0(varname, '.rolling') := evalp(
    'rollapply(',varname, '.monthly,mean,width=12, 
        fill=c(head(', varname, '.monthly,1), tail(', varname, '.monthly,1)))'
    , envir=.SD
  )]

  new.table[,paste0(varname, '.scaled'):= evalp(
      varname, '.annual.total / sum(', varname, '.rolling) * ', varname, '.rolling'
      , envir=.SD
    )
    ,by=year
  ]

  # Since we're working with strings, more freedom 
  # to work programmatically
  new.table[, paste0(varname, '.row.percent') := evalp(
    'the.table[,rep(', varname, '/ (', paste(var.names, collapse='+'), '), each=12)]'
  )]
}