從大數據表中提取列到小數據表並保存在列表中

Question

我從外部服務器獲得一個數據表（不同產品的時間序列取決於日期），它可以有以下最大列數（日期總是第一列，所有其他列可以存在或不存在，或者只有兩個額外的列，或其他）：

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)

現在我想在自己的數據表中保存/提取帶有日期列的每個出現的列。 理想情況下，然后將所有提取的數據表添加到列表中。 我知道我應該以某種方式使用 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)

我怎樣才能做到這一點？

Answer 1

重塑為長格式，然后拆分。

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

然后，您可以使用lapply遍歷列表並執行 tidyverse 代碼所做的任何操作。

但是，通常您不應該拆分 data.table。 它效率低下，通常沒有必要。

編輯：

我建議你忘記拆分。 將您的代碼包裝在這樣的函數中：

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

然后，當您需要閃亮應用程序中特定列的表時，您可以簡單地調用此函數：

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

如果你堅持預先計算列表：

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