Skip to content

Instantly share code, notes, and snippets.

@jaymon0703
Last active August 28, 2021 21:54
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save jaymon0703/600eaf2996c975fc3d620776150d65d3 to your computer and use it in GitHub Desktop.
Hierarchical Risk Parity implementation in R
# R code
corMat <- read.csv("corMat_23072021.csv")[,-1]
covMat <- read.csv("covMat_23072021.csv")[,-1]
clustOrder <- hclust(dist(corMat), method = 'single')$order
clustOrder
# Plot Dendogram for some visualization of the order
clust <- hclust(dist(corMat), method = 'single')
plot(clust)
getIVP <- function(covMat) {
# get inverse variance portfolio from diagonal of covariance matrix
invDiag <- 1/diag(as.matrix(covMat))
weights <- invDiag/sum(invDiag)
return(weights)
}
getClusterVar <- function(covMat, cItems) {
# compute cluster variance from the inverse variance portfolio above
covMatSlice <- covMat[cItems, cItems]
weights <- getIVP(covMatSlice)
cVar <- t(weights) %*% as.matrix(covMatSlice) %*% weights
return(cVar)
}
getRecBipart <- function(covMat, sortIx) {
# keeping track of weights vector in the global environment
assign("w", value = rep(1, ncol(covMat)), envir = .GlobalEnv)
# run recursion function
recurFun(covMat, sortIx)
return(w)
}
recurFun <- function(covMat, sortIx) {
# get first half of sortIx which is a cluster order
subIdx <- 1:trunc(length(sortIx)/2)
# subdivide ordering into first half and second half
cItems0 <- sortIx[subIdx]
cItems1 <- sortIx[-subIdx]
# compute cluster variances of covariance matrices indexed
# on first half and second half of ordering
cVar0 <- getClusterVar(covMat, cItems0)
cVar1 <- getClusterVar(covMat, cItems1)
alpha <- 1 - cVar0/(cVar0 + cVar1)
# updating weights outside the function using scoping mechanics
w[cItems0] <<- w[cItems0] * alpha
w[cItems1] <<- w[cItems1] * (1-alpha)
# rerun the function on a half if the length of that half is greater than 1
if(length(cItems0) > 1) {
recurFun(covMat, cItems0)
}
if(length(cItems1) > 1) {
recurFun(covMat, cItems1)
}
}
out <- getRecBipart(covMat, clustOrder)
out
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment