黑人垃圾人
R中的Black-Litterman計算 - 我哪裡出錯了？
我正在嘗試在 R 中計算一個小型 Black Litterman 模型。我正在關注 Youtube 影片並在 R 中翻譯 excel 實現。
我有一個 var cov S 矩陣
INTC AEP AMZN MRK XOM ^GSPC INTC 0.0119535151 0.0005721887 0.0072352418 0.0016447926 0.0005925077 0.0024795274 AEP 0.0005721887 0.0042225253 0.0008231236 0.0011854049 0.0010758889 0.0011941026 AMZN 0.0072352418 0.0008231236 0.0191091776 0.0009086193 -0.0002442391 0.0017836173 MRK 0.0016447926 0.0011854049 0.0009086193 0.0063486415 0.0009187387 0.0009943984 XOM 0.0005925077 0.0010758889 -0.0002442391 0.0009187387 0.0027747986 0.0009486789 ^GSPC 0.0024795274 0.0011941026 0.0017836173 0.0009943984 0.0009486789 0.0012362303數據：
S_cov_var <- structure(c(0.0119535151035911, 0.000572188710022071, 0.00723524182537011, 0.00164479256302833, 0.000592507747499871, 0.00247952741729956, 0.000572188710022071, 0.00422252526205478, 0.000823123610432928, 0.00118540486616208, 0.00107588894445389, 0.00119410264013768, 0.00723524182537011, 0.000823123610432928, 0.0191091775682989, 0.000908619322530227, -0.000244239135715373, 0.00178361731695959, 0.00164479256302833, 0.00118540486616208, 0.000908619322530227, 0.00634864154256473, 0.000918738733973792, 0.00099439837734023, 0.000592507747499871, 0.00107588894445389, -0.000244239135715373, 0.000918738733973792, 0.00277479857981738, 0.000948678870995285, 0.00247952741729956, 0.00119410264013768, 0.00178361731695959, 0.00099439837734023, 0.000948678870995285, 0.00123623026419288 ), .Dim = c(6L, 6L), .Dimnames = list(c("INTC", "AEP", "AMZN", "MRK", "XOM", "^GSPC"), c("INTC", "AEP", "AMZN", "MRK", "XOM", "^GSPC")))我有一個連結矩陣 P：
INTC AEP AMZN MRK XOM View 1 0 1 0 0 -1 View 2 1 0 -1 0 0數據：
P <- structure(c(0, 1, 1, 0, 0, -1, 0, 0, -1, 0), .Dim = c(2L, 5L), .Dimnames = list( c("View 1", "View 2"), c("INTC", "AEP", "AMZN", "MRK", "XOM" )))我將歐米茄計算為：
tau = 1 Omega = tau * P %*% S_cov_var[1:5 ,1:5] %*% t(P)我將公式的第一部分計算為：
$$ ((\tau S)^{-1} + P^{T}\Omega^{-1}P)^{-1} $$
first <- ((tau * S_cov_var[1:5 ,1:5])^(-1) + (t(P) %*% Omega^(-1) %*% P))^(-1)那麼公式的第二部分為：
$$ (\tau S)^{-1}\pi + P^{T}\Omega^{-1}Q $$
數據：
Q <- c(0.01, 0.0175) # uncertainty about my views implied_equilib_excess_rets <- structure(c(0.00933950373355221, 0.0031834850342374, 0.00648459638783838, 0.00560398430525973, 0.00578609504932214), .Dim = c(5L, 1L), .Dimnames = list( c("INTC", "AEP", "AMZN", "MRK", "XOM"), NULL))計算：
second <- (tau * S_cov_var[1:5 ,1:5])^(-1) %*% implied_equilib_excess_rets[,1] + (t(P) %*% (Omega^(-1)) %*% Q)這給了我結果（第二部分）：
[,1] INTC 12.274655 AEP 21.034321 AMZN -3.885805 MRK 22.681126 XOM 14.381804這是完全錯誤的。
到目前為止，我已經檢查了所有數據，它們幾乎與我關注的影片相符（他使用調整後的雅虎價格，我使用收盤價，因為影片已有幾年曆史了）。我希望結果不匹配，但它們在很長一段時間內都不匹配。例如，預期的輸出應該是（對於第二部分）
INTC 1.175 AEP 2.304 AMZN -1.074 MRK 0.448 XOM -0.431分鐘 11:27這裡顯示了公式的第二部分應該是什麼樣子。
額外的：
這是我從 excel 影片中獲得的 R 程式碼的轉儲（根據影片輸出，我得到了非常接近的結果，直到
second程式碼的一部分）：library(tsibble) library(tidyverse) library(tidyquant) start_date <- "2002-01-01" end_date <- "2007-08-01" symbols <- c("INTC", "AEP", "AMZN", "MRK", "XOM", "^GSPC") portfolio_prices <- tq_get( symbols, from = start_date, to = end_date, ) %>% select(symbol, date, close) portfolio_monthly_prices <- portfolio_prices %>% group_by(symbol) %>% tq_transmute( select = close, mutate_fun = to.period, period = "months" ) %>% pivot_wider(names_from = symbol, values_from = close) %>% tk_xts(., date_var = date) portfolio_monthly_returns <- portfolio_prices %>% group_by(symbol) %>% tq_transmute( select = close, mutate_fun = periodReturn, period = "monthly", type = "log", ) %>% pivot_wider(names_from = symbol, values_from = monthly.returns) %>% tk_xts(., date_var = date) portfolio_monthly_returns[,1:5] Asset_Ave_Rets <- colMeans(portfolio_monthly_returns[, 1:5]) Market_Ave_Rets <- colMeans(portfolio_monthly_returns[, 6]) Market_variance <- var(portfolio_monthly_returns[, 6]) obs <- nrow(portfolio_monthly_returns) - 1 S_cov_var <- as.matrix(cov(portfolio_monthly_returns)) Variance <- diag(S_cov_var) StandardDev <- sqrt(Variance) lambda = c(1.5, 1.5, 1.5, 1.5, 1.5) Market_caps <- data.frame( stock = c("INTC", "AEP", "AMZN", "MRK", "XOM"), mkt_cap = c(153.42, 19.2, 36.62, 125.5, 505.49) ) %>% mutate( market_weights = mkt_cap / sum(mkt_cap) ) weights <- as.vector(Market_caps$market_weights) implied_equilib_excess_rets <- 2*c(lambda) * (S_cov_var[1:5, 1:5] %*% weights[1:5]) # AKA pi implied_equilib_excess_rets #VIEW 1: AP outperforms exxon mobile by 1% per month #VIEW 2: Intel outperforms Amazon by 1.75 % per month Q <- c(0.01, 0.0175) VIEWS = matrix(data = 0, nrow = 2, ncol = ncol(S_cov_var[,1:5])) rownames(VIEWS) = c(paste("View", seq(1:2))) colnames(VIEWS) = colnames(S_cov_var[, 1:5]) # Fill out the link matrix VIEWS[1, 2] <- 1 VIEWS[1, 5] <- -1 VIEWS[2, 1] <- 1 VIEWS[2, 3] <- -1 P = as.matrix(VIEWS) # link matrix tau = 1 Omega = tau * P %*% S_cov_var[1:5 ,1:5] %*% t(P) # uncertainty associated with our views Omega # black litterman formula # part 1: # expected returns calculation first <- ((tau * S_cov_var[1:5 ,1:5])^(-1) + (t(P) %*% Omega^(-1) %*% P))^(-1) first # part 2: second <- (tau * S_cov_var[1:5 ,1:5])^(-1) %*% implied_equilib_excess_rets[,1] + (t(P) %*% (Omega^(-1)) %*% Q) second
我快速查看了您的程式碼，您似乎
inverse在計算中錯誤地應用了該函式。例如，在second等式中，我做了以下更改：sub1 = tau * S_cov_var[1:5 ,1:5] Isub1 = solve(sub1) IOmega = solve(Omega) second <- (Isub1 %*% implied_equilib_excess_rets[,1] + (t(P) %*% IOmega %*% Q))它返回以下內容：
> second [,1] INTC 1.7555493 AEP 2.4034124 AMZN -1.0770208 MRK 0.4480916 XOM -0.5300325我希望這就是你要找的。否則讓我知道。