使用seq_along和lapply处理多个数据帧(CAPM)

时间:2017-03-29 17:44:00

标签: r lapply seq

我有48个数据帧,我希望计算每个数据帧(CAPM)中每个股票的线性回归。每个数据帧包含大约470个相同数量的股票,S& P 500并且具有36个月的数据。最初我有一个大型数据帧,但我已经成功地将数据分成48个数据帧(这可能不是最聪明的举动,但这是我解决问题的方式。)

当我运行以下代码时,它工作正常。注意到我在Block 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

2 个答案:

答案 0 :(得分:0)

考虑一个嵌套的lapply,其中外部循环遍历每个符号的数据帧列表和内部循环。结果是一个48人的名单,每个包含470套β系数。

此外,除此之外,最好使用许多类似结构对象的列表,尤其是运行相同的操作并避免充斥您的全局环境(管理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)
  })

})

答案 1 :(得分:0)

@ Parfait的答案是OPs使用lapply处理数据帧列表的问题的正确答案。

以下示例显示如何使用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