147 lines
4.6 KiB
R
147 lines
4.6 KiB
R
# Final Project for the University of Tulsa's CS-7863 Network Theory Course
|
|
# Compliance Graph Analysis
|
|
# Professor: Dr. McKinney, Spring 2022
|
|
# Noah L. Schrick - 1492657
|
|
|
|
library(igraph)
|
|
library(centiserve)
|
|
library(RBGL)
|
|
|
|
################## Read in the previously generated networks ##################
|
|
setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
|
|
source("./CG_Files/manual_import.R")
|
|
|
|
car <- import_networks(1)
|
|
car.netname <- "Vehicle Maintenance"
|
|
hipaa <- import_networks(2)
|
|
hipaa.netname <- "HIPAA Compliance"
|
|
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 ################################
|
|
source("centralities.R")
|
|
|
|
#### Katz
|
|
car.katz <- katz.cent(car)
|
|
hipaa.katz <- katz.cent(hipaa)
|
|
pci.katz <- katz.cent(pci)
|
|
|
|
### Page Rank
|
|
car.pr <- page.rank(car)
|
|
hipaa.pr <- page.rank(hipaa)
|
|
pci.pr <- page.rank(pci)
|
|
|
|
### K-path
|
|
car.kpe <- geokpath(car, V(car), "out")
|
|
hipaa.kpe <- geokpath(hipaa, V(hipaa), "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 #################################
|
|
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 <- Re(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 <- Re(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 <- Re(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
|
|
min_cut(car,"0", "2490")
|
|
min_cut(hipaa,"0","2320")
|
|
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
|