Динамически генерировать неоцененные выражения для создания отстающих данных. - PullRequest
Новая
       35

Динамически генерировать неоцененные выражения для создания отстающих данных.

1 голос
/ 28 сентября 2011

У меня есть data.frame Z, и я хотел бы выбрать только пару переменных, хранящихся в символьном векторе vars. Это, конечно, легко сделать с помощью: 

Z[,vars]

Проблема в том, что мне нужны все эти переменные lags 1 and 4. Я использую lag(variable,-1), чтобы получить их. Я попробовал следующее, что было предложено здесь ранее: 

require(plyr)
l <- c(0,1,4)
expand.grid(x=vars,l=l)
# which results in 
  x      l
var1     0
var2     0
var3     0
var1     1
var2     1
var3     1
var1     4
var2     4
var3     4

buildFaDf <- function(x,l) paste("lag(Z$",x,",-",l,")",sep="")
test <- mlply(vars,buildFaDf)

возвращает список примерно так: 

.... 
$`4`
[1] "lag(Z$var1,-1)"

Если я вызову этот элемент списка, я просто верну символы, но, конечно, мне хотелось бы получить сами данные. В конце я хочу получить unlist и получить data.frame, содержащий все vars и соответствующие им лаги.

Я также играл с substitute, eval и expression и не мог этого сделать. Обратите внимание, что я не сфокусирован на решении mlply, здесь оно было мне предложено в последнее время, и, возможно, в данный момент я немного предвзят.

1 Ответ

2 голосов
/ 28 сентября 2011

Возможно, вы слишком усложняете проблему.На мой взгляд, есть два шага для решения этой проблемы:

  • Шаг 1. Создайте подмножество data.frame - это тривиально, и вы показываете это в своем вопросе.
  • Шаг 2. Создайте лаговые переменные для всех столбцов в data.frame

Вот один из способов выполнения шага 2. Я продемонстрирую с помощью встроенного набора данных faithful: 

data(faithful)

dat <- head(faithful, 10)

lag1 <- function(x) c(NA, head(x, -1))
lag4 <- function(x) c(rep(NA, 4), head(x, -4))

data.frame(
  dat,
  llply(dat, lag1),
  llply(dat, lag4)
)

   eruptions waiting eruptions.1 waiting.1 eruptions.2 waiting.2
1      3.600      79          NA        NA          NA        NA
2      1.800      54       3.600        79          NA        NA
3      3.333      74       1.800        54          NA        NA
4      2.283      62       3.333        74          NA        NA
5      4.533      85       2.283        62       3.600        79
6      2.883      55       4.533        85       1.800        54
7      4.700      88       2.883        55       3.333        74
8      3.600      85       4.700        88       2.283        62
9      1.950      51       3.600        85       4.533        85
10     4.350      85       1.950        51       2.883        55

Чтобы превратить решение в функцию, которая выполняет поднаборы, а также запаздывание, выполните следующие действия: 

dat <- data.frame(head(faithful, 10), newcol=LETTERS[1:10])

laggedDF <- function(x, vars){
  lag1 <- function(x) c(NA, head(x, -1))
  lag4 <- function(x) c(rep(NA, 4), head(x, -4))
  dat <- x[, vars, drop=FALSE]
  print(dat)
  data.frame(
    dat,
    llply(dat, lag1),
    llply(dat, lag4)
  )
}

laggedDF(dat, vars=c("eruptions", "newcol"))

   eruptions newcol eruptions.1 newcol.1 eruptions.2 newcol.2
1      3.600      A          NA       NA          NA       NA
2      1.800      B       3.600        1          NA       NA
3      3.333      C       1.800        2          NA       NA
4      2.283      D       3.333        3          NA       NA
5      4.533      E       2.283        4       3.600        1
6      2.883      F       4.533        5       1.800        2
7      4.700      G       2.883        6       3.333        3
8      3.600      H       4.700        7       2.283        4
9      1.950      I       3.600        8       4.533        5
10     4.350      J       1.950        9       2.883        6
...