Recently Published
Inferring Market State through Network Clustering of Regularized Partial-Correlation Matrices
#####Script_Start####
#{
# if (!requireNamespace(x)) install.packages(x)
# devtools::install_github('bwlewis/crosstool')
#}
#
#library(quantmod)
#library(igraph)
#library(threejs)
#library(crosstalk)
#library(htmltools)
#library(PerformanceAnalytics)
#
#from = "2012-12-01"
#to = "2019-12-01"
#sym = c("A", "AAL", "AAP", "AAPL", "ABBV", "ABC", "ABMD", "ABT", "ACN", "ADBE",
# "ADI", "ADM", "ADP", "ADS", "ADSK", "AEE", "AEP", "AES", "AFL", "AGN",
# "AIG", "AIV", "AIZ", "AJG", "AKAM", "ALB", "ALGN", "ALK", "ALL", "ALLE",
# "ALXN", "AMAT", "AMCR", "AMD", "AME", "AMG", "AMGN", "AMP", "AMT", "AMZN",
# "ANET", "ANSS", "ANTM", "AON", "AOS", "APA", "APD", "APH", "APTV", "ARE",
# "ARNC", "ATO", "ATVI", "AVB", "AVGO", "AVY", "AWK", "AXP", "AZO", "BA",
# "BAC", "BAX", "BBT", "BBY", "BDX", "BEN", "BF-B", "BIIB", "BK", "BKNG",
# "BLK", "BLL", "BMY", "BR", "BRK-B", "BSX", "BWA", "BXP", "C",
# "CAG", "CAH", "CAT", "CB", "CBOE", "CBRE", "CBS", "CCI", "CCL", "CDNS",
# "CDW", "CE", "CERN", "CF", "CFG", "CHD", "CHRW", "CHTR", "CI", "CINF",
# "CL", "CLX", "CMA", "CMCSA", "CME", "CMG", "CMI", "CMS", "CNC", "CNP",
# "COF", "COG", "COO", "COP", "COST", "COTY", "CPB", "CPRI", "CPRT", "CRM",
# "CSCO", "CSX", "CTAS", "CTL", "CTSH", "CTVA", "CVS", "CVX", "CXO",
# "D", "DAL", "DD", "DE", "DFS", "DG", "DGX", "DHI", "DHR", "DIS",
# "DISCA", "DISCK", "DISH", "DLR", "DLTR", "DOV", "DOW", "DRE", "DRI",
# "DVA", "DVN", "DXC", "EA", "EBAY", "ECL", "ED", "EFX", "EIX",
# "EL", "EMN", "EMR", "EOG", "EQIX", "EQR", "ES", "ESS", "ETFC", "ETN",
# "ETR", "EVRG", "EW", "EXC", "EXPD", "EXPE", "EXR", "F", "FANG", "FAST",
# "FB", "FBHS", "FCX", "FDX", "FE", "FFIV", "FIS", "FISV", "FITB", "FLIR",
# "FLS", "FLT", "FMC", "FOX", "FOXA", "FRC", "FRT", "FTI", "FTNT", "FTV",
# "GD", "GE", "GILD", "GIS", "GL", "GLW", "GM", "GOOG", "GOOGL", "GPC",
# "GPN", "GPS", "GRMN", "GS", "GWW", "HAL", "HAS", "HBAN", "HBI", "HCA",
# "HD", "HES", "HFC", "HIG", "HII", "HLT", "HOG", "HOLX", "HON", "HP",
# "HPE", "HPQ", "HRB", "HRL", "HSIC", "HST", "HSY", "HUM", "IBM", "ICE",
# "IDXX", "IEX", "IFF", "ILMN", "INCY", "INFO", "INTC", "INTU", "IP", "IPG",
# "IPGP", "IQV", "IR", "IRM", "ISRG", "IT", "ITW", "IVZ", "JBHT", "JCI",
# "JEC", "JKHY", "JNPR", "JPM", "JWN", "K", "KEY", "KEYS", "KHC",
# "KIM", "KLAC", "KMB", "KMI", "KMX", "KO", "KR", "KSS", "KSU", "L",
# "LB", "LDOS", "LEG", "LEN", "LH", "LHX", "LIN", "LKQ", "LLY", "LMT",
# "LNC", "LNT", "LOW", "LRCX", "LUV", "LVS", "LW", "LYB", "M", "MA",
# "MAA", "MAC", "MAR", "MAS", "MCD", "MCHP", "MCK", "MCO", "MDLZ", "MDT",
# "MET", "MGM", "MHK", "MKC", "MKTX", "MLM", "MMC", "MMM", "MNST", "MO",
# "MOS", "MPC", "MRK", "MRO", "MS", "MSCI", "MSFT", "MSI", "MTB", "MTD",
# "MU", "MXIM", "MYL", "NBL", "NCLH", "NDAQ", "NEE", "NEM", "NFLX",
# "NKE", "NLSN", "NOC", "NOV", "NOW", "NRG", "NSC", "NTAP", "NTRS",
# "NUE", "NVDA", "NVR", "NWL", "NWS", "NWSA", "O", "OKE", "OMC", "ORCL",
# "OXY", "PAYX", "PBCT", "PCAR", "PEAK", "PEG", "PEP", "PFE", "PFG",
# "PG", "PGR", "PH", "PHM", "PKG", "PKI", "PLD", "PM", "PNC", "PNR",
# "PNW", "PPG", "PPL", "PRGO", "PRU", "PSA", "PSX", "PVH", "PWR", "PXD",
# "PYPL", "QCOM", "QRVO", "RCL", "RE", "REG", "REGN", "RF", "RHI", "RJF",
# "RL", "RMD", "ROK", "ROL", "ROP", "ROST", "RSG", "RTN", "SBAC", "SBUX",
# "SCHW", "SEE", "SHW", "SIVB", "SJM", "SLB", "SLG", "SNPS",
# "SPG", "SPGI", "SRE", "STI", "STT", "STX", "STZ", "SWK", "SWKS", "SYF",
# "SYK", "SYY", "T", "TAP", "TDG", "TEL", "TFX", "TGT", "TIF", "TJX",
# "TMO", "TMUS", "TPR", "TRIP", "TROW", "TRV", "TSCO", "TSN", "TTWO", "TWTR",
# "TXN", "TXT", "UAA", "UAL", "UDR", "UHS", "ULTA", "UNH", "UNM",
# "UNP", "UPS", "URI", "USB", "UTX", "V", "VAR", "VFC", "VIAB", "VLO",
# "VMC", "VNO", "VRSK", "VRSN", "VRTX", "VTR", "VZ", "WAB", "WAT", "WBA",
# "WCG", "WDC", "WEC", "WELL", "WFC", "WHR", "WLTW", "WM", "WMB", "WMT",
# "WRK", "WU", "WY", "WYNN", "XEC", "XEL", "XOM", "XRAY", "XRX",
# "XYL", "YUM", "ZBH", "ZION", "ZTS")
#
#
#prices = Map(function(n)
# {
# print(n)
# tryCatch(getSymbols(n, src = 'yahoo', env = NULL, from = from, to = to)[, 4], error = function(e) NA)
# }, sym)
#N = length(prices)
#
#i = !unlist(Map(function(i) is.na(prices[i]), seq(N)))
#
#prices = Reduce(cbind, prices[i])
#colnames(prices) = sym[i]
#
#for (j in 1:ncol(prices)) prices[, j] = na.locf(prices[, j])
#prices = prices[, apply(prices, 2, function(x) !any(is.na(x)))]
#save(prices, file = 'priceless.rdata')
#
#chart_Series(prices[, "ABMD"])
#
#log_returns = apply(prices, 2, function(x) diff(log(x)))
#save(log_returns, file = 'log_returns.rdata')
#
#qqnorm(prices[,"ABMD"]);qqline(prices[,"ABMD"])
#qqnorm(log_returns[,"ABMD"]);qqline(log_returns[,"ABMD"])
#
#
#
#
##Observation of LnReturn heatmap
##image(Log_returns[466:1, ], useRaster = TRUE)
#
#X = cor(log_returns)
#
##Observation of SCM lnReturn heatmap
#image(X[466:1, ], useRaster = TRUE)
#
#P = solve(X)
#P = P/tcrossprod(sqrt(diag(P)))
#colnames(P) = colnames(X)
#
##Observation of Scaled Inverse Pearson Matrix heatmap
##image(P[466:1, ], useRaster = TRUE)
#
#
#X = cor(log_returns)
#L = eigen(X, symmetric = TRUE)
#plot(L$values, ylab = "eigenvalues", xlab = "Index")
#abline(v = 10)
#
#N = 10
#P = L$vectors[, 1:N] %*% ((1 / L$values[1:N]) * t(L$vectors[, 1:N]))
#P = P / tcrossprod(sqrt(diag(P)))
#colnames(P) = colnames(X)
#
#
#threshold = 0.90
#
#Q = P * (P > quantile(P, probs = threshold))
#g = graph.adjacency(Q, mode = "undirected", weighted = TRUE, diag = FALSE)
##image(Q[466:1, ], useRaster = TRUE)
##Observation of 0.90 quantile thresholded Precision Matrix heatmap
#
#
##Network generation for given threshold(s) and precision matrix (Q)
#f = function(threshold, P)
#{
# Q = P * (P > quantile(P, probs = threshold))
# g = graph.adjacency(Q, mode = "undirected", weighted = TRUE, diag = FALSE)
#
# x = groups(cluster_louvain(g))
# i = unlist(lapply(x, length))
# d = order(i, decreasing = TRUE)
# x = x[d]
# i = i[d]
# j = i > 1
# s = sum(j)
# names(x)[j] = seq(1, s)
# names(x)[!j] = s + 1
# grp = as.integer(rep(names(x), i))
# clrs = c(rainbow(s), "gray")[grp[order(unlist(x))]]
# g = set_vertex_attr(g, "color", value = clrs)
# set_vertex_attr(g, "shape", value = colnames(P))
#}
#
#threshold = c(0.995, 0.99, 0.98, 0.97, 0.95, 0.90)
#g = Map(f, threshold, MoreArgs = list(P = P)) # <-list of graphs, one for each threshold
#
## Computation of force-directed network layouts for each threshold value
## Note - mcMap "core" resraint of 1 in Windows based R-studio, therefore 'detect cores' non-compatiple
#
#library(parallel)
#
#l = mcMap(function(x) layout_with_fr(x, dim = 3, niter = 150), g)
#
#sdf = SharedData$new(data.frame(key = paste(seq(0, length(threshold) - 1))), key = ~key)
#slider = crosstool(sdf, "transmitter",
# sprintf("<input type='range' min='0' max='%d' value='0'/>",
# length(threshold) - 1), width = "100%", height = 20, channel = "filter")
#vis = graphjs(g, l, vertex.size = 0.2, main = as.list(threshold), defer = TRUE, edge.alpha = 0.5, deferfps = 30,
# crosstalk = sdf, width = "100%", height = 900)
#
#browsable(div(list(HTML("<center>"), tags$h3("Precision matrix quantile threshold (adjust slider to change)"), #slider, vis)))
#
#####Script_End#####
GCAI CA660 Precision Matrix Network Clusters
Interactive visualization of the S&P500 precision network of stock association clusters
Cluster-Segmented Network Precision Matrix (with force-directed and thresholded network layout)
Sample correlation matrix of Log(returns) data regularised into a low-rank matrix through (the chosen regularisation parameter) eigenvalue decomposition.
N-rank choice of first 10 eigenvalues removes subspace associated with including the very small eigenvalues present in the matrix thus avoiding aplification of noise that would be otherwise created when the inverse the original sample correlation matrix, that is, when the precision matrix values are calculated.
This precision matrix can be thought of as an adjacency matrix defining a weighted undirected network of stock associations. The precision matrix depicted here is processed with a fast community detection alogrithm via igraph's nascent 'cluster_louvain()' function, to segment the (top 10th percentile) thresholded precision matrix into groups.
Here, Object g represents the igraph graph, vertices contained theirein are coloured by group membership and rejected unassociated 'singletons' lacking edges are grouped in grey.
The R 'threejs' package enables visualisation and interaction of this network
with the following settings
graphjs(g, vertex.size = 0.2, vertex.shape = colnames(x), edge.alpha = 0.5)
stock return series networks and sample correlation matrix regularization
SP500 ticker precision matrix quantile threshold, expressed as graph
Plot
CA660 Test Plot