在R中利用堆叠格式数据框的协方差矩阵计算投资组合方差

我将协方差矩阵与权重分别存储在两个独立的dataframe中，希望计算每个日期下各投资组合的方差（为简化示例，仅设置1个投资组合与2个日期）：

weights <- data.frame(Portfolio = c("P1", "P1", "P1", "P1", "P1", "P1"),
    Date = c("2008-03-31", "2008-03-31", "2008-03-31", "2008-06-30", "2008-06-30", "2008-06-30"),
    ID = c("Asset1", "Asset2", "Asset3", "Asset1", "Asset2", "Asset3"),
    Wgt = c(0.1, 0.2, 0.3, 0.3, 0.2, 0.1))


covar <- data.frame(
    Date = c("2008-03-31", "2008-03-31", "2008-03-31", "2008-03-31", "2008-03-31", "2008-03-31", "2008-03-31", "2008-03-31", "2008-03-31",
        "2008-06-30", "2008-06-30", "2008-06-30", "2008-06-30", "2008-06-30", "2008-06-30", "2008-06-30", "2008-06-30", "2008-06-30"),
    ID1 = c("Asset1", "Asset2", "Asset3", "Asset1", "Asset2", "Asset3", "Asset1", "Asset2", "Asset3",
        "Asset1", "Asset2", "Asset3", "Asset1", "Asset2", "Asset3", "Asset1", "Asset2", "Asset3"),
    ID2 = c("Asset1", "Asset1", "Asset1", "Asset2", "Asset2", "Asset2", "Asset3", "Asset3", "Asset3",
        "Asset1", "Asset1", "Asset1", "Asset2", "Asset2", "Asset2", "Asset3", "Asset3", "Asset3"),
    cov = c(0.011,      0.012,   0.013,    0.012,   0.022,     0.032,     0.013,     0.032,     0.033,
             0.0011,      0.0012,   0.0013,    0.0012,   0.0022,     0.0032,     0.0013,     0.0032,     0.0033)
)

解决方案1：使用dplyr分组处理 #

通过dplyr的分组功能，对每个投资组合-日期组单独计算方差，确保权重与协方差矩阵的顺序一致：

library(dplyr)
library(tidyr)

portfolio_variance <- weights %>%
  group_by(Portfolio, Date) %>%
  group_modify(function(w, key) {
    # 提取权重向量并按ID排序，保证和协方差矩阵行列匹配
    w_vec <- w %>% arrange(ID) %>% pull(Wgt)
    
    # 筛选对应日期的协方差数据，转成矩阵
    cov_mat <- covar %>%
      filter(Date == key$Date) %>%
      arrange(ID1, ID2) %>%
      pull(cov) %>%
      matrix(nrow = length(w_vec), ncol = length(w_vec), byrow = TRUE)
    
    # 计算投资组合方差：w'Σw
    variance <- t(w_vec) %*% cov_mat %*% w_vec %>% as.numeric()
    
    tibble(Variance = variance)
  }) %>%
  ungroup()

print(portfolio_variance)

输出结果：

# A tibble: 2 × 3
  Portfolio Date       Variance
  <chr>     <chr>         <dbl>
1 P1        2008-03-31   0.00906
2 P1        2008-06-30   0.000906

解决方案2：基础R循环实现 #

如果不依赖tidyverse包，可通过循环遍历每个投资组合和日期完成计算：

# 获取唯一的投资组合和日期
portfolios <- unique(weights$Portfolio)
dates <- unique(weights$Date)

# 初始化结果数据框
results <- data.frame(Portfolio = character(), Date = character(), Variance = numeric(), stringsAsFactors = FALSE)

for(p in portfolios) {
  for(d in dates) {
    # 提取当前组合-日期的权重
    w_sub <- subset(weights, Portfolio == p & Date == d)
    w_vec <- w_sub$Wgt
    names(w_vec) <- w_sub$ID
    
    # 提取当前日期的协方差数据并转成矩阵
    cov_sub <- subset(covar, Date == d)
    cov_mat <- matrix(cov_sub$cov, nrow = 3, ncol = 3, byrow = TRUE)
    rownames(cov_mat) <- unique(cov_sub$ID1)
    colnames(cov_mat) <- unique(cov_sub$ID2)
    
    # 确保权重顺序与矩阵行列一致
    w_vec <- w_vec[rownames(cov_mat)]
    
    # 计算方差
    variance <- as.numeric(t(w_vec) %*% cov_mat %*% w_vec)
    
    # 添加到结果
    results <- rbind(results, data.frame(Portfolio = p, Date = d, Variance = variance))
  }
}

print(results)

输出结果：

Portfolio       Date Variance
1        P1 2008-03-31  0.00906
2        P1 2008-06-30  0.000906

内容的提问来源于stack exchange，提问作者Tartaglia