diff --git a/DESCRIPTION b/DESCRIPTION index 74dca6c..0761ef1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,17 +1,18 @@ -Package: fingraph -Title: Learning Graphs for Financial Markets +Package: balancedfingraph +Title: Learning Balanced Graphs for Financial Markets Version: 0.1.0 Date: 2023-02-02 -Description: Learning graphs for financial markets with optimization algorithms. - This package contains implementations of the algorithms described in the paper: - Cardoso JVM, Ying J, and Palomar DP (2021) +Description: Learning balanced graphs for financial markets. + This package contains implementations of the algorithms described in these papers: + A. Javaheri, J. V. De M. Cardoso and D. P. Palomar (2023) + "Graph Learning for Balanced Clustering of Heavy-Tailed Data," 2023 IEEE 9th International Workshop on Computational Advances in Multi-Sensor Adaptive Processing (CAMSAP), 2023 + J. V. De M. Cardoso, J. Ying, and D. P. Palomar (2021) "Learning graphs in heavy-tailed markets", Advances in Neural Informations Processing Systems (NeurIPS). -Authors@R: c( - person("Ze", "Vinicius", role = c("cre", "aut"), email = "jvmirca@gmail.com"), - person("Daniel", "Palomar", role = c("cre", "aut"), email = "daniel.p.palomar@gmail.com"), - ) -URL: https://github.com/convexfi/fingraph/ -BugReports: https://github.com/convexfi/fingraph/issues +Authors@R: c( person("Ze", "Vinicius", role = c("cre", "aut"), email = "jvmirca@gmail.com"), + person("Amirhossein", "Javaheri", role = c("aut"), email = "javaheriamirhosein@gmail.com"), + person("Daniel", "Palomar", role = c("aut"), email = "daniel.p.palomar@gmail.com")) +URL: https://github.com/javaheriamirhossein/balanced-fingraph +BugReports: https://github.com/javaheriamirhossein/balanced-fingraph/issues License: GPL-3 Encoding: UTF-8 Depends: spectralGraphTopology @@ -22,8 +23,4 @@ Imports: mvtnorm Suggests: testthat -RoxygenNote: 7.1.1 -VignetteBuilder: - knitr, - rmarkdown, - R.rsp +RoxygenNote: 7.2.2 diff --git a/Makefile b/Makefile deleted file mode 100644 index 320243b..0000000 --- a/Makefile +++ /dev/null @@ -1,16 +0,0 @@ -clean: - rm -v src/*.so src/*.o - rm -v R/RcppExports.R - rm -v src/RcppExports.cpp - -build: - Rscript .roxygenize.R - -install: - R CMD INSTALL ../fingraph - -test: - Rscript -e "devtools::test()" - -all: - make build && make install && make test diff --git a/NAMESPACE b/NAMESPACE index 1cdcb15..54c60b3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,5 +2,6 @@ export(learn_connected_graph) export(learn_kcomp_heavytail_graph) +export(learn_kcomp_heavytail_graph_balanced) export(learn_regular_heavytail_graph) import(spectralGraphTopology) diff --git a/R/learn_kcomp_heavytail_graph_balanced.R b/R/learn_kcomp_heavytail_graph_balanced.R new file mode 100644 index 0000000..7697dd9 --- /dev/null +++ b/R/learn_kcomp_heavytail_graph_balanced.R @@ -0,0 +1,230 @@ +library(spectralGraphTopology) + +#' @title Laplacian matrix of a balanced k-component graph with heavy-tailed data +#' +#' Computes the Laplacian matrix of a balanced graph on the basis of an observed data matrix, +#' where we assume the data to be Student-t distributed. +#' +#' @param X an n x p data matrix, where n is the number of observations and p is +#' the number of nodes in the graph. +#' @param k the number of components of the graph. +#' @param heavy_type a string which selects the statistical distribution of the data . +#' Valid values are "gaussian" or "student". +#' @param nu the degrees of freedom of the Student-t distribution. +#' Must be a real number greater than 2. +#' @param w0 initial vector of graph weights. Either a vector of length p(p-1)/2 or +#' a string indicating the method to compute an initial value. +#' @param beta hyperparameter that controls the regularization to obtain a +#' k-component graph +#' @param update_beta whether to update beta during the optimization. +#' @param alpha spare regularization term parameter +#' @param t upperbound scale parameter +#' @param d the nodes' degrees. Either a vector or a single value. +#' @param rho ADMM hyperparameter. +#' @param update_rho whether or not to update rho during the optimization. +#' @param maxiter maximum number of iterations. +#' @param reltol relative tolerance as a convergence criteria. +#' @param verbose whether or not to show a progress bar during the iterations. +#' @export +#' @import spectralGraphTopology +learn_kcomp_heavytail_graph_balanced <- function(X, + alpha = 0.1, + k = 1, + heavy_type = "gaussian", + nu = NULL, + w0 = "naive", + d = 1, + t = 1.2, + beta = 1e-8, + update_beta = TRUE, + early_stopping = FALSE, + rho = 1, + update_rho = FALSE, + maxiter = 10000, + reltol = 1e-5, + verbose = TRUE, + record_objective = FALSE) { + + X <- scale(as.matrix(X)) + # number of nodes + p <- ncol(X) + + t <- t*d/sqrt(p-1) + # number of observations + n <- nrow(X) + LstarSq <- vector(mode = "list", length = n) + for (i in 1:n) + LstarSq[[i]] <- Lstar(X[i, ] %*% t(X[i, ])) / n + # w-initialization + if (assertthat::is.string(w0)) { + w <- spectralGraphTopology:::w_init(w0, MASS::ginv(cor(X))) + A0 <- A(w) + A0 <- A0 / rowSums(A0) + w <- spectralGraphTopology:::Ainv(A0) + } + else { + w <-w0 + } + # Theta-initilization + Lw <- L(w) + Aw <- A(w) + Theta <- Lw + U <- eigen(Lw, symmetric = TRUE)$vectors[, (p - k + 1):p] + Y <- matrix(0, p, p) + y <- rep(0, p) + # Z-initialization + Lambda <- matrix(0, p, p) + Z <- A0 + + # ADMM constants + mu <- 2 + tau <- 2 + # residual vectors + primal_lap_residual <- c() + primal_deg_residual <- c() + dual_residual <- c() + # augmented lagrangian vector + lagrangian <- c() + beta_seq <- c() + if (verbose) + pb <- progress::progress_bar$new(format = "<:bar> :current/:total eta: :eta", + total = maxiter, clear = FALSE, width = 80) + elapsed_time <- c() + start_time <- proc.time()[3] + for (i in 1:maxiter) { + + for (j in 1:1){ + # update w + LstarLw <- Lstar(Lw) + DstarDw <- Dstar(diag(Lw)) + LstarSweighted <- rep(0, .5*p*(p-1)) + if (heavy_type == "student") { + for (q in 1:n) + LstarSweighted <- LstarSweighted + LstarSq[[q]] * compute_student_weights(w, LstarSq[[q]], p, nu) + } else if (heavy_type == "gaussian") { + for (q in 1:n) + LstarSweighted <- LstarSweighted + LstarSq[[q]] + } + grad <- LstarSweighted + Lstar(beta * crossprod(t(U)) - Y - rho * Theta) + Dstar(y - rho * d) + rho * (LstarLw + DstarDw) + grad <- grad + Astar( rho * (Aw-Z) + Lambda ) + eta <- 1 / (2*rho * (2*p - 1)+ 2*rho) + wi <- w - eta * grad + thr <- sqrt(2*alpha *eta ) + wi[wi< thr] <- 0 + Lwi <- L(wi) + Awi <- A(wi) + } + + # Update Z + Z <- Awi + Lambda/rho + for (i in 1:p){ + norm_i <- norm(Z[i,], type="2") + if (norm_i>t) { + Z[i,] <- Z[i,]/norm_i *t + } + } + + + # update U + U <- eigen(Lwi, symmetric = TRUE)$vectors[, (p - k + 1):p] + + # update Theta + eig <- eigen(rho * Lwi - Y, symmetric = TRUE) + V <- eig$vectors[,1:(p-k)] + gamma <- eig$values[1:(p-k)] + Thetai <- V %*% diag((gamma + sqrt(gamma^2 + 4 * rho)) / (2 * rho)) %*% t(V) + + # update Y + R1 <- Thetai - Lwi + Y <- Y + rho * R1 + + # update y + R2 <- diag(Lwi) - d + y <- y + rho * R2 + + R3 = Awi - Z + Lambda <- Lambda + rho * R3 + # compute primal, dual residuals, & lagrangian + primal_lap_residual <- c(primal_lap_residual, norm(R1, "F")) + primal_deg_residual <- c(primal_deg_residual, norm(R2, "2")) + dual_residual <- c(dual_residual, rho*norm(Lstar(Theta - Thetai), "2")) + lagrangian <- c(lagrangian, compute_augmented_lagrangian_kcomp_ht_balanced(wi, LstarSq, Thetai, U, Y, y, d, heavy_type, n, p, k, rho, beta, nu, alpha, Z, Lambda)) + + # update rho + if (update_rho) { + eig_vals <- spectralGraphTopology:::eigval_sym(Theta) + n_zero_eigenvalues <- sum(eig_vals < 1e-9) + if (k < n_zero_eigenvalues) + rho <- .5 * rho + else if (k > n_zero_eigenvalues) + rho <- 2 * rho + else { + if (early_stopping) { + has_converged <- TRUE + break + } + } + } + if (update_beta) { + eig_vals <- spectralGraphTopology:::eigval_sym(L(wi)) + n_zero_eigenvalues <- sum(eig_vals < 1e-9) + if (k < n_zero_eigenvalues) + beta <- .5 * beta + else if (k > n_zero_eigenvalues) + beta <- 2 * beta + else { + if (early_stopping) { + has_converged <- TRUE + break + } + } + beta_seq <- c(beta_seq, beta) + } + if (verbose) + pb$tick() + + elapsed_time <- c(elapsed_time, proc.time()[3] - start_time) + has_converged <- (norm(Lwi - Lw, 'F') / norm(Lw, 'F') < reltol) && (i > 1) + if (has_converged) + break + w <- wi + Lw <- Lwi + Aw <- Awi + + Theta <- Thetai + } + results <- list(laplacian = L(wi), adjacency = A(wi), theta = Thetai, maxiter = i, + convergence = has_converged, beta_seq = beta_seq, + primal_lap_residual = primal_lap_residual, + primal_deg_residual = primal_deg_residual, + dual_residual = dual_residual, + lagrangian = lagrangian, + elapsed_time = elapsed_time) + return(results) +} + +compute_augmented_lagrangian_kcomp_ht_balanced <- function(w, LstarSq, Theta, U, Y, y, d, heavy_type, n, p, k, rho, beta, nu, alpha, Z, Lambda) { + eig <- eigen(Theta, symmetric = TRUE, only.values = TRUE)$values[1:(p-k)] + Lw <- L(w) + Aw <- A(w) + Dw <- diag(Lw) + u_func <- 0 + if (heavy_type == "student") { + for (q in 1:n) + u_func <- u_func + (p + nu) * log(1 + n * sum(w * LstarSq[[q]]) / nu) + } else if (heavy_type == "gaussian"){ + for (q in 1:n) + u_func <- u_func + sum(n * w * LstarSq[[q]]) + } + u_func <- u_func / n + return(u_func - sum(log(eig)) + sum(y * (Dw - d)) + sum(diag(Y %*% (Theta - Lw))) + + .5 * rho * (norm(Dw - d, "2")^2 + norm(Lw - Theta, "F")^2) + beta * sum(w * Lstar(crossprod(t(U)))) + + .5 * rho * norm(Aw - Z, "2")^2 + sum(diag(Lambda %*% (Aw - Z))) + + alpha * sum(w>0) ) +} + +hardThresh <- function(v, thr){ + + return( v * (abs(v) > thr) ) + +} diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..7d0f3ee --- /dev/null +++ b/R/utils.R @@ -0,0 +1,263 @@ +Mode <- function(v) { + uniqv <- unique(v) + return ( uniqv[which.max(tabulate(match(v, uniqv)))] ) +} + + +Balancedness <- function(netobj, p, q) { + clust_size <- igraph::components(netobj)$csize + k <- length(clust_size) + if (k= lb) { + alpha <- 0 + } + + else if (sum(x0>=0) == n) { + alpha <- (lb - sum(x0)) / n + } + + else{ + + x0_sorted <- sort(x0, decreasing = TRUE) + id_neg <- which(x0_sorted<0) + if (id_neg[1]>1) { + id_neg <- c(id_neg[1]-1,id_neg) + } + + x0_csum <- cumsum(x0_sorted) + + for (j in 1:length(id_neg)) { + id <- id_neg[j] + alpha <- (lb - x0_csum[id])/id + + if (id=0 & -alpha < x0_sorted[id] & -alpha >= x0_sorted[id+1]) { + break + } + } + + } + + } + + x <- x0 + alpha + x[x<0] = 0 + + return(x) +} + + + + + + +simplex_project_lb_ub <- function(x0, lb = 0, ub = Inf) { + # Ensure x0 is a column vector + x0 <- as.vector(x0) + + # Define the length of x0 + n <- length(x0) + + # Set negative elements in x0 to 0 + x0_pos <- pmax(x0, 0) + + # Sort x0 in descending order + x0_sorted <- sort(x0, decreasing = TRUE) + + # Cumulative sum of sorted x0 + x0_csum <- cumsum(x0_sorted) + + # Initialize beta and alpha + beta <- 0 + alpha <- 0 + + # Calculate beta for the upper bound constraint + if (sum(x0_pos) <= ub) { + beta <- 0 + } else if (sum(x0 >= 0) == n) { + beta <- (sum(x0) - ub) / n + } else { + for (j in 1:n) { + beta <- (x0_csum[j] - ub) / j + if (j < n) { + if (beta >= 0 && beta < x0_sorted[j] && beta >= x0_sorted[j + 1]) { + break + } + } else { + if (beta >= 0 && beta < x0_sorted[j]) { + break + } + } + } + } + + # Calculate alpha for the lower bound constraint + if (sum(x0_pos) >= lb) { + alpha <- 0 + } else if (sum(x0 >= 0) == n) { + alpha <- (lb - sum(x0)) / n + } else { + id_neg <- which(x0_sorted < 0) + if (length(id_neg) > 0 && id_neg[1] > 1) { + id_neg <- c(id_neg[1] - 1, id_neg) + } + + for (j in seq_along(id_neg)) { + id <- id_neg[j] + alpha <- (lb - x0_csum[id]) / id + if (id < n) { + if (alpha >= 0 && -alpha < x0_sorted[id] && -alpha >= x0_sorted[id + 1]) { + break + } + } else { + if (alpha >= 0 && -alpha < x0_sorted[id]) { + break + } + } + } + } + + # Project x0 using the calculated alpha and beta + x <- x0 - beta + alpha + x <- pmax(x, 0) + # x <- pmax(x0 - beta, lb) + # x <- pmin(x + alpha, ub) + + return(x) +} + + + + +project_circle <- function(z0, d, u) { + beta <- min(z0) + itermax <- 1000 + reltol <- 1e-6 + p <- length(z0) + c <- (sum(z0)-d)/p + pu <- p*u + + for (j in 1:itermax) { + z0_sub <- z0 - rep(beta,p) + z0_sub_pos <- z0_sub + z0_sub_pos[z0_sub_pos<0] <- 0; + z0_sub_neg <- -z0_sub; + z0_sub_neg[z0_sub_neg<0] <- 0; + + beta_new <- ( u*sum(z0_sub_neg) - d*max(0,norm(z0_sub_pos,'2')-u) )/pu + c; + if ( norm(beta - beta_new,'2')/norm(beta,'2') < reltol ) { + break + } + + beta <- beta_new + } + + z <- z0_sub_pos + z_norm <- norm(z,'2'); + if (z_norm>u) { + z <- z/z_norm * u; + } + + return( z ) +} + + + +evaluate_clustering <- function(net, stock_sectors_index, p, q) { + labels_pred <- rep(0, p) + for (j in 1:q){ + idx <- igraph::components(net)$membership %in% c(j) + labels_pred[idx] <- Mode(stock_sectors_index[idx]) + } + + mask <- labels_pred != stock_sectors_index + purity_Fin <- 1- sum(mask)/length(mask) + + + + labels_pred_adj <- igraph::components(net)$membership + perms <- permn(c(1:q)) + acc_max <- 0 + for (k in 1:length(perms)){ + perm <- perms[[k]] + for (j in 1:q){ + idx <- labels_pred %in% j + labels_pred_adj[idx] <- perm[j] + + } + mask <- labels_pred_adj != stock_sectors_index + acc <- 1- sum(mask)/length(mask) + if (acc>= acc_max) { + acc_max <- acc + ind_max <- k + } + } + perm <- perms[[ind_max]] + for (j in 1:q){ + idx <- labels_pred %in% j + labels_pred_adj[idx] <- perm[j] + } + + NMI_val <- randnet::NMI(labels_pred_adj, stock_sectors_index) + + ARI <- mclust::adjustedRandIndex(labels_pred_adj, stock_sectors_index) + mask <- labels_pred_adj != stock_sectors_index + accuracy_adj <- 1- sum(mask)/length(mask) + + + + + mod_gt <- modularity(net, stock_sectors_index) + + balanced_norm <- Balancedness_norm(net, p, q) + GINI_metric <- GINI(net) + + metrics <- list( labels_pred = labels_pred, labels_pred_adj = labels_pred_adj, + accuracy = accuracy_adj, purity = purity_Fin, + mod = mod_gt, + balanced = balanced_norm, GINI = GINI_metric, + NMI = NMI_val, ARI = ARI) + return( metrics ) +} + + diff --git a/README.Rmd b/README.Rmd deleted file mode 100644 index 098bf5e..0000000 --- a/README.Rmd +++ /dev/null @@ -1,160 +0,0 @@ ---- -title: "fingraph README" -output: - html_document: - keep_md: true ---- - -```{r, echo = FALSE} -library(knitr) -opts_chunk$set( - collapse = TRUE, - comment = "#>", - fig.path = "man/figures/README-", - fig.align = "center", - fig.retina = 2, - out.width = "75%", - dpi = 96 -) -knit_hooks$set(pngquant = hook_pngquant) -``` - -# fingraph -[![codecov](https://codecov.io/gh/convexfi/fingraph/branch/main/graph/badge.svg?token=OhreF1p2Yt)](https://app.codecov.io/gh/convexfi/fingraph) - - -This repo contains ADMM implementations to estimate weighted undirected graphs -(Markov random fields) under Student-t assumptions with applications to financial -markets. - -## Installation - -**fingraph** depends on the development version of **spectralGraphTopology**, -which can be installed as: -```{r, eval = FALSE} -> devtools::install_github("convexfi/spectralGraphTopology") -``` - -The stable version of **fingraph** can be installed directly from CRAN: -```{r, eval = FALSE} -> install.packages("fingraph") -``` - -#### Microsoft Windows -On MS Windows environments, make sure to install the most recent version of ``Rtools``. - -## Usage - -### Learning a graph of cryptocurrencies -```{r plot_crypto_network, message=FALSE} -library(igraph) -library(fingraph) -library(fitHeavyTail) -library(xts) -set.seed(123) - -# load crypto prices into an xts table -crypto_prices <- readRDS("examples/crypto/crypto-prices.rds") -colnames(crypto_prices) - -# compute log-returns -log_returns <- diff(log(crypto_prices), na.pad = FALSE) - -# estimate a weighted, undirected graph (markov random field) -graph_mrf <- learn_kcomp_heavytail_graph(scale(log_returns), - k = 8, - heavy_type = "student", - nu = fit_mvt(scale(log_returns))$nu, - verbose = FALSE) - -# plot network -net <- graph_from_adjacency_matrix(graph_mrf$adjacency, - mode = "undirected", - weighted = TRUE) -cfg <- cluster_fast_greedy(as.undirected(net)) -la_kcomp <- layout_nicely(net) -V(net)$label.cex = 1 -plot(cfg, net, vertex.label = colnames(crypto_prices), - layout = la_kcomp, - vertex.size = 4.5, - col = "black", - edge.color = c("#686de0"), - vertex.label.family = "Helvetica", - vertex.label.color = "black", - vertex.label.dist = 1.25, - vertex.shape = "circle", - edge.width = 20*E(net)$weight, - edge.curved = 0.1) -``` - - -### Learning a network of S&P500 stocks -```{r plot_sp500_stocks_network, message=FALSE} -library(xts) -library(igraph) -library(fingraph) -library(fitHeavyTail) -library(readr) -set.seed(123) - -# load table w/ stocks and their sectors -SP500 <- read_csv("examples/stocks/SP500-sectors.csv") - -# load stock prices into an xts table -stock_prices <- readRDS("examples/stocks/stock-data-2014-2018.rds") -colnames(stock_prices) - -# compute log-returns -log_returns <- diff(log(stock_prices), na.pad = FALSE) - -# estimate a weighted, undirected graph (markov random field) -graph_mrf <- learn_kcomp_heavytail_graph(scale(log_returns), - rho = 10, - k = 3, - heavy_type = "student", - nu = fit_mvt(scale(log_returns))$nu, - verbose = FALSE) - -# map stock names and sectors -stock_sectors <- c(SP500$GICS.Sector[SP500$Symbol %in% colnames(stock_prices)]) -stock_sectors_index <- as.numeric(as.factor(stock_sectors)) - -# plot network -net <- graph_from_adjacency_matrix(graph_mrf$adjacency, - mode = "undirected", - weighted = TRUE) -la_kcomp <- layout_nicely(net) -V(net)$label.cex = 1 -colors <- c("#FD7272", "#55E6C1", "#25CCF7") -V(net)$color <- colors[stock_sectors_index] -V(net)$type <- stock_sectors_index -V(net)$cluster <- stock_sectors_index -E(net)$color <- apply(as.data.frame(get.edgelist(net)), 1, - function(x) ifelse(V(net)$cluster[x[1]] == V(net)$cluster[x[2]], - colors[V(net)$cluster[x[1]]], 'grey')) -plot(net, vertex.label = colnames(stock_prices), - layout = la_kcomp, - vertex.size = 4.5, - vertex.label.family = "Helvetica", - vertex.label.dist = 1.25, - vertex.label.color = "black", - vertex.shape = "circle", - edge.width = 20*E(net)$weight, - edge.curved = 0.1) -``` - -## Citation -If you made use of this software please consider citing: - -- [Cardoso JVM](https://mirca.github.io), [Ying J](https://github.com/jxying), - [Palomar DP](https://www.danielppalomar.com) (2021). - [Graphical Models in Heavy-Tailed Markets](https://papers.nips.cc/paper/2021/hash/a64a034c3cb8eac64eb46ea474902797-Abstract.html). - [Advances in Neural Information Processing Systems](https://neurips.cc/Conferences/2021) (NeurIPS’21). - -## Links -- [RFinance'23 Slides](https://github.com/mirca/rfinance-talk/blob/main/rfinance.pdf) -- [NeurIPS’21 Slides](https://palomar.home.ece.ust.hk/papers/2021/CardosoYingPalomar-NeurIPS2021-slides.pdf) -- [NeurIPS'21 Poster](https://palomar.home.ece.ust.hk/papers/2021/CardosoYingPalomar-NeurIPS2021-poster.png) -- [NeurIPS'21 Supplementary Material](https://palomar.home.ece.ust.hk/papers/2021/CardosoYingPalomar-NeurIPS2021-supplemental.pdf) -- [CRAN Package](https://cran.r-project.org/package=fingraph) - diff --git a/README.html b/README.html deleted file mode 100644 index d0d7438..0000000 --- a/README.html +++ /dev/null @@ -1,568 +0,0 @@ - - - - - - - - - - - - - -fingraph README - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - - - - - -
-

fingraph

-

codecov

-

This repo contains ADMM implementations to estimate weighted undirected graphs (Markov random fields) under Student-t assumptions with applications to financial markets.

-
-

Installation

-

fingraph depends on the development version of spectralGraphTopology, which can be installed as:

-
> devtools::install_github("convexfi/spectralGraphTopology")
-

The stable version of fingraph can be installed directly from CRAN:

-
> install.packages("fingraph")
-
-

Microsoft Windows

-

On MS Windows environments, make sure to install the most recent version of Rtools.

-
-
-
-

Usage

-
-

Learning a graph of cryptocurrencies

-
library(igraph)
-library(fingraph)
-library(fitHeavyTail)
-library(xts)
-set.seed(123)
-
-# load crypto prices into an xts table
-crypto_prices <- readRDS("examples/crypto/crypto-prices.rds")
-colnames(crypto_prices)
-#>  [1] "BTC"      "ETH"      "USDT"     "BNB"      "USDC"     "XRP"     
-#>  [7] "ADA"      "HEX"      "DOGE"     "SOL"      "MATIC"    "DOT"     
-#> [13] "TRX"      "LTC"      "BUSD"     "SHIB"     "AVAX"     "DAI"     
-#> [19] "LEO"      "LINK"     "ATOM"     "UNI7083"  "XMR"      "OKB"     
-#> [25] "ETC"      "TON11419" "XLM"      "BCH"      "ICP"      "CNX"     
-#> [31] "TUSD"     "FIL"      "HBAR"     "CRO"      "LDO"      "NEAR"    
-#> [37] "VET"      "QNT"      "ALGO"     "USDP"     "FTM"      "GRT6719"
-
-# compute log-returns
-log_returns <- diff(log(crypto_prices), na.pad = FALSE)
-
-# estimate a weighted, undirected graph (markov random field)
-graph_mrf <- learn_kcomp_heavytail_graph(scale(log_returns),
-                                         k = 8,
-                                         heavy_type = "student",
-                                         nu = fit_mvt(scale(log_returns))$nu,
-                                         verbose = FALSE)
-
-# plot network
-net <- graph_from_adjacency_matrix(graph_mrf$adjacency,
-                                   mode = "undirected",
-                                   weighted = TRUE)
-cfg <- cluster_fast_greedy(as.undirected(net))
-la_kcomp <- layout_nicely(net)
-V(net)$label.cex = 1
-plot(cfg, net, vertex.label = colnames(crypto_prices),
-     layout = la_kcomp,
-     vertex.size = 4.5,
-     col = "black",
-     edge.color = c("#686de0"),
-     vertex.label.family = "Helvetica",
-     vertex.label.color = "black",
-     vertex.label.dist = 1.25,
-     vertex.shape = "circle",
-     edge.width = 20*E(net)$weight,
-     edge.curved = 0.1)
-

