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

Graph laplacian and reursive newman modularity

Browse Source
This commit is contained in:
Noah L. Schrick 2022-04-30 16:03:21 -05:00
parent d7e9098582
commit 3e37d31d22
1 changed files with 81 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
Schrick-Noah_CG-Analysis.R
View File

@ -11,8 +11,24 @@ setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
source("./CG_Files/manual_import.R") source("./CG_Files/manual_import.R")
car <- import_networks(1) car <- import_networks(1)
car.netname <- "Vehicle Maintenance"
hipaa <- import_networks(2) hipaa <- import_networks(2)
hipaa.netname <- "HIPAA Compliance"
pci <- import_networks(3) pci <- import_networks(3)
pci.netname <- "PCI Compliance"
# Get basic network attributes
car.adj <- get.adjacency(car)
car.deg <- rowSums(as.matrix(car.adj)) # degree
car.n <- length(V(car))
hipaa.adj <- get.adjacency(hipaa)
hipaa.deg <- rowSums(as.matrix(hipaa.adj)) # degree
hipaa.n <- length(V(hipaa))
pci.adj <- get.adjacency(pci)
pci.deg <- rowSums(as.matrix(pci.adj)) # degree
pci.n <- length(V(pci))
################################ Centralities ################################ ################################ Centralities ################################
source("centralities.R") source("centralities.R")
@ -29,8 +45,73 @@ pci.pr <- page.rank(pci)
### K-path ### K-path
car.kpe <- geokpath(car, V(car), "out") car.kpe <- geokpath(car, V(car), "out")
hipaa.kpe <- geokpath(hipaa, V(hipaa), "out")
pci.kpe <- geokpath(pci, V(pci), "out")
############## Clustering
source("self_newman_mod.R")
### Laplacian
car.Lap <- diag(car.deg) - car.adj # L = D-A
hipaa.Lap <- diag(hipaa.deg) - hipaa.adj
pci.Lap <- diag(pci.deg) - pci.adj
# get eigvals and vecs
car.eigs <- eigen(car.Lap)$vectors[,car.n-1]
car.eig_val <- eigen(car.Lap)$values[car.n-1]
names(car.eigs) <- names(V(car))
car.l_clusters <- ifelse(car.eigs>0,1,-1)
hipaa.eigs <- eigen(hipaa.Lap)$vectors[,hipaa.n-1]
hipaa.eig_val <- eigen(hipaa.Lap)$values[hipaa.n-1]
names(hipaa.eigs) <- names(V(hipaa))
hipaa.l_clusters <- ifelse(hipaa.eigs>0,1,-1)
pci.eigs <- eigen(pci.Lap)$vectors[,pci.n-1]
pci.eig_val <- eigen(pci.Lap)$values[pci.n-1]
names(pci.eigs) <- names(V(pci))
pci.l_clusters <- ifelse(pci.eigs>0,1,-1)
### Recursive Newmann
car.modularity <- fastgreedy.community(car,merges=TRUE, modularity=TRUE, membership=TRUE)
car.membership.ids <- unique(car.modularity$membership)
cat(paste('Number of detected communities in the car network =',length(car.membership.ids)))
cat("community sizes: ")
sapply(membership.ids,function(x) {sum(x==car.modularity$membership)})
cat("modularity: ")
max(car.modularity$modularity)
V(car)$color=car.modularity$membership
plot(car,vertex.size=10,
vertex.label=NA,vertex.color=V(car)$color,
main=paste(car.netname, " Recursive Newman Modularity"))
hipaa.modularity <- fastgreedy.community(hipaa,merges=TRUE, modularity=TRUE, membership=TRUE)
hipaa.membership.ids <- unique(hipaa.modularity$membership)
cat(paste('Number of detected communities in the HIPAA network =',length(hipaa.membership.ids)))
cat("community sizes: ")
sapply(membership.ids,function(x) {sum(x==hipaa.modularity$membership)})
cat("modularity: ")
max(hipaa.modularity$modularity)
V(hipaa)$color=hipaa.modularity$membership
plot(hipaa,vertex.size=10,
vertex.label=NA,vertex.color=V(hipaa)$color,
main=paste(hipaa.netname, " Recursive Newman Modularity"))
pci.modularity <- fastgreedy.community(pci,merges=TRUE, modularity=TRUE, membership=TRUE)
pci.membership.ids <- unique(pci.modularity$membership)
cat(paste('Number of detected communities in the PCI network =',length(pci.membership.ids)))
cat("community sizes: ")
sapply(membership.ids,function(x) {sum(x==pci.modularity$membership)})
cat("modularity: ")
max(pci.modularity$modularity)
V(pci)$color=pci.modularity$membership
plot(pci,vertex.size=10,
vertex.label=NA,vertex.color=V(pci)$color,
main=paste(pci.netname, " Recursive Newman Modularity"))
############# Other- Tmp work ############# Other- Tmp work
min_cut(car,"0", "2490") min_cut(car,"0", "2490")
min_cut(hipaa,"0","2320") min_cut(hipaa,"0","2320")