{{ message }}

Instantly share code, notes, and snippets.

# briatte/swan_combinatory.r

Last active Nov 8, 2015
see https://groupefmr.hypotheses.org/4190 ~ the code below is NOT quicker, perhaps due to calling all igraph functions through :: — it is, however, shorter than the NetSwan 0.1.0 code
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 swan_connectivity <- function(g) { d = igraph::distances(g) sum(!is.infinite(d) & d > 0) } swan_combinatory <- function (g, k = 10) { n <- igraph::vcount(g) t <- connectivity(g) f <- matrix(ncol = 5, nrow = n, 0) # COL 2: BETWEENNESS m <- cbind(1:n, igraph::betweenness(g)) m <- m[ order(m[, 2]), ] p <- g for (i in 1:n) { v <- n + 1 - i p <- igraph::delete_vertices(p, m[v, 1]) f[i, 1] <- (n - v + 1) / n f[i, 2] <- t - swan_connectivity(p) m[ m[, 1] > m[v, 1], 1] <- m[ m[, 1] > m[v, 1], 1] - 1 } # COL 3: DEGREE m <- cbind(1:n, igraph::degree(g)) m <- m[ order(m[, 2]), ] p <- g for (i in 1:n) { v <- n + 1 - i p <- igraph::delete_vertices(p, m[v, 1]) f[i, 3] <- t - swan_connectivity(p) m[ m[, 1] > m[v, 1], 1] <- m[ m[, 1] > m[v, 1], 1] - 1 } # COL 4: CASCADING p <- g npro <- n for (i in 1:(n - 1)) { m <- cbind(1:npro, igraph::betweenness(p)) m <- m[ order(m[, 2]), ] p <- igraph::delete_vertices(p, m[npro, 1]) f[i, 4] <- t - swan_connectivity(p) npro <- npro - 1 } f[n, 4] <- t # COL 5: RANDOM for (l in 1:k) { al <- sample(1:n, n) p <- g for (i in 1:n) { p <- igraph::delete_vertices(p, al[i]) f[i, 5] <- f[i, 5] + t - swan_connectivity(p) al[al > al[i]] <- al[al > al[i]] - 1 } } f[, 2:4] <- f[, 2:4] / t f[, 5] <- f[, 5] / t / k return(f) }
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 library(igraph) library(testthat) g <- matrix(nc = 2, byrow = TRUE, c(11,1, 11,10, 1,2, 2,3, 2,9, 3,4, 3,8, 4,5, 5,6, 5,7, 6,7, 7,8, 8,9, 9,10)) g <- graph.edgelist(g, directed = FALSE) expect_equal(swan_combinatory(g)[, 1], NetSwan::swan_combinatory(g, 10)[, 1]) expect_equal(swan_combinatory(g)[, 2], NetSwan::swan_combinatory(g, 10)[, 2]) expect_equal(swan_combinatory(g)[, 3], NetSwan::swan_combinatory(g, 10)[, 3]) expect_equal(swan_combinatory(g)[, 4], NetSwan::swan_combinatory(g, 10)[, 4]) # unequal due to random component # expect_equal(swan_combinatory(g)[, 5], NetSwan::swan_combinatory(g, 10)[, 5]) g <- matrix(nc = 2, byrow = TRUE, c(11,1, 11,10, 1,2, 2,3, 2,9, 3,4, 3,8, 4,5, 5,6, 5,7, 6,7, 7,8, 8,9, 9,10, 12,13)) g <- graph.edgelist(g, directed = FALSE) expect_equal(swan_combinatory(g)[, 1], NetSwan::swan_combinatory(g, 10)[, 1]) expect_equal(swan_combinatory(g)[, 2], NetSwan::swan_combinatory(g, 10)[, 2]) expect_equal(swan_combinatory(g)[, 3], NetSwan::swan_combinatory(g, 10)[, 3]) expect_equal(swan_combinatory(g)[, 4], NetSwan::swan_combinatory(g, 10)[, 4]) # unequal due to random component # expect_equal(swan_combinatory(g)[, 5], NetSwan::swan_combinatory(g, 10)[, 5])
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 swan_efficiency <- function (g, pow = 1) { cl_g <- igraph::distances(g) ^ pow cl_g[ is.infinite(cl_g) ] <- 0 cl_s <- sum(cl_g) sapply(1:igraph::vcount(g), function(v) { p <- igraph::delete_vertices(g, v) cl_p <- igraph::distances(p) ^ pow cl_p <- sum(cl_p[ !is.infinite(cl_p) ]) cl_p - (cl_s - sum(cl_g[ v, ]) - sum(cl_g[ ,v ])) }) } swan_closeness <- function (g) { swan_efficiency(g, -1) } swan_connectivity <- function (g) { cl_g <- igraph::distances(g) cl_g <- sum(is.infinite(cl_g)) sapply(1:igraph::vcount(g), function(v) { p <- igraph::delete_vertices(g, v) cl_p <- igraph::distances(p) cl_p <- sum(is.infinite(cl_p)) cl_p - cl_g }) }
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode characters
 # check that my own functions return the same results as NetSwan, # using the author's example: all nodes have finite distances library(igraph) library(testthat) g <- matrix(nc = 2, byrow = TRUE, c(11,1, 11,10, 1,2, 2,3, 2,9, 3,4, 3,8, 4,5, 5,6, 5,7, 6,7, 7,8, 8,9, 9,10)) g <- graph.edgelist(g, directed = FALSE) expect_equal(as.matrix(swan_closeness(g)), NetSwan::swan_closeness(g)) expect_equal(as.matrix(swan_efficiency(g)), NetSwan::swan_efficiency(g)) expect_equal(as.matrix(swan_connectivity(g)), NetSwan::swan_connectivity(g)) # same tests, with two nodes that have infinite distance g <- matrix(nc = 2, byrow = TRUE, c(11,1, 11,10, 1,2, 2,3, 2,9, 3,4, 3,8, 4,5, 5,6, 5,7, 6,7, 7,8, 8,9, 9,10, 12,13)) g <- graph.edgelist(g, directed = FALSE) expect_equal(as.matrix(swan_closeness(g)), NetSwan::swan_closeness(g)) expect_equal(as.matrix(swan_efficiency(g)), NetSwan::swan_efficiency(g)) expect_equal(as.matrix(swan_connectivity(g)), NetSwan::swan_connectivity(g)) # the swan_efficiency test fails because NetSwan::swan_efficiency does not prune # infinite distances, which results in NaNs instead of numeric (integer) results