从大数据表中提取列到小数据表并保存在列表中

Question

I get a data table (time series for different products depending on dates) from an extern server, which can have the following maximal number of columns (date is always the first column, and all other columns can exists or not, or there are only two additional columns, or whatever):

set.seed(123)
dt.data <- data.table(date = seq(as.Date('2020-01-01'), by = '1 day', length.out = 365),
                      'DEB Cal-2019' = rnorm(365, 2, 1), 'DEB Cal-2021' = rnorm(365, 2, 1),
                      'DEB Cal-2022' = rnorm(365, 2, 1), 'DEB Cal-2023' = rnorm(365, 2, 1),
                      'ATB Cal-2019' = rnorm(365, 2, 1), 'ATB Cal-2021' = rnorm(365, 2, 1),
                      'ATB Cal-2022' = rnorm(365, 2, 1), 'ATB Cal-2023' = rnorm(365, 2, 1),
                      'TTF Cal-2019' = rnorm(365, 2, 1), 'TTF Cal-2021' = rnorm(365, 2, 1),
                      'TTF Cal-2022' = rnorm(365, 2, 1), 'TTF Cal-2023' = rnorm(365, 2, 1),
                      'NCG Cal-2019' = rnorm(365, 2, 1), 'NCG Cal-2021' = rnorm(365, 2, 1),
                      'NCG Cal-2022' = rnorm(365, 2, 1), 'NCG Cal-2023' = rnorm(365, 2, 1),
                      'AUTVTP Cal-2019' = rnorm(365, 2, 1), 'AUTVTP Cal-2021' = rnorm(365, 2, 1),
                      'AUTVTP Cal-2022' = rnorm(365, 2, 1), 'AUTVTP Cal-2023' = rnorm(365, 2, 1),
                      'ATW Cal-2019' = rnorm(365, 2, 1), 'ATW Cal-2021' = rnorm(365, 2, 1),
                      'ATW Cal-2022' = rnorm(365, 2, 1), 'ATW Cal-2023' = rnorm(365, 2, 1),
                      'BRN Cal-2019' = rnorm(365, 2, 1), 'BRN Cal-2021' = rnorm(365, 2, 1),
                      'BRN Cal-2022' = rnorm(365, 2, 1), 'BRN Cal-2023' = rnorm(365, 2, 1),
                      'FEUA MDEC1' = rnorm(365, 2, 1),
                      check.names = FALSE)

Now I would like to save / extract each occurring column with the date column in its own data table. Ideally, all extracted data tables are then added to a list. I know that I should somehow do this with a for loop, but I can't solve it.

After I have received individual data tables for each product, I would have to do the following for each of the data tables (an example data table is now used here for AUTVTP Cal-2022 ):

DT <- data.table(date = seq(as.Date('2020-01-01'), by = '1 day', length.out = 365),
                 'AUTVTP Cal-2022' = rnorm(365, 2, 1), check.names = FALSE)


DT <- DT %>%
  mutate(month = format(date, '%b'), 
         date = format(date, '%d')) %>%
  tidyr::pivot_wider(names_from = date, values_from = 'AUTVTP Cal-2022') %>%
  relocate(`01`, .after = month)

## Calculate monthly and quarterly mean values: ##
DT <- setDT(DT)[, monthAvg := rowMeans(.SD, na.rm = TRUE), .SDcols = -1]
DT <- DT[, quartAvg := mean(monthAvg), ceiling(seq_len(nrow(DT))/3)]
DT <- DT[, yearAvg := mean(monthAvg), ceiling(seq_len(nrow(DT))/12)]

## Round all values of the data table to 2 digits: ##
DT <- DT %>% mutate_if(is.numeric, round, 2)

HOW CAN I DO THIS?

Answer 1

Reshape to long format, then split.

split(
  melt(dt.data, id.vars = "date"),
  by = "variable", keep.by = FALSE)

You can then use lapply to iterate over the list and do whatever your tidyverse code does.

However, generally you shouldn't split a data.table. It's inefficient and often not necessary.

Edit:

I suggest you forget the splitting. Wrap your code in a function like this:

foo <- function(DT, colname) {
  DT <- DT[, c("date", colname), with = FALSE]
  DT <- DT %>%
    mutate(month = format(date, '%b'), 
           date = format(date, '%d')) %>%
    tidyr::pivot_wider(names_from = date, values_from = colname) %>%
    relocate(`01`, .after = month)
  
  ## Calculate monthly and quarterly mean values: ##
  DT <- setDT(DT)[, monthAvg := rowMeans(.SD, na.rm = TRUE), .SDcols = -1]
  DT <- DT[, quartAvg := mean(monthAvg), ceiling(seq_len(nrow(DT))/3)]
  DT <- DT[, yearAvg := mean(monthAvg), ceiling(seq_len(nrow(DT))/12)]
  
  ## Round all values of the data table to 2 digits: ##
  DT %>% mutate_if(is.numeric, round, 2)
}

Then, when you need the table for a specific column in your shiny app, you can simply call this function:

foo(dt.data, 'DEB Cal-2019')

If you insist on pre-computing the list:

lapply(names(dt.data)[names(dt.data) != "date"], 
       foo, DT = dt.data)

Answer 2

使用split.default创建一个数据split.default列表，并将第一列cbind到每个列表。

lapply(split.default(dt.data[, -1], names(dt.data[, -1])), cbind, dt.data[, 1])