Upload

.Rproj.user/C3768FE8/sources/prop/79E7A040

@@ -0,0 +1,7 @@
+{
+    "tempName": "Untitled1",
+    "source_window_id": "",
+    "Source": "Source",
+    "cursorPosition": "48,0",
+    "scrollLine": "36"
+}

.Rproj.user/C3768FE8/sources/prop/8FED07D0

@@ -0,0 +1,7 @@
+{
+    "tempName": "Untitled1",
+    "source_window_id": "",
+    "Source": "Source",
+    "cursorPosition": "35,4",
+    "scrollLine": "34"
+}

.Rproj.user/C3768FE8/sources/prop/A5F06F40

@@ -0,0 +1,7 @@
+{
+    "tempName": "Untitled1",
+    "source_window_id": "",
+    "Source": "Source",
+    "cursorPosition": "240,0",
+    "scrollLine": "226"
+}

.Rproj.user/C3768FE8/sources/prop/INDEX

@@ -0,0 +1,3 @@
+~%2FDocuments%2FSchool%2FCS-7863_Network-Theory%2FR_Projects%2FHomework%2F2%2FSchrick-Noah_CS-7863_Homework-2.R="A5F06F40"
+~%2FDocuments%2FSchool%2FCS-7863_Network-Theory%2FR_Projects%2FHomework%2F2%2Fkatz_centrality.R="79E7A040"
+~%2FDocuments%2FSchool%2FCS-7863_Network-Theory%2FR_Projects%2FHomework%2F2%2Fself_estrada.R="8FED07D0"

.Rproj.user/C3768FE8/sources/s-5CCDCDB3/082578C8

@@ -0,0 +1,34 @@
+{
+    "id": "082578C8",
+    "path": null,
+    "project_path": null,
+    "type": "r_dataframe",
+    "hash": "0",
+    "contents": "",
+    "dirty": false,
+    "created": 1645068742704.0,
+    "source_on_save": false,
+    "relative_order": 5,
+    "properties": {
+        "expression": "res",
+        "caption": "res",
+        "totalObservations": 3,
+        "displayedObservations": 3,
+        "variables": 4,
+        "cacheKey": "65140D37",
+        "object": "res",
+        "environment": "",
+        "contentUrl": "grid_resource/gridviewer.html?env=&obj=res&cache_key=65140D37&max_cols=50",
+        "preview": 0,
+        "source_window_id": "",
+        "Source": "Source"
+    },
+    "folds": "",
+    "lastKnownWriteTime": 8206027058632,
+    "encoding": "",
+    "collab_server": "",
+    "source_window": "",
+    "last_content_update": 1645068742704,
+    "read_only": false,
+    "read_only_alternatives": []
+}

.Rproj.user/C3768FE8/sources/s-5CCDCDB3/4101911F

@@ -0,0 +1,27 @@
+{
+    "id": "4101911F",
+    "path": "~/Documents/School/CS-7863_Network-Theory/R_Projects/Homework/2/self_estrada.R",
+    "project_path": "self_estrada.R",
+    "type": "r_source",
+    "hash": "1080622386",
+    "contents": "",
+    "dirty": false,
+    "created": 1645053522178.0,
+    "source_on_save": false,
+    "relative_order": 4,
+    "properties": {
+        "tempName": "Untitled1",
+        "source_window_id": "",
+        "Source": "Source",
+        "cursorPosition": "35,4",
+        "scrollLine": "34"
+    },
+    "folds": "",
+    "lastKnownWriteTime": 1645086032,
+    "encoding": "UTF-8",
+    "collab_server": "",
+    "source_window": "",
+    "last_content_update": 1645086032590,
+    "read_only": false,
+    "read_only_alternatives": []
+}

.Rproj.user/C3768FE8/sources/s-5CCDCDB3/4101911F-contents

@@ -0,0 +1,77 @@
+estrada.index <- function(A, beta=NULL){
+    g <- A
+    if (class(A) == 'igraph'){
+        # Error checking. Turn into adj matrix if needed.
+        A <- get.adjacency(A)
+    }
+    
+    
+    if (is.null(beta)){
+        beta <- 1.0
+    }
+    
+    lam.dom <- eigen(A)$values[1] #dom eigenvec
+
+    A.eigs <- eigen(A) 
+    V <- A.eigs$vectors # where columns are the v_i terms
+    lams <- A.eigs$values
+    n <- length(lams)
+    
+    # Create subfunction to compute centrality for one node, then use sapply
+    # for all nodes
+    subg.node.i <- function(i){sum(V[i,]^2*exp(beta*lams))} 
+    subg.all <- sapply(1:n, subg.node.i)
+    EE <- sum(subg.all)
+    
+    return(EE)
+}
+
+microstate.prob <- function(A, beta=NULL){
+    EE <- estrada.index(A, beta)
+    g <- A
+    if (class(A) == 'igraph'){
+        # Error checking. Turn into adj matrix if needed.
+        A <- get.adjacency(A)
+    }
+    
+    if (is.null(beta)){
+        beta <- 1.0
+    }
+    
+    A.eigs <- eigen(A) 
+    lams <- A.eigs$values
+
+    probs <- (exp(beta*lams))/EE
+    
+    # Add names to output
+    names(probs) <- V(g)$name
+    return(probs)
+}
+
+entropy <- function(A, beta=NULL, kb=NULL){
+    microstate_probs <- microstate.prob(A, beta)
+    EE <- estrada.index(A, beta)
+    g <- A
+    
+    if (class(A) == 'igraph'){
+        # Error checking. Turn into adj matrix if needed.
+        A <- get.adjacency(A)
+    }
+    
+    if (is.null(beta)){
+        beta <- 1.0
+    }
+    
+    if (is.null(kb)){
+        kb <- 1.0
+    }
+    
+    lam.dom <- eigen(A)$values[1] #dom eigenvec
+    A.eigs <- eigen(A) 
+    V <- A.eigs$vectors # where columns are the v_i terms
+    lams <- A.eigs$values
+    
+    S <- -kb*beta*sum(lams*microstate_probs)+kb*log(EE)*sum(microstate_probs)
+    return(S)
+}
+    

