向嵌套列表添加变量

Question

使用R base，我想向嵌套列表中添加一个变量，其中每个嵌套列表元素的变量都会发生变化。下面是一个例子。谢谢你。

#CREATE EXAMPLE DATAFRAME
DF <- expand.grid(NAME = c("FRANK", "TONY", "ED"), DATE = seq(as.Date("2014-01-01"), as.Date("2018-12-31"), by = "day"))

#CREATE NESTED LIST
DF <- lapply(1:3, function(i) lapply(2014:2015, function(t) DF[with(DF, as.Date(paste(t, "01", "01", sep = "-")) <= DATE & DATE <= as.Date(paste(t + i, "12", "31", sep = "-"))), ]))

#PRINT NESTED LIST
lapply(DF, lapply, function(x) rbind(head(x), tail(x)))

#I WOULD LIKE TO SIMPLIFY THIS PART
DF[[1]][[1]] <- within(DF[[1]][[1]], GROUP <- 2014)
DF[[1]][[2]] <- within(DF[[1]][[2]], GROUP <- 2015)

DF[[2]][[1]] <- within(DF[[2]][[1]], GROUP <- 2014)
DF[[2]][[2]] <- within(DF[[2]][[2]], GROUP <- 2015)

DF[[3]][[1]] <- within(DF[[3]][[1]], GROUP <- 2014)
DF[[3]][[2]] <- within(DF[[3]][[2]], GROUP <- 2015)

#PRINT MODIFIED NESTED LIST
lapply(DF, lapply, function(x) rbind(head(x), tail(x)))

#I AM SURPRISED THE FOLLOWING DOES NOT WORK
DF <- expand.grid(NAME = c("FRANK", "TONY", "ED"), DATE = seq(as.Date("2014-01-01"), as.Date("2018-12-31"), by = "day"))
DF <- lapply(1:3, function(i) lapply(2014:2015, function(t) DF[with(DF, as.Date(paste(t, "01", "01", sep = "-")) <= DATE & DATE <= as.Date(paste(t + i, "12", "31", sep = "-"))),]))
DF <- lapply(DF, function(x) lapply(2014:2015, function(t) within(x, GROUP <- t)))
lapply(DF, lapply, function(x) rbind(head(x), tail(x)))

Answer 1

我认为这个问题可能是第二个lapply

DF <- lapply(DF, function(x) lapply(2014:2015, function(t) within(x, GROUP <- t)))

lapply似乎没有从大的list对象中提取所需的组件。第一个lapply遍历列表的顶层，每次提取一个包含两个元素的列表对象x。然后第二个lapply遍历一个向量，每次提供一个标量向量t。因此，下一部分每次都会获得一个包含两个元素的列表(x)，而不是所需的(未命名)数据帧。

解决方案

如果已经创建了对象，则可以直接迭代元素，而不是索引列表元素。

#CREATE NESTED LIST
DF <- lapply(1:3, function(i) lapply(2014:2015, function(t) DF[with(DF, as.Date(paste(t, "01", "01", sep = "-")) <= DATE & DATE <= as.Date(paste(t + i, "12", "31", sep = "-"))), ]))

edit_level2 <- function(df) {
    # figure out what the value of t should be based on the data.
    t <- as.integer(format(min(df$DATE), "%Y"))
    df$GROUP <- t
    return(df)
}

# iterate over the list object contents at *both* levels
DF <- lapply(DF, function(level1) lapply(level1, function(level2) edit_level2(level2)))

注意:这类似于@Consistency在注释中提出的解决方案--提取数据帧是问题所在。

替代方案

如果可以修改生成list对象的代码，我建议在创建list对象时赋值变量，而不是事后修改它(我最初的建议是在编辑之前)。

#CREATE EXAMPLE DATAFRAME
DF <- expand.grid(NAME = c("FRANK", "TONY", "ED"), 
                  DATE = seq(as.Date("2014-01-01"), as.Date("2018-12-31"), by = "day"))

#CREATE NESTED LIST
DF <- lapply(1:3, function(i) {

    lapply(2014:2015, function(t) {

        first <- as.Date(paste(t,     "01", "01", sep = "-")) 
        last  <- as.Date(paste(t + i, "12", "31", sep = "-")) 

        # create a local data frame
        df <- DF[first <= DF$DATE & DF$DATE <= last, ]

        # modify the local data frame
        df$GROUP <- t

        # return the modified data frame
        df

    })

})

Answer 2

这应该可以了

final_list<-list()
for(i in seq(1, length(DF))){

  new_list<-list()

  for(j in seq(1,length(DF[[i]]))){

    new_list[[j]]<-list(DF[[i]][[j]],GROUP=j)

  }
  final_list[[i]]<-new_list
}

Answer 3

#CREATE EXAMPLE DATAFRAME
DF <- expand.grid(NAME = c("FRANK", "TONY", "ED"), DATE = seq(as.Date("2014-01-01"), as.Date("2018-12-31"), by = "day"))

#CREATE NESTED LIST
DF <- lapply(1:3, function(i) lapply(2014:2015, function(t) DF[with(DF, as.Date(paste(t, "01", "01", sep = "-")) <= DATE & DATE <= as.Date(paste(t + i, "12", "31", sep = "-"))), ]))

#PRINT NESTED LIST
lapply(DF, lapply, function(x) rbind(head(x), tail(x)))

#I WOULD LIKE TO SIMPLIFY THIS PART
DF[[1]][[1]] <- within(DF[[1]][[1]], GROUP <- 2014)
DF[[1]][[2]] <- within(DF[[1]][[2]], GROUP <- 2015)

DF[[2]][[1]] <- within(DF[[2]][[1]], GROUP <- 2014)
DF[[2]][[2]] <- within(DF[[2]][[2]], GROUP <- 2015)

DF[[3]][[1]] <- within(DF[[3]][[1]], GROUP <- 2014)
DF[[3]][[2]] <- within(DF[[3]][[2]], GROUP <- 2015)

#PRINT MODIFIED NESTED LIST
DF1 <- lapply(DF, lapply, function(x) rbind(head(x), tail(x)))
DF1

#I AM SURPRISED THE FOLLOWING DOES NOT WORK
DF <- expand.grid(NAME = c("FRANK", "TONY", "ED"), DATE = seq(as.Date("2014-01-01"), as.Date("2018-12-31"), by = "day"))
DF <- lapply(1:3, function(i) lapply(2014:2015, function(t) DF[with(DF, as.Date(paste(t, "01", "01", sep = "-")) <= DATE & DATE <= as.Date(paste(t + i, "12", "31", sep = "-"))),]))

GROUPS <- c(2014:2015)    

DF <- lapply(DF, function(xs) lapply(1:2, function(t) within(xs[[t]], GROUP <- GROUPS[t])))

DF2 <- lapply(DF, lapply, function(x) rbind(head(x), tail(x)))
DF2

all.equal(DF1, DF2)