noah/Network-Theory_Compliance-Graph-Analysis
1
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

RBGL and related functions

Browse Source
This commit is contained in:
Noah L. Schrick 2022-04-30 19:29:02 -05:00
parent 3e37d31d22
commit b31deb14d8
1 changed files with 32 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
Schrick-Noah_CG-Analysis.R
View File

@ -5,6 +5,7 @@
library(igraph) library(igraph)
library(centiserve) library(centiserve)
library(RBGL)
################## Read in the previously generated networks ################## ################## Read in the previously generated networks ##################
setwd(dirname(rstudioapi::getActiveDocumentContext()$path)) setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
@ -48,8 +49,12 @@ car.kpe <- geokpath(car, V(car), "out")
hipaa.kpe <- geokpath(hipaa, V(hipaa), "out") hipaa.kpe <- geokpath(hipaa, V(hipaa), "out")
pci.kpe <- geokpath(pci, V(pci), "out") pci.kpe <- geokpath(pci, V(pci), "out")
### Betweenness
car.btwn <- betweenness(car, TRUE)
hipaa.btwn <- betweenness(hipaa, TRUE)
pci.btwn <- betweenness(pci, TRUE)
############## Clustering ################################# Clustering #################################
source("self_newman_mod.R") source("self_newman_mod.R")
### Laplacian ### Laplacian
@ -58,17 +63,17 @@ hipaa.Lap <- diag(hipaa.deg) - hipaa.adj
pci.Lap <- diag(pci.deg) - pci.adj pci.Lap <- diag(pci.deg) - pci.adj
# get eigvals and vecs # get eigvals and vecs
car.eigs <- eigen(car.Lap)$vectors[,car.n-1] car.eigs <- Re(eigen(car.Lap)$vectors[,car.n-1])
car.eig_val <- eigen(car.Lap)$values[car.n-1] car.eig_val <- eigen(car.Lap)$values[car.n-1]
names(car.eigs) <- names(V(car)) names(car.eigs) <- names(V(car))
car.l_clusters <- ifelse(car.eigs>0,1,-1) car.l_clusters <- ifelse(car.eigs>0,1,-1)
hipaa.eigs <- eigen(hipaa.Lap)$vectors[,hipaa.n-1] hipaa.eigs <- Re(eigen(hipaa.Lap)$vectors[,hipaa.n-1])
hipaa.eig_val <- eigen(hipaa.Lap)$values[hipaa.n-1] hipaa.eig_val <- eigen(hipaa.Lap)$values[hipaa.n-1]
names(hipaa.eigs) <- names(V(hipaa)) names(hipaa.eigs) <- names(V(hipaa))
hipaa.l_clusters <- ifelse(hipaa.eigs>0,1,-1) hipaa.l_clusters <- ifelse(hipaa.eigs>0,1,-1)
pci.eigs <- eigen(pci.Lap)$vectors[,pci.n-1] pci.eigs <- Re(eigen(pci.Lap)$vectors[,pci.n-1])
pci.eig_val <- eigen(pci.Lap)$values[pci.n-1] pci.eig_val <- eigen(pci.Lap)$values[pci.n-1]
names(pci.eigs) <- names(V(pci)) names(pci.eigs) <- names(V(pci))
pci.l_clusters <- ifelse(pci.eigs>0,1,-1) pci.l_clusters <- ifelse(pci.eigs>0,1,-1)
@ -116,3 +121,26 @@ plot(pci,vertex.size=10,
min_cut(car,"0", "2490") min_cut(car,"0", "2490")
min_cut(hipaa,"0","2320") min_cut(hipaa,"0","2320")
min_cut(pci,"0","60") min_cut(pci,"0","60")
max_flow(car, "0", "2490")
max_flow(hipaa,"0","2320")
max_flow(pci,"0","60")
### Transitive closure
car.graph <- as.graphnel(car)
hipaa.graph <- as.graphnel(hipaa)
pci.graph <- as.graphnel(pci)
car.tc <- transitive.closure(car)
hipaa.tc <- transitive.closure(hipaa)
pci.tc <- transitive.closure(pci)
### Edge connectivty
edge_connectivity(car, "0", "2490")
edge_connectivity(hipaa,"0","2320")
edge_connectivity(pci,"0","60")
# Dominator Tree
car.dtree <- dominator_tree(car, "0", "out")$domtree
hipaa.dtree <- dominator_tree(hipaa, "0", "out")$domtree
pci.dtree <- dominator_tree(pci, "0", "out")$domtree