-
-
-

Learning a network of S&P500 stocks

-
library(xts)
-library(igraph)
-library(fingraph)
-library(fitHeavyTail)
-library(readr)
-set.seed(123)
-
-# load table w/ stocks and their sectors
-SP500 <- read_csv("examples/stocks/SP500-sectors.csv")
-
-# load stock prices into an xts table
-stock_prices <- readRDS("examples/stocks/stock-data-2014-2018.rds")
-colnames(stock_prices)
-#>  [1] "AEE"   "AEP"   "AES"   "AIV"   "AMT"   "ARE"   "ATO"   "ATVI"  "AVB"  
-#> [10] "AWK"   "BXP"   "CBRE"  "CCI"   "CHTR"  "CMCSA" "CMS"   "CNP"   "CTL"  
-#> [19] "D"     "DIS"   "DISCA" "DISCK" "DISH"  "DLR"   "DRE"   "DTE"   "DUK"  
-#> [28] "EA"    "ED"    "EIX"   "EQIX"  "EQR"   "ES"    "ESS"   "ETR"   "EVRG" 
-#> [37] "EXC"   "EXR"   "FB"    "FE"    "FRT"   "GOOG"  "GOOGL" "HST"   "IPG"  
-#> [46] "IRM"   "KIM"   "LNT"   "LYV"   "MAA"   "NEE"   "NFLX"  "NI"    "NRG"  
-#> [55] "NWS"   "NWSA"  "O"     "OMC"   "PEAK"  "PEG"   "PLD"   "PNW"   "PPL"  
-#> [64] "PSA"   "REG"   "SBAC"  "SLG"   "SO"    "SPG"   "SRE"   "T"     "TMUS" 
-#> [73] "TTWO"  "TWTR"  "UDR"   "VNO"   "VTR"   "VZ"    "WEC"   "WELL"  "WY"   
-#> [82] "XEL"
-
-# compute log-returns
-log_returns <- diff(log(stock_prices), na.pad = FALSE)
-
-# estimate a weighted, undirected graph (markov random field)
-graph_mrf <- learn_kcomp_heavytail_graph(scale(log_returns),
-                                         rho = 10,
-                                         k = 3,
-                                         heavy_type = "student",
-                                         nu = fit_mvt(scale(log_returns))$nu,
-                                         verbose = FALSE)
-#> Warning in tclass.xts(x): index does not have a 'tclass' attribute
-
-#> Warning in tclass.xts(x): index does not have a 'tclass' attribute
-
-# map stock names and sectors
-stock_sectors <- c(SP500$GICS.Sector[SP500$Symbol %in% colnames(stock_prices)])
-stock_sectors_index <- as.numeric(as.factor(stock_sectors))
-
-# plot network
-net <- graph_from_adjacency_matrix(graph_mrf$adjacency,
-                                   mode = "undirected",
-                                   weighted = TRUE)
-la_kcomp <- layout_nicely(net)
-V(net)$label.cex = 1
-colors <- c("#FD7272", "#55E6C1", "#25CCF7")
-V(net)$color <- colors[stock_sectors_index]
-V(net)$type <- stock_sectors_index
-V(net)$cluster <- stock_sectors_index
-E(net)$color <- apply(as.data.frame(get.edgelist(net)), 1,
-                      function(x) ifelse(V(net)$cluster[x[1]] == V(net)$cluster[x[2]],
-                                        colors[V(net)$cluster[x[1]]], 'grey'))
-plot(net, vertex.label = colnames(stock_prices),
-     layout = la_kcomp,
-     vertex.size = 4.5,
-     vertex.label.family = "Helvetica",
-     vertex.label.dist = 1.25,
-     vertex.label.color = "black",
-     vertex.shape = "circle",
-     edge.width = 20*E(net)$weight,
-     edge.curved = 0.1)
-

