使用 seq_along 和 lapply 处理多个数据帧（CAPM）

Question

我有 48 个数据框，我希望为每个数据框（CAPM）中的每只股票计算线性回归。每个数据框包含相同数量的股票，大约是 470 只，标准普尔 500 指数和 36 个月的数据。最初我有一个大数据帧，但我成功地将数据拆分为 48 个数据帧（这可能不是最明智的举动，但这是我解决问题的方法）。

当我运行下面的代码时，它工作正常。请注意，我在块 1 中进行了硬编码。

  beta_results <- lapply(symbols, function(x) {
  temp <-  as.data.frame(Block1)
  input <- as.formula(paste("temp$",x, "~ temp$SP500" ))
  capm <- lm(input)
  coefficients(capm)
 })

现在我没有更改 48 个块（即 Block1 到 Block2 等）中每个块的编码，而是尝试了以下操作，事后看来这完全是垃圾。我需要的是一种将 i 从 1 增加到 48 的方法。我曾尝试将所有数据帧放入列表中，但考虑到我进行回归工作的方式，我将处理两个列表，这超出了我的范围。

beta_results <- lapply(seq_along(symbols), function(i,x) {
 temp <-  as.data.frame(paste0("Block",i))
 input <- as.formula(paste("temp$",x, "~ temp$SP500" ))
 capm <- lm(input)
coefficients(capm)
})

一些示例数据帧等的代码是：

 symbols <- c("A", "AAPL", "BRKB")

Block1 到 BlockN 将采用

的形式

             A      AAPL  BRKB    SP500
2016-04-29 -0.139  0.111  0.122    0.150 
2016-05-31  0.071  0.095  0.330    0.200 
2016-06-30 -0.042 -0.009  0.230    0.150
2016-07-29  0.090  0.060  0.200    0.100
2016-08-31  0.023  0.013  0.005    0.050  
2016-09-30  0.065  0.088  0.002    0.100

Answer 1

考虑一个嵌套的 lapply，其中外循环遍历数据帧列表，内循环遍历每个符号。结果是一个包含 48 个成员的列表，每个包含 470 组 beta 系数。

另外，顺便说一句，最好使用许多结构相似的对象的列表，尤其是运行相同的操作，并避免淹没您的全局环境（管理 1 个列表与 48 个数据帧）：

# LIST OF DATA FRAMES FROM ALL GLOBAL VARIABLES CONTAINING "Block"
dfList <- mget(ls(pattern="Block"))

# NESTED LAPPLY
results_list <- lapply(dfList, function(df) {

  beta_results <- lapply(symbols, function(x) {
     input <- reformulate(quote(SP500), response=x)     
     capm <- lm(input, data=df)
     coefficients(capm)
  })

})

Answer 2

@Parfait 对于使用 lapply 处理数据帧列表的 OP 问题的回答是正确的。

以下示例显示如何使用 data.table 获取每只股票的 coefficients 或 lm(stock~SP500)（使用 Block1 示例数据）：

library(data.table)
dt <- structure(list(date = c("2016-04-29", "2016-05-31", "2016-06-30", 
"2016-07-29", "2016-08-31", "2016-09-30"), A = c(-0.139, 0.071, 
-0.042, 0.09, 0.023, 0.065), AAPL = c(0.111, 0.095, -0.009, 0.06, 
0.013, 0.088), BRKB = c(0.122, 0.33, 0.23, 0.2, 0.005, 0.002), 
    SP500 = c(0.15, 0.2, 0.15, 0.1, 0.05, 0.1)), .Names = c("date", 
"A", "AAPL", "BRKB", "SP500"), row.names = c(NA, -6L), class = "data.frame")

setDT(dt)
# Convert to long format for easier lm
dt_melt <- melt(dt, id.vars = c("date", "SP500"))
# Extract coefficients by doing lm for each unique variable (i.e. stock)
dt_lm <- dt_melt[, as.list(coefficients(lm(value~SP500))), by = variable]
# Fix column names
setnames(dt_lm, c("stock", "intercept", "slope"))

> dt_lm
   stock   intercept      slope
1:     A  0.05496970 -0.3490909
2:  AAPL  0.01421212  0.3636364
3:  BRKB -0.10751515  2.0454545

使用 seq_along 和 lapply 处理多个数据帧（CAPM）

Using seq_along and lapply to process multiple dataframes (CAPM)

r

seq

lapply