.Rproj.user/C3768FE8/sources/s-5CCDCDB3/6957530B

@@ -0,0 +1,34 @@
+{
+    "id": "6957530B",
+    "path": null,
+    "project_path": null,
+    "type": "r_dataframe",
+    "hash": "0",
+    "contents": "",
+    "dirty": false,
+    "created": 1645044390171.0,
+    "source_on_save": false,
+    "relative_order": 2,
+    "properties": {
+        "expression": "centralities",
+        "caption": "centralities",
+        "totalObservations": "3",
+        "displayedObservations": "3",
+        "variables": "5",
+        "cacheKey": "75FD0B62",
+        "object": "centralities",
+        "environment": "",
+        "contentUrl": "grid_resource/gridviewer.html?env=&obj=centralities&cache_key=75FD0B62&max_cols=50",
+        "preview": "0",
+        "source_window_id": "",
+        "Source": "Source"
+    },
+    "folds": "",
+    "lastKnownWriteTime": 1645041490,
+    "encoding": "",
+    "collab_server": "",
+    "source_window": "",
+    "last_content_update": 1645044390171,
+    "read_only": false,
+    "read_only_alternatives": []
+}

.Rproj.user/C3768FE8/sources/s-5CCDCDB3/DE635CF7

@@ -0,0 +1,27 @@
+{
+    "id": "DE635CF7",
+    "path": "~/Documents/School/CS-7863_Network-Theory/R_Projects/Homework/2/katz_centrality.R",
+    "project_path": "katz_centrality.R",
+    "type": "r_source",
+    "hash": "0",
+    "contents": "",
+    "dirty": false,
+    "created": 1645045899785.0,
+    "source_on_save": false,
+    "relative_order": 3,
+    "properties": {
+        "tempName": "Untitled1",
+        "source_window_id": "",
+        "Source": "Source",
+        "cursorPosition": "48,0",
+        "scrollLine": "36"
+    },
+    "folds": "",
+    "lastKnownWriteTime": 1645061237,
+    "encoding": "UTF-8",
+    "collab_server": "",
+    "source_window": "",
+    "last_content_update": 1645061237934,
+    "read_only": false,
+    "read_only_alternatives": []
+}

.Rproj.user/C3768FE8/sources/s-5CCDCDB3/DE635CF7-contents

@@ -0,0 +1,54 @@
+katz.cent <- function(A, alpha=NULL, beta=NULL){ #NULL sets the default value
+    g <- A
+    if (class(A) == 'igraph'){
+        #Error checking. Turn into adj matrix.
+        A <- get.adjacency(A)
+    }
+    
+    lam.dom <- eigen(A)$values[1] #dom eigenvec
+    if (is.null(alpha)){
+        alpha <- 0.9 * (1/lam.dom) #Set alpha to 90% of max allowed
+    }
+    
+    n <- nrow(A)
+    if (is.null(beta)){
+        beta <- matrix(rep(1/n, n),ncol=1)
+    }
+    
+    #Katz scores
+    scores <- solve(diag(n) - alpha*A,beta)
+    names(scores) <- V(g)$name
+    
+    return(scores)
+}
+
+sg.katz <- function(A, alpha=NULL, beta=NULL){
+    g <- A
+    if (class(A) == 'igraph'){
+        # Error checking. Turn into adj matrix if needed.
+        A <- get.adjacency(A)
+    }
+    
+    lam.dom <- eigen(A)$values[1] #dom eigenvec
+    if (is.null(alpha)){
+        alpha <- 0.9 * (1/lam.dom) #Set alpha to 90% of max allowed
+    }
+    
+    A.eigs <- eigen(A) 
+    V <- A.eigs$vectors # where columns are the v_i terms
+    lams <- A.eigs$values
+    n <- length(lams)
+    
+    # Create subfunction to compute centrality for one node, then use sapply
+    # for all nodes
+    
+    subg.node.i <- function(i){sum(V[i,]^2/(1-alpha*lams))}
+    
+    subg.all <- sapply(1:n, subg.node.i)
+    
+    # Add names to output
+    names(subg.all) <- V(g)$name
+    
+    
+    return(subg.all)
+}

.Rproj.user/C3768FE8/sources/s-5CCDCDB3/F22781E7

