I am struggling to make my mean-variance plot a bit nicer looking (interactive/dynamic).. Don't know at all how I should do it with ggplot2 and plotly. Any suggestions. Maybe I have to school myself a bit again in ggplot2.
Some of my data as an xts
tibble::tribble(
~ACKB.BR........AGS.BR.......ABI.BR.....BPOST.BR.......COFB.BR.......COLR.BR........ELI.BR,
"2016-05-31 0.0432320403 0.1163399079 0.053191613 -0.028769626 0.0432545905 0.0620524081 0.0400235221",
"2016-06-30 -0.0548885132 -0.1477101053 0.032937977 -0.033980511 -0.0342467176 -0.0716291734 0.1089806345",
"2016-07-29 -0.0176950484 -0.0287235657 -0.019557753 0.023596136 0.0557920959 0.0063540308 -0.0527623383",
"2016-08-31 -0.0120092484 0.0290745587 -0.036860294 -0.026680880 -0.0111956891 -0.0137302145 -0.0502465026",
"2016-09-30 0.1028518066 0.0482726448 0.049977505 0.056359657 0.0027172996 0.0260046039 0.0048596241",
"2016-10-31 0.0729122009 0.0249498882 -0.103344822 0.006228007 -0.0356819002 -0.0080024626 0.0364915528",
"2016-11-30 -0.0225206988 0.0583020592 -0.046570962 -0.125232125 -0.0238874811 -0.0261411446 -0.0119829618",
"2016-12-30 0.0679063410 0.0680107330 0.025601801 0.115251765 0.0427061999 -0.0142601756 0.0665450090",
"2017-01-31 -0.0454203118 0.0523796581 -0.043759445 -0.005777730 -0.0441785974 -0.0366983525 -0.0707458226",
"2017-02-28 0.0348929722 -0.0944921026 0.073842995 0.048278881 0.0091478942 -0.0223056037 0.0484081773",
"2017-03-31 0.1287357277 0.0223213145 -0.003389741 -0.061194075 0.0219465402 0.0395301722 0.0213821311",
"2017-04-28 0.0196876401 0.0262007769 0.004859115 -0.000681393 0.0373482316 0.0244459733 -0.0149676863",
"2017-05-31 0.0235088085 0.0124479040 0.024161724 -0.004406561 0.0178612484 0.0447553540 0.1019064399",
"2017-06-30 -0.0359379769 -0.0190569449 -0.068753066 -0.024013036 0.0000000000 -0.0635468744 -0.0479345700",
"2017-07-31 0.0451436662 0.0795519618 0.052631785 0.095102979 -0.0032512916 0.0272087957 -0.0003027797",
"2017-08-31 -0.0759162533 0.0248260844 -0.022397032 0.013177824 0.0102515785 -0.0148798099 0.0086798688",
"2017-09-29 0.0506373915 0.0192256218 0.017885894 0.072494444 0.0023062834 -0.0462686102 -0.0196117981",
"2017-10-31 -0.0087630367 0.0474096143 0.037018793 -0.037176948 0.0027611720 0.0132687797 0.0165340157",
"2017-11-30 -0.0020401675 -0.0086445708 -0.064593948 0.070617443 -0.0055071379 0.0132087334 -0.0080321909",
"2017-12-29 -0.0109029249 -0.0138065578 -0.036918286 0.020654406 0.0129211362 -0.0253988436 -0.0303642955",
"2018-01-31 0.0341027565 0.0448238921 -0.021368033 0.054953659 -0.0123007273 0.0279057607 0.0334027717",
"2018-02-28 -0.0119920598 0.0143395007 -0.040158094 0.041075369 -0.0461255171 -0.0053846741 0.0484849227",
"2018-03-29 -0.0411329003 -0.0275783610 0.020576232 -0.341463287 0.0193424249 0.0133092651 -0.0211945344",
"2018-04-30 0.0534458189 0.0593423208 -0.050930820 -0.010348756 0.0436433040 0.0391807731 0.0314960709",
"2018-05-31 -0.0107008859 0.0234594147 -0.030222404 -0.153300956 0.0144044738 -0.0259211946 0.0670915291",
"2018-06-29 0.0102739967 -0.0043779825 0.078284834 -0.106930729 0.0302964846 0.0747745422 -0.0166052199",
"2018-07-31 0.0576271353 0.0610969412 0.001040290 -0.004434567 0.0606060415 0.0460405131 0.0000000000",
"2018-08-31 -0.0153846788 -0.0276989887 -0.067559636 -0.031180335 0.0008928954 0.0015649542 0.0093807639",
"2018-09-28 -0.0240886321 0.0388067200 -0.068367818 0.071264337 -0.0419268510 -0.0238412101 0.0315985832",
"2018-10-31 -0.0720478594 -0.0453466239 -0.134006760 -0.040772548 -0.0158287377 0.0527180324 -0.0054053789",
"2018-11-30 0.0201292384 -0.0355123537 0.050870530 -0.149142482 0.0179754741 0.0997660745 0.0670290131",
"2018-12-31 -0.0711768283 -0.0783302055 -0.146954385 -0.198867957 0.0083643321 0.1027640659 -0.0101867786",
"2019-01-31 0.0599392756 0.0325699370 0.154419281 -0.001249163 0.0645160679 0.0080334093 0.0960548384",
"2019-02-28 -0.0085898159 0.0677675249 0.029125022 0.003126951 -0.0112553745 -0.0006376248 -0.0203443320",
"2019-03-29 -0.0288807955 -0.0076160253 0.090590811 0.198877773 0.0367775922 0.0510367762 -0.0015973463",
"2019-04-30 0.0661708934 0.0930231770 0.060192428 0.113884583 -0.0371621796 -0.0248862153 -0.0384000305",
"2019-05-31 -0.0439328885 -0.0230452514 -0.072088104 -0.157229669 0.0156460790 0.0351695751 0.0642529474",
"2019-06-28 -0.0213683551 0.0464743156 0.072028466 -0.052511991 0.0106194596 -0.2333132316 0.0532527874",
"2019-07-31 -0.0007579959 0.0647561020 0.169964229 0.011276407 0.0455341777 -0.0750981396 0.0617283542",
"2019-08-30 -0.0015175132 0.0006163674 -0.053475365 0.077342789 0.0586264548 -0.0127199573 0.0959303043",
"2019-09-30 0.0592704818 0.0447638575 0.014153171 0.059458200 0.0221518816 0.1078789652 -0.0053050712",
"2019-10-31 -0.0150645113 0.0149370992 -0.175932327 0.065267153 0.0263158540 -0.0087510304 0.0306666458",
"2019-11-29 -0.0058266447 0.0549962004 0.008771515 0.047317049 0.0120663011 -0.0569822975 -0.0297541848",
"2019-12-31 0.0234431811 -0.0330396368 0.011687795 0.019115109 -0.0238449917 -0.0110638295 0.0546666395",
"2020-01-31 0.0343592845 -0.0552391719 -0.059001505 -0.126601913 0.0977099692 -0.0286144122 0.0998735577",
"2020-02-28 -0.1038061697 -0.1585291682 -0.258550167 -0.176522977 0.0027815828 -0.0737542550 0.0356321989",
"2020-03-31 -0.0833977294 -0.0947947016 -0.202247102 -0.132019348 -0.1733703177 0.1781444629 -0.0110988342",
"2020-04-30 0.0185341634 -0.1334741454 0.034840554 -0.008553648 0.0654362147 0.1085853224 0.1784511944",
"2020-05-29 0.0231595962 -0.0663621855 0.054803155 -0.055389347 0.0078740488 -0.0043939705 0.0228635185",
"2020-06-30 -0.0590136819 0.0370487756 0.057072438 0.015228426 0.0000000000 -0.0994850816 -0.0852272743",
"2020-07-31 -0.0635739110 0.0098287252 0.051407658 -0.083333333 -0.0114379246 0.0120481837 -0.0455486655",
"2020-08-31 0.0926605096 0.1051805736 0.058217716 0.524545455 0.0148760579 0.0694108129 -0.0227765626")
plot_mv_frontier <- function(mv, levmax_TP = 2, new_plot = TRUE,
add_CAL = TRUE) {
weights <- mv$weights
mu <- mv$mu
sigma <- mv$sigma
stds <- sqrt(diag(sigma))
stat_p <- mv$stats
w <- seq(0, levmax_TP, length.out = 100)
w_mv <- sapply(w, function(x) (1-x)*weights[,"MVP"] + x*weights[,"TP"])
i <- seq_along(w)
mu_mv <- sapply(i, function(x) t(mu) %*% w_mv[,x])
sigma_mv <- sqrt(sapply(i, function(x) t(w_mv[,x]) %*% sigma %*% w_mv[,x]))
max_std <- max(c(stds,sigma_mv)) * 1.1 #set axis to get a nice graph
max_mu <- max(c(mu,mu_mv)) * 1.1
if(new_plot) plot(x = c(0, sigma_mv, max_std),
y = c(-0.01, mu_mv, max_mu),
type = 'n', xlab = "return volatility",
ylab = "expected return")
lines(x = sigma_mv, y = mu_mv, type = 'l', col = "blue")
if(new_plot) points(x = stds, y = mu, col = "red")
if(new_plot) text(x = stds, y = mu, labels = assets,
pos = 4, offset = 0.5, cex = 0.75, col = "darkgreen")
points(x = stat_p[2,], y = stat_p[1,],
col = "black")
text(x = stat_p[2,], y = stat_p[1,], labels = colnames(stat_p),
col = "black", pos = 2, offset = 0.5, cex = 0.75)
grid()
if(add_CAL) abline(a = 0, b = stat_p[3,1], lty = "dashed", col = "grey") #takes as b the sharpe of the TP
}
plot_mv_frontier(mv) (with mv computes with the following: mv <- computeMVstats(R))
computeMVstats <- function(R) { # R = matrix-like object containing returns
mu <- colMeans(R) #average returns
Sigma <- cov(R) #covariance matrix
SigmaInv <- solve(Sigma) #inverse function using solve
ones <- rep(1, length(mu))
# the MV constants:
a <- as.vector(t(mu) %*% SigmaInv %*% mu)
b <- as.vector(t(mu) %*% SigmaInv %*% ones)
c <- as.vector(t(ones) %*% SigmaInv %*% ones)
# the Tangency Portfolio:
w_TP <- SigmaInv %*% mu / b #weights
mu_TP <- a/b #average return
var_TP <- a/(b^2) #variance
sh_TP <- mu_TP/sqrt(var_TP) #Sharpe ratio
# the Minimum Variance Portfolio:
w_MVP <- SigmaInv %*% ones / c
mu_MVP <- b/c
var_MVP <- 1/c
sh_MVP <- mu_MVP/sqrt(var_MVP)
# join together the stats of both MV portfolios:
mv_stat <- matrix(data = c(mu_TP, sqrt(var_TP), sh_TP,
#expected return, vol
#, sharpe tangency portfolio
mu_MVP, sqrt(var_MVP), sh_MVP),
#exactly the same
#for MVP
nrow = 3)
rownames(mv_stat) <- c("mean", "std", "Sharpe") #row names
colnames(mv_stat) <- c("TP", "MVP") #first column and second column
print(mv_stat)
# join the portfolio weights for both portfolios:
mv_weights <- cbind(w_TP, w_MVP)
colnames(mv_weights) <- c("TP", "MVP")
rownames(mv_weights) <- names(R) #names of the assets
#Prepare function output as a named list:which is the one big one
MVstats <- list(assets = names(R),
mu = mu, sigma = Sigma, #expected returns assets, cov matrix
stats = mv_stat, #statistics
weights = mv_weights, #weights
mv_const = c(a = a, b = b, c = c)) #also need the constants
return(MVstats)
}
As you can see it is a normal plot without any interaction and the labels are sometimes overlapping..