-
-
-
-

Citation

-

If you made use of this software please consider citing:

- -
- -
- - - - -
- - - - - - - - - - - - - - - diff --git a/README.md b/README.md index e7ab191..5040c3e 100644 --- a/README.md +++ b/README.md @@ -1,24 +1,11 @@ -# fingraph -[![codecov](https://codecov.io/gh/convexfi/fingraph/branch/main/graph/badge.svg?token=OhreF1p2Yt)](https://app.codecov.io/gh/convexfi/fingraph) +This repo, forked from **fingraph**, contains the R code for balanced undirected graph learning from data +with Student-t distribution applied to financial data clustering. - -This repo contains ADMM implementations to estimate weighted undirected graphs -(Markov random fields) under Student-t assumptions with applications to financial -markets. - -## Installation - -**fingraph** depends on the development version of **spectralGraphTopology**, -which can be installed as: +## Installation in R ```r -> devtools::install_github("convexfi/spectralGraphTopology") -``` - -The stable version of **fingraph** can be installed directly from CRAN: - -```r -> install.packages("fingraph") +> install.packages(spectralGraphTopology) +> devtools::install_github("javaheriamirhossein/balanced-fingraph") ``` #### Microsoft Windows @@ -50,11 +37,11 @@ colnames(crypto_prices) log_returns <- diff(log(crypto_prices), na.pad = FALSE) # estimate a weighted, undirected graph (markov random field) -graph_mrf <- learn_kcomp_heavytail_graph(scale(log_returns), - k = 8, - heavy_type = "student", - nu = fit_mvt(scale(log_returns))$nu, - verbose = FALSE) +graph_mrf <- learn_kcomp_heavytail_graph_balanced(scale(log_returns), + k = 8, + heavy_type = "student", + nu = fit_mvt(scale(log_returns))$nu, + verbose = FALSE) # plot network net <- graph_from_adjacency_matrix(graph_mrf$adjacency, @@ -110,12 +97,12 @@ colnames(stock_prices) log_returns <- diff(log(stock_prices), na.pad = FALSE) # estimate a weighted, undirected graph (markov random field) -graph_mrf <- learn_kcomp_heavytail_graph(scale(log_returns), - rho = 10, - k = 3, - heavy_type = "student", - nu = fit_mvt(scale(log_returns))$nu, - verbose = FALSE) +graph_mrf <- learn_kcomp_heavytail_graph_balanced(scale(log_returns), + rho = 10, + k = 3, + heavy_type = "student", + nu = fit_mvt(scale(log_returns))$nu, + verbose = FALSE) #> Warning in tclass.xts(x): index does not have a 'tclass' attribute #> Warning in tclass.xts(x): index does not have a 'tclass' attribute @@ -150,18 +137,19 @@ plot(net, vertex.label = colnames(stock_prices), + ## Citation -If you made use of this software please consider citing: +Please cite: + +- [A Javaheri](https://javaheriamirhossein.github.io/), [JVM Cardoso](https://mirca.github.io) and + [DP Palomar](https://www.danielppalomar.com), + [Graph Learning for Balanced Clustering of Heavy-Tailed Data]([https://papers.nips.cc/paper/2021/hash/a64a034c3cb8eac64eb46ea474902797-Abstract.html](https://ieeexplore.ieee.org/abstract/document/10403460)). + [2023 IEEE 9th International Workshop on Computational Advances in Multi-Sensor Adaptive Processing](https://ieeexplore.ieee.org/xpl/conhome/10402605/proceeding) (CAMSAP 2023). -- [Cardoso JVM](https://mirca.github.io), [Ying J](https://github.com/jxying), - [Palomar DP](https://www.danielppalomar.com) (2021). +- [JVM Cardoso](https://mirca.github.io), [J Ying](https://github.com/jxying) and + [DP Palomar](https://www.danielppalomar.com), [Graphical Models in Heavy-Tailed Markets](https://papers.nips.cc/paper/2021/hash/a64a034c3cb8eac64eb46ea474902797-Abstract.html). - [Advances in Neural Information Processing Systems](https://neurips.cc/Conferences/2021) (NeurIPS’21). - -## Links -- [RFinance'23 Slides](https://github.com/mirca/rfinance-talk/blob/main/rfinance.pdf) -- [NeurIPS’21 Slides](https://palomar.home.ece.ust.hk/papers/2021/CardosoYingPalomar-NeurIPS2021-slides.pdf) -- [NeurIPS'21 Poster](https://palomar.home.ece.ust.hk/papers/2021/CardosoYingPalomar-NeurIPS2021-poster.png) -- [NeurIPS'21 Supplementary Material](https://palomar.home.ece.ust.hk/papers/2021/CardosoYingPalomar-NeurIPS2021-supplemental.pdf) -- [CRAN Package](https://cran.r-project.org/package=fingraph) + [Advances in Neural Information Processing Systems](https://neurips.cc/Conferences/2021) (NeurIPS 2021). + + diff --git a/examples/stocks/sp500-data-2016-2021.rds b/examples/stocks/sp500-data-2016-2021.rds new file mode 100644 index 0000000..f23d622 Binary files /dev/null and b/examples/stocks/sp500-data-2016-2021.rds differ diff --git a/vignettes/talk-rfinance-2023.pdf b/vignettes/talk-rfinance-2023.pdf deleted file mode 100644 index a12c490..0000000 Binary files a/vignettes/talk-rfinance-2023.pdf and /dev/null differ diff --git a/vignettes/talk-rfinance-2023.pdf.asis b/vignettes/talk-rfinance-2023.pdf.asis deleted file mode 100644 index 48e24eb..0000000 --- a/vignettes/talk-rfinance-2023.pdf.asis +++ /dev/null @@ -1,4 +0,0 @@ -%\VignetteIndexEntry{Talk package finbipartite at R/Finance 2023} -%\VignetteEngine{R.rsp::asis} -%\VignetteKeyword{graphs} -%\VignetteKeyword{financial markets}