R/summary_network.R In HeteroGGM: Gaussian Graphical Model-Based Heterogeneity Analysis

Documented in summary_network

```#' The summary of the resulting network structures.
#'
#' @name summary_network
#' @usage summary_network(opt_Mu_hat, opt_Theta_hat, data)
#' @description Summarize the characteristics of the resulting network structures.
#' @param opt_Mu_hat A p * K0_hat matrix, the optional mean vectors of K0_hat subgroups.
#' @param opt_Theta_hat n * p * K0_hat matrix, the optional precision matrices of K0_hat subgroups.
#' @param data A n * p matrix, the design matrix.
#'
#' @return A list including the overlap of edges of different subgroups, the number of edges, and the names of connected nodes to each nodes in each subgroup.
#' @export
#'
#' @import igraph
#'
#'
summary_network <- function(opt_Mu_hat, opt_Theta_hat, data){

## ------------------------------------------------------------------------------------------------------------------------------------------
## The name of the function: summary_network
## ------------------------------------------------------------------------------------------------------------------------------------------
## Description:
##            Summarize the characteristics of the resulting network structures.
## ------------------------------------------------------------------------------------------------------------------------------------------
## Required preceding functions or packages:
##            R functions: edge_index()
## ------------------------------------------------------------------------------------------------------------------------------------------
## Input:
## @ opt_Mu_hat: the optional mean vectors of K0_hat subgroups.
## @ opt_Theta_hat, the optional precision matrices of K0_hat subgroups.
## @ data: n * p matrix, the design matrix.
## ------------------------------------------------------------------------------------------------------------------------------------------
## Output:
## A list including:
## @ Theta_summary: A list including:
##                  @ overlap: the overlap of edges of different subgroups.
##                  @ Theta_nonzero_num: the number of edges of each subgroup.
##                  @ network_edge_summary: the names of connected nodes to each node in each subgroup.
## @ Mu_summary: A list including:
##                  @ nonzero_num: non-zero variable numbers in each subgroup.
##                  @ nonzero_names: non-zero variable names in each subgroup.
## @ variable_names: A vector, names of variables.
## ------------------------------------------------------------------------------------------------------------------------------------------

variable_names <- names(data)
if(length(variable_names) == 0){variable_names <- as.character(c(1:dim(data)[2]))}
p <- dim(opt_Theta_hat)[1]
K_hat <- dim(opt_Theta_hat)[3]

if(K_hat == 1){print("warning: only one cluster.")}else{
Mu_summary <- list()
for (k in 1:K_hat) {
non_k <- which(opt_Mu_hat[k,]!=0)
if(length(non_k) > 0){
nonzero_num <- non_k
nonzero_names <- variable_names[nonzero_num]
Mu_nonzero_info <- as.data.frame(cbind(nonzero_num,nonzero_names))
Mu_summary[[k]] <- Mu_nonzero_info
} else {
Mu_summary[[k]] <- "ALL ZERO"
}

}

Theta_nonzero_num <- list()
for (kk in 1:K_hat) {
Theta_nonzero_num[[kk]] <- which(opt_Theta_hat[,,kk]!=0)
}
overlap <- as.data.frame(matrix(0,K_hat,K_hat))
names(overlap) <- paste("subgroup",1:K_hat)
row.names(overlap) <- paste("subgroup",1:K_hat)
for (k in 1:K_hat) {
edge1 <- Theta_nonzero_num[[k]]
for (kk in 1:K_hat) {
edge2 <- Theta_nonzero_num[[kk]]
if(k!=kk){
overlap[k,kk] <- length(intersect(edge1,edge2)) - p
overlap[kk,k] <- length(intersect(edge1,edge2)) - p
} else{
overlap[k,kk] <- length(intersect(edge1,edge2)) - p
overlap[kk,k] <- length(intersect(edge1,edge2)) - p
}
}
}
network_edge_summary <- edge_index(opt_Theta_hat, data)
Theta_summary <- list(overlap=overlap,
Theta_nonzero_num=apply(opt_Theta_hat, 3, function(a){sum(a!=0)}),
network_edge_summary=network_edge_summary)

return(list(Theta_summary=Theta_summary, Mu_summary=Mu_summary,
variable_names=variable_names, opt_Theta_hat=opt_Theta_hat))
}

}
```

Try the HeteroGGM package in your browser

Any scripts or data that you put into this service are public.

HeteroGGM documentation built on Feb. 11, 2021, 5:09 p.m.