@@ -0,0 +1,27 @@
+{
+    "id": "F22781E7",
+    "path": "~/Documents/School/CS-7863_Network-Theory/R_Projects/Homework/2/Schrick-Noah_CS-7863_Homework-2.R",
+    "project_path": "Schrick-Noah_CS-7863_Homework-2.R",
+    "type": "r_source",
+    "hash": "499576880",
+    "contents": "",
+    "dirty": false,
+    "created": 1645041345008.0,
+    "source_on_save": false,
+    "relative_order": 1,
+    "properties": {
+        "tempName": "Untitled1",
+        "source_window_id": "",
+        "Source": "Source",
+        "cursorPosition": "240,0",
+        "scrollLine": "226"
+    },
+    "folds": "",
+    "lastKnownWriteTime": 1645090277,
+    "encoding": "UTF-8",
+    "collab_server": "",
+    "source_window": "",
+    "last_content_update": 1645090277195,
+    "read_only": false,
+    "read_only_alternatives": []
+}

.Rproj.user/C3768FE8/sources/s-5CCDCDB3/F22781E7-contents

@@ -0,0 +1,240 @@
+# Homework 2 for the University of Tulsa's CS-7863 Network Theory Course
+# Subgraph Centrality Comparisons, Microstate Computations, and Entropy
+# Professor: Dr. McKinney, Spring 2022
+# Noah Schrick - 1492657
+
+# Imports
+#install.packages("igraph")
+#install.packages("igraphdata")
+#install.packages("reshape2")
+library(igraph)
+library(igraphdata)
+library(reshape2)
+data(karate)
+data(kite)
+source("katz_centrality.R")
+source("self_estrada.R")
+
+# 3 Networks: Karate, Kite, and Fig. 1a of the subgraph centrality paper
+g.one <- karate
+g.one.netname <- "Karate"
+
+g.two <- kite
+g.two.netname <- "Kite"
+
+g.fig1a <- graph.ring(8)
+for (idx in V(g.fig1a)) {V(g.fig1a)[idx]$name <- idx}
+g.fig1a <- g.fig1a %>% add_edges(c(2,8, 3,6, 4,7, 1,5))
+g.fig1a.netname <- "Fig1a"
+
+####################### Part 1: Centrality Comparisons #########################
+# Container to hold results for each centrality measure
+centralities <- matrix(list(), nrow=3, ncol=5)
+rownames(centralities) <- c(g.one.netname, g.two.netname, g.fig1a.netname)
+colnames(centralities) <- c("Eigenvector", "Subgraph", "Betweenness", "Katz", 
+                            "Subgraph-like Katz")
+
+# Eigenvector - using igraph
+centralities[[1,1]] <- eigen_centrality(g.one)$vector %>% sort(decreasing=T)
+centralities[[2,1]] <- eigen_centrality(g.two)$vector %>% sort(decreasing=T)
+centralities[[3,1]] <- eigen_centrality(g.fig1a)$vector %>% sort(decreasing=T)
+
+# Subgraph - using igraph
+centralities[[1,2]] <- subgraph.centrality(g.one) %>% sort(decreasing=T)
+centralities[[2,2]] <- subgraph.centrality(g.two) %>% sort(decreasing=T)
+centralities[[3,2]] <- subgraph.centrality(g.fig1a) %>% sort(decreasing=T)
+
+# Betweenness - using igraph
+centralities[[1,3]] <- betweenness(g.one) %>% sort(decreasing=T)
+centralities[[2,3]] <- betweenness(g.two) %>% sort(decreasing=T)
+centralities[[3,3]] <- betweenness(g.fig1a) %>% sort(decreasing=T)
+
+# Katz
+centralities[[1,4]] <- katz.cent(g.one) %>% sort(decreasing=T)
+centralities[[2,4]] <- katz.cent(g.two) %>% sort(decreasing=T)
+centralities[[3,4]] <- katz.cent(g.fig1a) %>% sort(decreasing=T)
+
+
+# "Subgraph-like Katz"
+centralities[[1,5]] <- sg.katz(g.one) %>% sort(decreasing=T)
+centralities[[2,5]] <- sg.katz(g.two) %>% sort(decreasing=T)
+centralities[[3,5]] <- sg.katz(g.fig1a) %>% sort(decreasing=T)
+
+
+####################### Part 2: Microstates and Entropy ########################
+# Create 3 100-node Erdos-Renyi random graph: 10%, 50%, and 100% attachment
+# probabilities. Will use a Beta of 0.01, 0.5, and 1.0 for all 3 networks.
+g.r.one <- erdos.renyi.game(100, .1)
+# for (idx in V(g.r.one)) {V(g.r.one)[idx]$name <- idx}
+g.r.one.netname <- "10% Attachment Probability"
+
+g.r.two <- erdos.renyi.game(100, .5)
+for (idx in V(g.r.two)) {V(g.r.two)[idx]$name <- idx}
+g.r.two.netname <- "50% Attachment Probability"
+
+g.r.three <- erdos.renyi.game(100, 1)
+for (idx in V(g.r.three)) {V(g.r.three)[idx]$name <- idx}
+g.r.three.netname <- "100% Attachment Probability"
+
+# Container to hold results for each network
+res <- matrix(list(), nrow=3, ncol=4)
+rownames(res) <- c(g.r.one.netname, g.r.two.netname, g.r.three.netname)
+colnames(res) <- c("Degree Distribution", "Estrada Index",
+                            "Microstates p_i's", "Entropy")
+
+# Degree Distribution-Not Dependent on Beta, but treating it for easier results
+res[[1,1]] <- list("0.01"=degree_distribution(g.r.one) %>% sort(decreasing=T), 
+                   "0.5"=degree_distribution(g.r.one) %>% sort(decreasing=T),
+                   "1.0"=degree_distribution(g.r.one) %>% sort(decreasing=T))
+res[[2,1]] <- list("0.01"=degree_distribution(g.r.two) %>% sort(decreasing=T), 
+                   "0.5"=degree_distribution(g.r.two) %>% sort(decreasing=T),
+                   "1.0"=degree_distribution(g.r.two) %>% sort(decreasing=T))
+res[[3,1]] <- list("0.01"=degree_distribution(g.r.three) %>% sort(decreasing=T),
+                   "0.5"=degree_distribution(g.r.three) %>% sort(decreasing=T), 
+                   "1.0"=degree_distribution(g.r.three) %>% sort(decreasing=T))
+
+# Compute EE
+res[[1,2]] <- list("0.01"=estrada.index(g.r.one, 0.01), 
+                   "0.5"=estrada.index(g.r.one, 0.5),
+                   "1.0"=estrada.index(g.r.one, 1))
+res[[2,2]] <- list("0.01"=estrada.index(g.r.two, 0.01),
+                   "0.5"=estrada.index(g.r.two, 0.5),
+                   "1.0"=estrada.index(g.r.two, 1))
+res[[3,2]] <- list("0.01"=estrada.index(g.r.three, 0.01),
+                   "0.5"=estrada.index(g.r.three, 0.5),
+                   "1.0"=estrada.index(g.r.three, 1))
+
+# Compute Microstates
+res[[1,3]] <- list("0.01"=microstate.prob(g.r.one, 0.01), 
+                   "0.5"=microstate.prob(g.r.one, 0.5),
+                   "1.0"=microstate.prob(g.r.one, 1))
+res[[2,3]] <- list("0.01"=microstate.prob(g.r.two, 0.01),
+                   "0.5"=microstate.prob(g.r.two, 0.5),
+                   "1.0"=microstate.prob(g.r.two, 1))
+res[[3,3]] <- list("0.01"=microstate.prob(g.r.three, 0.01),
+                   "0.5"=microstate.prob(g.r.three, 0.5),
+                   "1.0"=microstate.prob(g.r.three, 1))
+
+# Histogram Display
+# 10% Attachment Probability Network
+par(mfrow=c(3,1))
+g.r<- unlist(res[[1,3]]["0.01"], use.names=FALSE)
+hist(g.r,
+    main="Microstate Histogram for a a 100-node Erdos-Renyi random
+    graph with attachment probability 10% and Beta=0.01",
+    xlab="Occupation Probability")
+g.r <- unlist(res[[1,3]]["0.5"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a a 100-node Erdos-Renyi random
+    graph with attachment probability 10% and Beta=0.5",
+     xlab="Occupation Probability")
+g.r <- unlist(res[[1,3]]["1.0"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a a 100-node Erdos-Renyi random
+    graph with attachment probability 10% and Beta=1.0",
+     xlab="Occupation Probability")
+# 50% Attachment Probability Network
+par(mfrow=c(3,1))
+g.r<- unlist(res[[2,3]]["0.01"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a a 100-node Erdos-Renyi random
+    graph with attachment probability 50% and Beta=0.01",
+     xlab="Occupation Probability")
+g.r <- unlist(res[[2,3]]["0.5"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a a 100-node Erdos-Renyi random
+    graph with attachment probability 50% and Beta=0.5",
+     xlab="Occupation Probability")
+g.r <- unlist(res[[2,3]]["1.0"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a a 100-node Erdos-Renyi random
+    graph with attachment probability 50% and Beta=1.0",
+     xlab="Occupation Probability")
+# 100% Attachment Probability Network
+par(mfrow=c(3,1))
+g.r<- unlist(res[[3,3]]["0.01"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a 100-node Erdos-Renyi random
+    graph with attachment probability 100% and Beta=0.01",
+     xlab="Occupation Probability")
+g.r <- unlist(res[[3,3]]["0.5"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a 100-node Erdos-Renyi random
+    graph with attachment probability 100% and Beta=0.5",
+     xlab="Occupation Probability")
+g.r <- unlist(res[[3,3]]["1.0"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a 100-node Erdos-Renyi random
+    graph with attachment probability 100% and Beta=1.0",
+     xlab="Occupation Probability")
+
+# Entropy
+res[[1,4]] <- list("0.01"=entropy(g.r.one, 0.01), 
+                   "0.5"=entropy(g.r.one, 0.5),
+                   "1.0"=entropy(g.r.one, 1))
+res[[2,4]] <- list("0.01"=entropy(g.r.two, 0.01),
+                   "0.5"=entropy(g.r.two, 0.5),
+                   "1.0"=entropy(g.r.two, 1))
+res[[3,4]] <- list("0.01"=entropy(g.r.three, 0.01),
+                   "0.5"=entropy(g.r.three, 0.5),
+                   "1.0"=entropy(g.r.three, 1))
+y1 <- c(unlist(res[[1,4]]["0.01"], use.names=FALSE),
+                unlist(res[[2,4]]["0.01"], use.names=FALSE),
+                unlist(res[[3,4]]["0.01"], use.names=FALSE))
+
+y2 <- c(unlist(res[[1,4]]["0.5"], use.names=FALSE),
+                unlist(res[[2,4]]["0.5"], use.names=FALSE),
+                unlist(res[[3,4]]["0.5"], use.names=FALSE))
+
+y3 <-c(unlist(res[[1,4]]["1.0"], use.names=FALSE),
+                 unlist(res[[2,4]]["1.0"], use.names=FALSE),
+                 unlist(res[[3,4]]["1.0"], use.names=FALSE))
+
+par(mfrow=c(3,1))
+
+plot(x=c(0.1,0.5,1.0), y=y1, col="red", type="o", pch="o",
+        xlab="Attachment Probability", ylab="Entropy",
+        main="Entropies for a 100-node Erdos-Renyi random
+    graph with varying attachment probability and Beta=0.01", lty=1,
+     ylim=c(min(y1),max(y1)))
+
+plot(x=c(0.1,0.5,1.0), y=y2, col="red", type="o", pch="o",
+     xlab="Attachment Probability", ylab="Entropy",
+     main="Entropies for a 100-node Erdos-Renyi random
+    graph with varying attachment probability and Beta=0.5", lty=1, ylim=c(min(y2),max(y2)))
+
+plot(x=c(0.1,0.5,1.0), y=y3, col="red", type="o", pch="o",
+     xlab="Attachment Probability", ylab="Entropy",
+     main="Entropies for a 100-node Erdos-Renyi random
+    graph with varying attachment probability and Beta=1.0", lty=1, ylim=c(min(y3),max(y3)))
+
+
+# igraph network entropy
+g1 <- entropy(g.one,0.01)
+g2 <- entropy(g.one,0.5)
+g3 <-entropy(g.one,1.0)
+
+# Simulate a random graph network with n = n of igraph network
+n <- vcount(g.one)
+attachment <- sum(degree(g.one))/vcount(g.one)
+g1.rand <- erdos.renyi.game(n, attachment/(n-1))
+
+g1.rand.o <- entropy(g1.rand,0.01)
+g1.rand.t <- entropy(g1.rand,0.5)
+g1.rand.th <- entropy(g1.rand,1.0)
+
+# Compare entropy of these random graphs to their original counterparts
+par(mfrow=c(1,1))
+plot(x=c(0.01,0.5,1.0), y=c(g1,g2,g3), col="red", type="o", pch="o",
+     xlab="Beta Values", ylab="Entropy",
+     main="Entropies for the igraph Karate network vs
+     a related Erdos-Renyi random network",
+     ylim=c(min(g1,g2,g3,g1.rand.o,g1.rand.t,g1.rand.th),
+          max(g1,g2,g3,g1.rand.o,g1.rand.t,g1.rand.th)), lty=1)
+points(x=c(0.01,0.5,1.0), y=c(g1.rand.o,g1.rand.t,g1.rand.th),pch="*",
+       col="black")
+lines(x=c(0.01,0.5,1.0), y=c(g1.rand.o,g1.rand.t,g1.rand.th), lty=2,
+     col="black")
+legend("bottomleft",
+       legend=c("Karate", "Erdos-Renyi"), col=c("red","black"), pch=c("o","*"),
+       lty=c(1,3),ncol=1)

.Rproj.user/shared/notebooks/paths

@@ -0,0 +1,3 @@
+/home/noah/Documents/School/CS-7863_Network-Theory/R_Projects/Homework/2/Schrick-Noah_CS-7863_Homework-2.R="228CC0E6"
+/home/noah/Documents/School/CS-7863_Network-Theory/R_Projects/Homework/2/katz_centrality.R="316D2819"
+/home/noah/Documents/School/CS-7863_Network-Theory/R_Projects/Homework/2/self_estrada.R="D4486536"

2.Rproj

@@ -0,0 +1,13 @@
+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 4
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX

Schrick-Noah_CS-7863_Homework-2.R

@@ -0,0 +1,240 @@
+# Homework 2 for the University of Tulsa's CS-7863 Network Theory Course
+# Subgraph Centrality Comparisons, Microstate Computations, and Entropy
+# Professor: Dr. McKinney, Spring 2022
+# Noah Schrick - 1492657
+
+# Imports
+#install.packages("igraph")
+#install.packages("igraphdata")
+#install.packages("reshape2")
+library(igraph)
+library(igraphdata)
+library(reshape2)
+data(karate)
+data(kite)
+source("katz_centrality.R")
+source("self_estrada.R")
+
+# 3 Networks: Karate, Kite, and Fig. 1a of the subgraph centrality paper
+g.one <- karate
+g.one.netname <- "Karate"
+
+g.two <- kite
+g.two.netname <- "Kite"
+
+g.fig1a <- graph.ring(8)
+for (idx in V(g.fig1a)) {V(g.fig1a)[idx]$name <- idx}
+g.fig1a <- g.fig1a %>% add_edges(c(2,8, 3,6, 4,7, 1,5))
+g.fig1a.netname <- "Fig1a"
+
+####################### Part 1: Centrality Comparisons #########################
+# Container to hold results for each centrality measure
+centralities <- matrix(list(), nrow=3, ncol=5)
+rownames(centralities) <- c(g.one.netname, g.two.netname, g.fig1a.netname)
+colnames(centralities) <- c("Eigenvector", "Subgraph", "Betweenness", "Katz", 
+                            "Subgraph-like Katz")
+
+# Eigenvector - using igraph
+centralities[[1,1]] <- eigen_centrality(g.one)$vector %>% sort(decreasing=T)
+centralities[[2,1]] <- eigen_centrality(g.two)$vector %>% sort(decreasing=T)
+centralities[[3,1]] <- eigen_centrality(g.fig1a)$vector %>% sort(decreasing=T)
+
+# Subgraph - using igraph
+centralities[[1,2]] <- subgraph.centrality(g.one) %>% sort(decreasing=T)
+centralities[[2,2]] <- subgraph.centrality(g.two) %>% sort(decreasing=T)
+centralities[[3,2]] <- subgraph.centrality(g.fig1a) %>% sort(decreasing=T)
+
+# Betweenness - using igraph
+centralities[[1,3]] <- betweenness(g.one) %>% sort(decreasing=T)
+centralities[[2,3]] <- betweenness(g.two) %>% sort(decreasing=T)
+centralities[[3,3]] <- betweenness(g.fig1a) %>% sort(decreasing=T)
+
+# Katz
+centralities[[1,4]] <- katz.cent(g.one) %>% sort(decreasing=T)
+centralities[[2,4]] <- katz.cent(g.two) %>% sort(decreasing=T)
+centralities[[3,4]] <- katz.cent(g.fig1a) %>% sort(decreasing=T)
+
+
+# "Subgraph-like Katz"
+centralities[[1,5]] <- sg.katz(g.one) %>% sort(decreasing=T)
+centralities[[2,5]] <- sg.katz(g.two) %>% sort(decreasing=T)
+centralities[[3,5]] <- sg.katz(g.fig1a) %>% sort(decreasing=T)
+
+
+####################### Part 2: Microstates and Entropy ########################
+# Create 3 100-node Erdos-Renyi random graph: 10%, 50%, and 100% attachment
+# probabilities. Will use a Beta of 0.01, 0.5, and 1.0 for all 3 networks.
+g.r.one <- erdos.renyi.game(100, .1)
+# for (idx in V(g.r.one)) {V(g.r.one)[idx]$name <- idx}
+g.r.one.netname <- "10% Attachment Probability"
+
+g.r.two <- erdos.renyi.game(100, .5)
+for (idx in V(g.r.two)) {V(g.r.two)[idx]$name <- idx}
+g.r.two.netname <- "50% Attachment Probability"
+
+g.r.three <- erdos.renyi.game(100, 1)
+for (idx in V(g.r.three)) {V(g.r.three)[idx]$name <- idx}
+g.r.three.netname <- "100% Attachment Probability"
+
+# Container to hold results for each network
+res <- matrix(list(), nrow=3, ncol=4)
+rownames(res) <- c(g.r.one.netname, g.r.two.netname, g.r.three.netname)
+colnames(res) <- c("Degree Distribution", "Estrada Index",
+                            "Microstates p_i's", "Entropy")
+
+# Degree Distribution-Not Dependent on Beta, but treating it for easier results
+res[[1,1]] <- list("0.01"=degree_distribution(g.r.one) %>% sort(decreasing=T), 
+                   "0.5"=degree_distribution(g.r.one) %>% sort(decreasing=T),
+                   "1.0"=degree_distribution(g.r.one) %>% sort(decreasing=T))
+res[[2,1]] <- list("0.01"=degree_distribution(g.r.two) %>% sort(decreasing=T), 
+                   "0.5"=degree_distribution(g.r.two) %>% sort(decreasing=T),
+                   "1.0"=degree_distribution(g.r.two) %>% sort(decreasing=T))
+res[[3,1]] <- list("0.01"=degree_distribution(g.r.three) %>% sort(decreasing=T),
+                   "0.5"=degree_distribution(g.r.three) %>% sort(decreasing=T), 
+                   "1.0"=degree_distribution(g.r.three) %>% sort(decreasing=T))
+
+# Compute EE
+res[[1,2]] <- list("0.01"=estrada.index(g.r.one, 0.01), 
+                   "0.5"=estrada.index(g.r.one, 0.5),
+                   "1.0"=estrada.index(g.r.one, 1))
+res[[2,2]] <- list("0.01"=estrada.index(g.r.two, 0.01),
+                   "0.5"=estrada.index(g.r.two, 0.5),
+                   "1.0"=estrada.index(g.r.two, 1))
+res[[3,2]] <- list("0.01"=estrada.index(g.r.three, 0.01),
+                   "0.5"=estrada.index(g.r.three, 0.5),
+                   "1.0"=estrada.index(g.r.three, 1))
+
+# Compute Microstates
+res[[1,3]] <- list("0.01"=microstate.prob(g.r.one, 0.01), 
+                   "0.5"=microstate.prob(g.r.one, 0.5),
+                   "1.0"=microstate.prob(g.r.one, 1))
+res[[2,3]] <- list("0.01"=microstate.prob(g.r.two, 0.01),
+                   "0.5"=microstate.prob(g.r.two, 0.5),
+                   "1.0"=microstate.prob(g.r.two, 1))
+res[[3,3]] <- list("0.01"=microstate.prob(g.r.three, 0.01),
+                   "0.5"=microstate.prob(g.r.three, 0.5),
+                   "1.0"=microstate.prob(g.r.three, 1))
+
+# Histogram Display
+# 10% Attachment Probability Network
+par(mfrow=c(3,1))
+g.r<- unlist(res[[1,3]]["0.01"], use.names=FALSE)
+hist(g.r,
+    main="Microstate Histogram for a a 100-node Erdos-Renyi random
+    graph with attachment probability 10% and Beta=0.01",
+    xlab="Occupation Probability")
+g.r <- unlist(res[[1,3]]["0.5"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a a 100-node Erdos-Renyi random
+    graph with attachment probability 10% and Beta=0.5",
+     xlab="Occupation Probability")
+g.r <- unlist(res[[1,3]]["1.0"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a a 100-node Erdos-Renyi random
+    graph with attachment probability 10% and Beta=1.0",
+     xlab="Occupation Probability")
+# 50% Attachment Probability Network
+par(mfrow=c(3,1))
+g.r<- unlist(res[[2,3]]["0.01"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a a 100-node Erdos-Renyi random
+    graph with attachment probability 50% and Beta=0.01",
+     xlab="Occupation Probability")
+g.r <- unlist(res[[2,3]]["0.5"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a a 100-node Erdos-Renyi random
+    graph with attachment probability 50% and Beta=0.5",
+     xlab="Occupation Probability")
+g.r <- unlist(res[[2,3]]["1.0"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a a 100-node Erdos-Renyi random
+    graph with attachment probability 50% and Beta=1.0",
+     xlab="Occupation Probability")
+# 100% Attachment Probability Network
+par(mfrow=c(3,1))
+g.r<- unlist(res[[3,3]]["0.01"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a 100-node Erdos-Renyi random
+    graph with attachment probability 100% and Beta=0.01",
+     xlab="Occupation Probability")
+g.r <- unlist(res[[3,3]]["0.5"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a 100-node Erdos-Renyi random
+    graph with attachment probability 100% and Beta=0.5",
+     xlab="Occupation Probability")
+g.r <- unlist(res[[3,3]]["1.0"], use.names=FALSE)
+hist(g.r,
+     main="Microstate Histogram for a 100-node Erdos-Renyi random
+    graph with attachment probability 100% and Beta=1.0",
+     xlab="Occupation Probability")
+
+# Entropy
+res[[1,4]] <- list("0.01"=entropy(g.r.one, 0.01), 
+                   "0.5"=entropy(g.r.one, 0.5),
+                   "1.0"=entropy(g.r.one, 1))
+res[[2,4]] <- list("0.01"=entropy(g.r.two, 0.01),
+                   "0.5"=entropy(g.r.two, 0.5),
+                   "1.0"=entropy(g.r.two, 1))
+res[[3,4]] <- list("0.01"=entropy(g.r.three, 0.01),
+                   "0.5"=entropy(g.r.three, 0.5),
+                   "1.0"=entropy(g.r.three, 1))
+y1 <- c(unlist(res[[1,4]]["0.01"], use.names=FALSE),
+                unlist(res[[2,4]]["0.01"], use.names=FALSE),
+                unlist(res[[3,4]]["0.01"], use.names=FALSE))
+
+y2 <- c(unlist(res[[1,4]]["0.5"], use.names=FALSE),
+                unlist(res[[2,4]]["0.5"], use.names=FALSE),
+                unlist(res[[3,4]]["0.5"], use.names=FALSE))
+
+y3 <-c(unlist(res[[1,4]]["1.0"], use.names=FALSE),
+                 unlist(res[[2,4]]["1.0"], use.names=FALSE),
+                 unlist(res[[3,4]]["1.0"], use.names=FALSE))
+
+par(mfrow=c(3,1))
+
+plot(x=c(0.1,0.5,1.0), y=y1, col="red", type="o", pch="o",
+        xlab="Attachment Probability", ylab="Entropy",
+        main="Entropies for a 100-node Erdos-Renyi random
+    graph with varying attachment probability and Beta=0.01", lty=1,
+     ylim=c(min(y1),max(y1)))
+
+plot(x=c(0.1,0.5,1.0), y=y2, col="red", type="o", pch="o",
+     xlab="Attachment Probability", ylab="Entropy",
+     main="Entropies for a 100-node Erdos-Renyi random
+    graph with varying attachment probability and Beta=0.5", lty=1, ylim=c(min(y2),max(y2)))
+
+plot(x=c(0.1,0.5,1.0), y=y3, col="red", type="o", pch="o",
+     xlab="Attachment Probability", ylab="Entropy",
+     main="Entropies for a 100-node Erdos-Renyi random
+    graph with varying attachment probability and Beta=1.0", lty=1, ylim=c(min(y3),max(y3)))
+
+
+# igraph network entropy
+g1 <- entropy(g.one,0.01)
+g2 <- entropy(g.one,0.5)
+g3 <-entropy(g.one,1.0)
+
+# Simulate a random graph network with n = n of igraph network
+n <- vcount(g.one)
+attachment <- sum(degree(g.one))/vcount(g.one)
+g1.rand <- erdos.renyi.game(n, attachment/(n-1))
+
+g1.rand.o <- entropy(g1.rand,0.01)
+g1.rand.t <- entropy(g1.rand,0.5)
+g1.rand.th <- entropy(g1.rand,1.0)
+
+# Compare entropy of these random graphs to their original counterparts
+par(mfrow=c(1,1))
+plot(x=c(0.01,0.5,1.0), y=c(g1,g2,g3), col="red", type="o", pch="o",
+     xlab="Beta Values", ylab="Entropy",
+     main="Entropies for the igraph Karate network vs
+     a related Erdos-Renyi random network",
+     ylim=c(min(g1,g2,g3,g1.rand.o,g1.rand.t,g1.rand.th),
+          max(g1,g2,g3,g1.rand.o,g1.rand.t,g1.rand.th)), lty=1)
+points(x=c(0.01,0.5,1.0), y=c(g1.rand.o,g1.rand.t,g1.rand.th),pch="*",
+       col="black")
+lines(x=c(0.01,0.5,1.0), y=c(g1.rand.o,g1.rand.t,g1.rand.th), lty=2,
+     col="black")
+legend("bottomleft",
+       legend=c("Karate", "Erdos-Renyi"), col=c("red","black"), pch=c("o","*"),
+       lty=c(1,3),ncol=1)

katz_centrality.R

@@ -0,0 +1,54 @@
+katz.cent <- function(A, alpha=NULL, beta=NULL){ #NULL sets the default value
+    g <- A
+    if (class(A) == 'igraph'){
+        #Error checking. Turn into adj matrix.
+        A <- get.adjacency(A)
+    }
+    
+    lam.dom <- eigen(A)$values[1] #dom eigenvec
+    if (is.null(alpha)){
+        alpha <- 0.9 * (1/lam.dom) #Set alpha to 90% of max allowed
+    }
+    
+    n <- nrow(A)
+    if (is.null(beta)){
+        beta <- matrix(rep(1/n, n),ncol=1)
+    }
+    
+    #Katz scores
+    scores <- solve(diag(n) - alpha*A,beta)
+    names(scores) <- V(g)$name
+    
+    return(scores)
+}
+
+sg.katz <- function(A, alpha=NULL, beta=NULL){
+    g <- A
+    if (class(A) == 'igraph'){
+        # Error checking. Turn into adj matrix if needed.
+        A <- get.adjacency(A)
+    }
+    
+    lam.dom <- eigen(A)$values[1] #dom eigenvec
+    if (is.null(alpha)){
+        alpha <- 0.9 * (1/lam.dom) #Set alpha to 90% of max allowed
+    }
+    
+    A.eigs <- eigen(A) 
+    V <- A.eigs$vectors # where columns are the v_i terms
+    lams <- A.eigs$values
+    n <- length(lams)
+    
+    # Create subfunction to compute centrality for one node, then use sapply
+    # for all nodes
+    
+    subg.node.i <- function(i){sum(V[i,]^2/(1-alpha*lams))}
+    
+    subg.all <- sapply(1:n, subg.node.i)
+    
+    # Add names to output
+    names(subg.all) <- V(g)$name
+    
+    
+    return(subg.all)
+}

self_estrada.R

@@ -0,0 +1,77 @@
+estrada.index <- function(A, beta=NULL){
+    g <- A
+    if (class(A) == 'igraph'){
+        # Error checking. Turn into adj matrix if needed.
+        A <- get.adjacency(A)
+    }
+    
+    
+    if (is.null(beta)){
+        beta <- 1.0
+    }
+    
+    lam.dom <- eigen(A)$values[1] #dom eigenvec
+
+    A.eigs <- eigen(A) 
+    V <- A.eigs$vectors # where columns are the v_i terms
+    lams <- A.eigs$values
+    n <- length(lams)
+    
+    # Create subfunction to compute centrality for one node, then use sapply
+    # for all nodes
+    subg.node.i <- function(i){sum(V[i,]^2*exp(beta*lams))} 
+    subg.all <- sapply(1:n, subg.node.i)
+    EE <- sum(subg.all)
+    
+    return(EE)
+}
+
+microstate.prob <- function(A, beta=NULL){
+    EE <- estrada.index(A, beta)
+    g <- A
+    if (class(A) == 'igraph'){
+        # Error checking. Turn into adj matrix if needed.
+        A <- get.adjacency(A)
+    }
+    
+    if (is.null(beta)){
+        beta <- 1.0
+    }
+    
+    A.eigs <- eigen(A) 
+    lams <- A.eigs$values
+
+    probs <- (exp(beta*lams))/EE
+    
+    # Add names to output
+    names(probs) <- V(g)$name
+    return(probs)
+}
+
+entropy <- function(A, beta=NULL, kb=NULL){
+    microstate_probs <- microstate.prob(A, beta)
+    EE <- estrada.index(A, beta)
+    g <- A
+    
+    if (class(A) == 'igraph'){
+        # Error checking. Turn into adj matrix if needed.
+        A <- get.adjacency(A)
+    }
+    
+    if (is.null(beta)){
+        beta <- 1.0
+    }
+    
+    if (is.null(kb)){
+        kb <- 1.0
+    }
+    
+    lam.dom <- eigen(A)$values[1] #dom eigenvec
+    A.eigs <- eigen(A) 
+    V <- A.eigs$vectors # where columns are the v_i terms
+    lams <- A.eigs$values
+    
+    S <- -kb*beta*sum(lams*microstate_probs)+kb*log(EE)*sum(microstate_probs)
+    return(S)
+}
+