From 1090d991fdee89a87795d24df04d956b8b7e8f0d Mon Sep 17 00:00:00 2001 From: noah Date: Thu, 17 Feb 2022 03:32:19 -0600 Subject: [PATCH] Upload --- .Rproj.user/C3768FE8/sources/prop/79E7A040 | 7 + .Rproj.user/C3768FE8/sources/prop/8FED07D0 | 7 + .Rproj.user/C3768FE8/sources/prop/A5F06F40 | 7 + .Rproj.user/C3768FE8/sources/prop/INDEX | 3 + .../C3768FE8/sources/s-5CCDCDB3/082578C8 | 34 +++ .../sources/s-5CCDCDB3/082578C8-contents | 0 .../C3768FE8/sources/s-5CCDCDB3/4101911F | 27 ++ .../sources/s-5CCDCDB3/4101911F-contents | 77 ++++++ .../C3768FE8/sources/s-5CCDCDB3/6957530B | 34 +++ .../sources/s-5CCDCDB3/6957530B-contents | 0 .../C3768FE8/sources/s-5CCDCDB3/DE635CF7 | 27 ++ .../sources/s-5CCDCDB3/DE635CF7-contents | 54 ++++ .../C3768FE8/sources/s-5CCDCDB3/F22781E7 | 27 ++ .../sources/s-5CCDCDB3/F22781E7-contents | 240 ++++++++++++++++++ .../C3768FE8/sources/s-5CCDCDB3/lock_file | 0 .../shared/notebooks/patch-chunk-names | 0 .Rproj.user/shared/notebooks/paths | 3 + 2.Rproj | 13 + Schrick-Noah_CS-7863_Homework-2.R | 240 ++++++++++++++++++ katz_centrality.R | 54 ++++ self_estrada.R | 77 ++++++ 21 files changed, 931 insertions(+) create mode 100644 .Rproj.user/C3768FE8/sources/prop/79E7A040 create mode 100644 .Rproj.user/C3768FE8/sources/prop/8FED07D0 create mode 100644 .Rproj.user/C3768FE8/sources/prop/A5F06F40 create mode 100644 .Rproj.user/C3768FE8/sources/prop/INDEX create mode 100644 .Rproj.user/C3768FE8/sources/s-5CCDCDB3/082578C8 create mode 100644 .Rproj.user/C3768FE8/sources/s-5CCDCDB3/082578C8-contents create mode 100644 .Rproj.user/C3768FE8/sources/s-5CCDCDB3/4101911F create mode 100644 .Rproj.user/C3768FE8/sources/s-5CCDCDB3/4101911F-contents create mode 100644 .Rproj.user/C3768FE8/sources/s-5CCDCDB3/6957530B create mode 100644 .Rproj.user/C3768FE8/sources/s-5CCDCDB3/6957530B-contents create mode 100644 .Rproj.user/C3768FE8/sources/s-5CCDCDB3/DE635CF7 create mode 100644 .Rproj.user/C3768FE8/sources/s-5CCDCDB3/DE635CF7-contents create mode 100644 .Rproj.user/C3768FE8/sources/s-5CCDCDB3/F22781E7 create mode 100644 .Rproj.user/C3768FE8/sources/s-5CCDCDB3/F22781E7-contents create mode 100644 .Rproj.user/C3768FE8/sources/s-5CCDCDB3/lock_file create mode 100644 .Rproj.user/shared/notebooks/patch-chunk-names create mode 100644 .Rproj.user/shared/notebooks/paths create mode 100644 2.Rproj create mode 100644 Schrick-Noah_CS-7863_Homework-2.R create mode 100644 katz_centrality.R create mode 100644 self_estrada.R diff --git a/.Rproj.user/C3768FE8/sources/prop/79E7A040 b/.Rproj.user/C3768FE8/sources/prop/79E7A040 new file mode 100644 index 0000000..b5e2847 --- /dev/null +++ b/.Rproj.user/C3768FE8/sources/prop/79E7A040 @@ -0,0 +1,7 @@ +{ + "tempName": "Untitled1", + "source_window_id": "", + "Source": "Source", + "cursorPosition": "48,0", + "scrollLine": "36" +} \ No newline at end of file diff --git a/.Rproj.user/C3768FE8/sources/prop/8FED07D0 b/.Rproj.user/C3768FE8/sources/prop/8FED07D0 new file mode 100644 index 0000000..220f8a1 --- /dev/null +++ b/.Rproj.user/C3768FE8/sources/prop/8FED07D0 @@ -0,0 +1,7 @@ +{ + "tempName": "Untitled1", + "source_window_id": "", + "Source": "Source", + "cursorPosition": "35,4", + "scrollLine": "34" +} \ No newline at end of file diff --git a/.Rproj.user/C3768FE8/sources/prop/A5F06F40 b/.Rproj.user/C3768FE8/sources/prop/A5F06F40 new file mode 100644 index 0000000..aa497de --- /dev/null +++ b/.Rproj.user/C3768FE8/sources/prop/A5F06F40 @@ -0,0 +1,7 @@ +{ + "tempName": "Untitled1", + "source_window_id": "", + "Source": "Source", + "cursorPosition": "240,0", + "scrollLine": "226" +} \ No newline at end of file diff --git a/.Rproj.user/C3768FE8/sources/prop/INDEX b/.Rproj.user/C3768FE8/sources/prop/INDEX new file mode 100644 index 0000000..754e897 --- /dev/null +++ b/.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" diff --git a/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/082578C8 b/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/082578C8 new file mode 100644 index 0000000..4ddb924 --- /dev/null +++ b/.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": [] +} \ No newline at end of file diff --git a/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/082578C8-contents b/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/082578C8-contents new file mode 100644 index 0000000..e69de29 diff --git a/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/4101911F b/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/4101911F new file mode 100644 index 0000000..ce8fc2d --- /dev/null +++ b/.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": [] +} \ No newline at end of file diff --git a/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/4101911F-contents b/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/4101911F-contents new file mode 100644 index 0000000..43f3103 --- /dev/null +++ b/.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) +} + \ No newline at end of file diff --git a/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/6957530B b/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/6957530B new file mode 100644 index 0000000..fb7d71c --- /dev/null +++ b/.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": [] +} \ No newline at end of file diff --git a/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/6957530B-contents b/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/6957530B-contents new file mode 100644 index 0000000..e69de29 diff --git a/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/DE635CF7 b/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/DE635CF7 new file mode 100644 index 0000000..38b6b17 --- /dev/null +++ b/.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": [] +} \ No newline at end of file diff --git a/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/DE635CF7-contents b/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/DE635CF7-contents new file mode 100644 index 0000000..3b341ab --- /dev/null +++ b/.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) +} \ No newline at end of file diff --git a/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/F22781E7 b/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/F22781E7 new file mode 100644 index 0000000..a84fcad --- /dev/null +++ b/.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": [] +} \ No newline at end of file diff --git a/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/F22781E7-contents b/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/F22781E7-contents new file mode 100644 index 0000000..8e0e490 --- /dev/null +++ b/.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) diff --git a/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/lock_file b/.Rproj.user/C3768FE8/sources/s-5CCDCDB3/lock_file new file mode 100644 index 0000000..e69de29 diff --git a/.Rproj.user/shared/notebooks/patch-chunk-names b/.Rproj.user/shared/notebooks/patch-chunk-names new file mode 100644 index 0000000..e69de29 diff --git a/.Rproj.user/shared/notebooks/paths b/.Rproj.user/shared/notebooks/paths new file mode 100644 index 0000000..68c42ea --- /dev/null +++ b/.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" diff --git a/2.Rproj b/2.Rproj new file mode 100644 index 0000000..066341e --- /dev/null +++ b/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 diff --git a/Schrick-Noah_CS-7863_Homework-2.R b/Schrick-Noah_CS-7863_Homework-2.R new file mode 100644 index 0000000..8e0e490 --- /dev/null +++ b/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) diff --git a/katz_centrality.R b/katz_centrality.R new file mode 100644 index 0000000..3b341ab --- /dev/null +++ b/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) +} \ No newline at end of file diff --git a/self_estrada.R b/self_estrada.R new file mode 100644 index 0000000..43f3103 --- /dev/null +++ b/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) +} + \ No newline at end of file