Добавить переменную во вложенный список

Ответ 1

Я думаю, что проблема может быть второй lapply:

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

lapply, как представляется, не извлекает желаемый компонент из большого объекта списка. Первый 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 в комментариях - проблема с извлечением фрейма данных.

Alternative

Если вы можете изменить код, создающий объект списка, я предлагаю назначить переменную при создании объекта списка вместо того, чтобы впоследствии ее модифицировать (мое первоначальное предложение перед редактированием).

#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

    })

})

Ответ 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
}

Ответ 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)

Ответ 4

Как насчет этого? Пришлось использовать пакет dplyr, поскольку он упрощает добавление новой переменной в dataframes с помощью mutate_.

library(dplyr) # if not installed, install with install.packages("dplyr")
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 = "-"))), ]))

# loop over the first list with lapply and then loop over the nested lists 
# and the desired GROUP values with mapply
DF <- lapply(DF, function(x) mapply(FUN = function(df,number){mutate_(df, 
"GROUP" = number)},x, 2014:2015, SIMPLIFY = F))

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

Что касается того, почему ваш путь не работал: подумайте о том, что делает function(t) within(xs[[t]], GROUP <- GROUPS[t]). Он не возвращает фрейм данных.

Ответ 5

Это может быть достигнуто также с помощью Map для cbind дат. то есть.,

lapply(DF, function(i) Map(cbind, i, c(2014, 2015)))

#or to set the name of that column to 'id',

lapply(DF, function(i) Map(function(x, y) cbind(x, id = y), i, c(2014, 2015)))

Однако, если вы не против выравнивания этого списка и сохранения дополнительной переменной id, вы можете использовать tidyverse для сглаживания и создания идентификатора года, путем градации года из первого элемента DATE из каждого кадра данных, т.е.

library(tidyverse)

new_df <- DF %>% 
  flatten_df(.id = 'list_id') %>% 
  group_by(list_id) %>% 
  mutate(id = sub('-.*', '', DATE[1]))

#which will give,

# A tibble: 19,725 x 4
# Groups:   list_id [6]
#   list_id   NAME       DATE    id
#     <chr> <fctr>     <date> <chr>
# 1       1  FRANK 2014-01-01  2014
# 2       1   TONY 2014-01-01  2014
# 3       1     ED 2014-01-01  2014
# 4       1  FRANK 2014-01-02  2014
# 5       1   TONY 2014-01-02  2014
# 6       1     ED 2014-01-02  2014
# 7       1  FRANK 2014-01-03  2014
# 8       1   TONY 2014-01-03  2014
# 9       1     ED 2014-01-03  2014
#10       1  FRANK 2014-01-04  2014
# ... with 19,715 more rows

Ответ 6

Хорошо, я думаю, что у меня это получилось. Не менее all.equal возвращает TRUE, хотя identical нет. Вот оно. Обратите внимание, что я немного изменил ваши имена df.

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

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

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

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

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

### New code
DF3 <- DF
DF3 <- lapply(DF3, function(x) {
        lapply(2014:2015, function(t){
            within(x[[t - 2013]], GROUP <- t)
        })
    })
identical(DF2, DF3)
all.equal(DF2, DF3)