version 0.7.0

DESCRIPTION

@@ -0,0 +1,22 @@
+Package: netUtils
+Title: Miscellaneous Functions for Network Analysis
+Version: 0.7.0
+Authors@R: 
+    person("David", "Schoch", email = "david@schochastics.net", role = c("aut", "cre"),
+           comment = c(ORCID = "0000-0003-2952-4812"))
+Description: Provides a collection of network analytic (convenience) functions which are missing in other standard packages. This includes triad census with attributes <doi:10.1016/j.socnet.2019.04.003>, core-periphery models <doi:10.1016/S0378-8733(99)00019-2>, and several graph generators. Most functions are build upon 'igraph'.  
+URL: https://github.com/schochastics/netUtils/
+BugReports: https://github.com/schochastics/netUtils/issues
+License: MIT + file LICENSE
+Encoding: UTF-8
+RoxygenNote: 7.2.0
+LinkingTo: Rcpp, RcppArmadillo
+Imports: Rcpp, igraph, stats
+Suggests: covr, testthat (>= 3.0.0)
+Config/testthat/edition: 3
+NeedsCompilation: yes
+Packaged: 2022-08-26 12:40:31 UTC; david
+Author: David Schoch [aut, cre] (<https://orcid.org/0000-0003-2952-4812>)
+Maintainer: David Schoch <david@schochastics.net>
+Repository: CRAN
+Date/Publication: 2022-08-27 08:40:05 UTC

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2019
+COPYRIGHT HOLDER: David Schoch

MD5

@@ -0,0 +1,53 @@
+baca1c2d0c472d997cd9a4cc29025d36 *DESCRIPTION
+e7169b5a4594da18e5ad9ba2db89154d *LICENSE
+d5a5888124866e90ed91c7e50c7b7f48 *NAMESPACE
+b1ba4a2307301b825bad25feaef212d2 *NEWS.md
+3a14204d6d2d659066eca9d3b17e4ad4 *R/RcppExports.R
+fdc65c00cae7fb89ebc8394deb974302 *R/core_periphery.R
+ff3cd3d422fec946f335ad907a82ac84 *R/dyad_census_attr.R
+4df312d407b347ec866dffc61331cb0c *R/fast_cliques.R
+8316973920c83d79af3bd3a99de04324 *R/graph_products.R
+df7c739b0b351242413df601a015900c *R/graph_structures.R
+b13cba23528fd8406fb7103f6b80d1fc *R/graphs.R
+fb37a3fcb369fcbf597fc0758daf5130 *R/lfr_benchmark.R
+8461870b83acf80959d17c3216bb7cc6 *R/netUtils-package.R
+88a641afb0f4c83c96e07c9bf4e9e41e *R/print_igraph.R
+c5ea5a37acc1aab97cf3bb3719806386 *R/qap.R
+dfb5c8aeb73081e9558868671de09a51 *R/sample_kcores.R
+2dcbfe612c9225cab216cb21d15409d6 *R/sample_pa_homophilic.R
+d358bef387e0fedfddf76cdf89270850 *R/structural_equivalence.R
+872266c375682853343b521e072120fc *R/triad_census_attr.R
+fe9ebb5848cc2edc99bf6bb5f1b43971 *R/utils.R
+ce616d9f1a9f24992a6f9fb0f1c695ea *README.md
+8ed9d7fed05daaa314c2a57c020b8674 *man/as_adj_list1.Rd
+285e8c97f908c0bc041c486a0bdb734a *man/as_adj_weighted.Rd
+5e5100de459bdd834db3a5f3f833f942 *man/as_multi_adj.Rd
+18071edf4db89329209030bc5ec4ce0c *man/bipartite_from_data_frame.Rd
+4d38aca154500ed98350dcf59fb8b1f8 *man/clique_vertex_mat.Rd
+5e22f02b7a33143e0046ae7245dc7d9e *man/core_periphery.Rd
+89b839833bf3289219350049df75785e *man/dyad_census_attr.Rd
+b855f5c661e30af4726a2a22ae849953 *man/fast_cliques.Rd
+2b1bccc6a050fe6aa3f24133348aa8fd *man/figures/logo.png
+0493342233e56aab5ee86b69d89fbaba *man/figures/netUtils.xcf
+14b8e78996fa3a052c672645464abbaa *man/graph_cartesian.Rd
+d28714abf267e5a5eac8be954e3852ce *man/graph_cor.Rd
+d77d25d66e62364fb89c3d5934dc9f20 *man/graph_direct.Rd
+3596a1d42d38c4bf77d804e6ed9f1af6 *man/graph_from_multi_edgelist.Rd
+5da31841031c2b4043f47d1335d74c89 *man/graph_kpartite.Rd
+416318f535e8a957afde51634ffc3d57 *man/graph_to_sage.Rd
+f20e64312667ecb2813c41825d486345 *man/helpers.Rd
+a23031bfaeb9e278d441553b44d076df *man/sample_coreseq.Rd
+f7c92c2bd152440c2e48200629837de7 *man/sample_pa_homophilic.Rd
+f2d4d39e86426c00fdfb38642b3ffd56 *man/split_graph.Rd
+7556bf59e3853f4a63f07383cf9b6310 *man/str.igraph.Rd
+3af7ed10fbe2e743042c720df2f68056 *man/structural_equivalence.Rd
+c95ef8453bfaf94fc3f00d67d39d87c8 *man/triad_census_attr.Rd
+2d907c7ef5841a4e6da4d7f9a594e804 *src/RcppExports.cpp
+0483e48d92cb9f4150fbb3a52e2dcc5d *src/mse.cpp
+c9feb1ad2e42c06117708b1ab66aad47 *src/triad_census_col.cpp
+5c9215d4381e674c2dddec13d64c3802 *tests/testthat.R
+2a88b8b150c677334d76a01120b6ae7c *tests/testthat/test-core_periphery.R
+98161930b66791f34e1a22033c6c0d0c *tests/testthat/test-dyad_census_attr.R
+e6c1bfecaeb7d33c6b6f895cbdfe484e *tests/testthat/test-sample_kcores.R
+451912beb91231a6e5242455d585a8a4 *tests/testthat/test-structural_equivalence.R
+947f9dbd58facce505f3df7898ecdccd *tests/testthat/test-triad_census_attr.R

NAMESPACE

@@ -0,0 +1,28 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method(graph_cor,array)
+S3method(graph_cor,default)
+S3method(graph_cor,igraph)
+S3method(graph_cor,matrix)
+S3method(str,igraph)
+export(as_adj_list1)
+export(as_adj_weighted)
+export(as_multi_adj)
+export(biggest_component)
+export(bipartite_from_data_frame)
+export(clique_vertex_mat)
+export(core_periphery)
+export(delete_isolates)
+export(fast_cliques)
+export(graph_cartesian)
+export(graph_cor)
+export(graph_direct)
+export(graph_from_multi_edgelist)
+export(graph_kpartite)
+export(sample_coreseq)
+export(sample_pa_homophilic)
+export(split_graph)
+export(structural_equivalence)
+export(triad_census_attr)
+importFrom(Rcpp,sourceCpp)
+useDynLib(netUtils, .registration = TRUE)

NEWS.md

@@ -0,0 +1,26 @@
+# netUtils 0.7.0   
+
+* fixed documentation 
+* removed unfinished functions
+* added examples 
+
+# netUtils 0.6.0.9000
+
+added `sample_pa_homophilic()`
+
+# netUtils 0.5.0.9000
+
+* renamed package to `netUtils`
+* added `bipartite_from_data_frame()`
+* added `graph_from_multi_edgelist()` and `as_multi_adj()`
+* added `structural_equivalence()`
+* added `core_periphery()`
+* added `sample_coreseq()`
+* added tests
+* added graph products `graph_cartesian()` and `graph_direct()`
+* added fast max clique routine `fast_cliques()`
+
+# igraphUtils 0.1.0
+
+* Added `as_adj_list1()` and `as_adj_weighted()`
+* Added `clique_vertex_mat()`

R/RcppExports.R

@@ -0,0 +1,15 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+mse <- function(adjList, deg) {
+    .Call(`_netUtils_mse`, adjList, deg)
+}
+
+sortxy <- function(x, y) {
+    .Call(`_netUtils_sortxy`, x, y)
+}
+
+triadCensusCol <- function(A, attr, orbitClasses, triads) {
+    .Call(`_netUtils_triadCensusCol`, A, attr, orbitClasses, triads)
+}
+

R/core_periphery.R

@@ -0,0 +1,201 @@
+#' Discrete core-periphery model
+#' @description Fits a discrete core-periphery model to a given network
+#' @param graph igraph object
+#' @param method algorithm to use (see details)
+#' @param iter number of iterations if `method=SA`
+#' @details The function fits the data to an optimal pattern matrix with simulated annealing (method="SA") or a rank 1 approximation, either with degree centrality (method="rk1_dc") or eigenvector centrality (method="rk1_ec") . The rank 1 approximation is computationally far cheaper but also more experimental. Best is to compare the results from both models.
+#' @return list with numeric vector with entries (k1,k2,...ki...) where ki assigns vertex i to either the core (ki=1) or periphery (ki=0), and the maximal correlation with an optimal pattern matrix
+#' @references
+#' Borgatti, Stephen P., and Martin G. Everett. "Models of core/periphery structures." Social networks 21.4 (2000): 375-395.
+#' @author David Schoch
+#' @examples
+#' set.seed(121)
+#' #split graphs have a perfect core-periphery structure
+#' sg <- split_graph(n = 20, p = 0.3,core = 0.5)
+#' core_periphery(sg)
+#' @export
+core_periphery <- function(graph,method="rk1_dc",iter=5000){
+  A <- igraph::as_adj(graph,type = "both",sparse = FALSE)
+  if(method=="SA"){
+    n <- nrow(A)
+    cvec <- sample(0:1,n,replace = TRUE)
+    res <- stats::optim(par = cvec, fn = cp_fct1__0, A = A,gr = genperm,method = "SANN",
+                 control = list(maxit = iter, temp = 10, tmax = 100, trace = FALSE,
+                                REPORT = 5))
+    return(list(vec=res$par,corr=-res$value))
+  } else if(method=="rk1_dc"){
+    ev <- igraph::degree(graph,mode="all",loops = FALSE)
+
+    thresh <- unique(ev)
+    optcorr <- -2
+
+    for(tr in thresh){
+      evabs <- (ev>=tr)+0
+      E <- outer(evabs,evabs,"+")
+      E[E==1] <- NA
+      E[E==2] <- 1
+      diag(E) <- NA
+      if(sum(E,na.rm = TRUE)==0){
+        next()
+      }
+      tmp <- suppressWarnings(graph_cor(E,A))
+      if(is.na(tmp)){
+        next()
+      }
+      if(tmp>optcorr){
+        optperm <- evabs
+        optcorr <- tmp
+      }
+    }
+    return(list(vec = optperm,corr=optcorr))
+  }else if(method=="rk1_ec"){
+    ev <- round(igraph::evcent(graph)$vector,8)
+
+    thresh <- unique(ev)
+    optcorr <- -2
+
+    for(tr in thresh){
+      evabs <- (ev>=tr)+0
+      E <- outer(evabs,evabs,"+")
+      E[E==1] <- NA
+      E[E==2] <- 1
+      diag(E) <- NA
+      if(sum(E,na.rm = TRUE)==0){
+        next()
+      }
+      tmp <- suppressWarnings(graph_cor(E,A))
+      if(is.na(tmp)){
+        next()
+      }
+      if(tmp>optcorr){
+        optperm <- evabs
+        optcorr <- tmp
+      }
+    }
+    return(list(vec = optperm,corr=optcorr))
+  } else{
+    stop("method must be one of 'SA', 'rk1_dc', or 'rk1_ec'")
+  }
+}
+
+
+#helper functions ----
+cp_fct1110 <- function(A,cvec){ #core=1 periphery=0
+  delta <- outer(cvec,cvec,function(x,y) x==1 | y==1 )
+  -sum(A*delta,na.rm = TRUE)
+}
+
+cp_fct1__0 <- function(A,cvec){ #core=1 periphery=0
+  delta <- outer(cvec,cvec,function(x,y) x+y)
+  delta[delta==1] <- NA
+  delta[delta==2] <- 1
+  diag(delta) <- NA
+  # -sum(A*delta,na.rm = TRUE)
+  -graph_cor(delta,A)
+}
+
+genperm <- function(A,cvec){
+  # 1=switch between values, 2= switch two nodes
+  what <- sample(1:2,1,prob = c(0.5,0.5))
+  if(what==1){
+    v <- sample(1:length(cvec),1)
+    cvec[v] <- 1-cvec[v]
+  } else if(what==2){
+    core <- which(cvec==1)
+    pery <- which(cvec==0)
+    v <- sample(core,1)
+    w <- sample(pery,1)
+    cvec[v] <- 0
+    cvec[w] <- 1
+  } else{
+
+  }
+  cvec
+}
+
+
+genperm_switch <- function(A,cvec){
+  core <- which(cvec==1)
+  pery <- which(cvec==0)
+  v <- sample(core,1)
+  w <- sample(pery,1)
+  cvec[v] <- 0
+  cvec[w] <- 1
+  cvec
+}
+
+
+# Rombach/Porter
+# a <- 0.99
+# b <- 0.2
+# iter <- 5000
+# trans_vec <- trans_fct(a,b,n)
+# plot(trans_vec)
+# perm <- sample(1:n)
+#
+# res <- stats::optim(par = perm, fn = cp_rombach, A = A,trans_vec = trans_vec,gr = genpermN,method = "SANN",
+#                     control = list(maxit = iter, temp = 10, tmax = 100, trace = TRUE,
+#                                    REPORT = 5))
+#
+# plot(trans_vec[res$par],degree(g))
+#
+# genpermN <- function(A,trans_vec,perm){
+#   uv <- sample(perm,2)
+#   u <- uv[1]
+#   v <- uv[2]
+#   tmp <- perm[u]
+#   perm[u] <- perm[v]
+#   perm[v] <- tmp
+#   perm
+# }
+#
+# cp_rombach <- function(A,trans_vec,perm){
+#   -sum(A*outer(trans_vec[perm],trans_vec[perm],"*"))
+# }
+#
+# trans_fct <- function(a,b,n){
+#   csize <- floor(b*n)
+#   nseq <- 1:n
+#   c(nseq[1:csize]*(1-a)/(2*csize),
+#     (nseq[(csize+1):n]-csize)*(1-a)/(2*(n-csize))+(1+a)/2
+#   )
+# }
+
+
+#CONCOR
+# VecFun <- Vectorize( cor )
+# system.time({
+#   for(k in 1:10){
+#     M <- outer(M_rows, M_rows, VecFun)
+#     M_rows <- split(M, row(M))
+#   }
+# })
+
+# https://www.nature.com/articles/srep01467.pdf
+# core_periphery_profile <- function(g){
+#   M <- as_adj(g,sparse=FALSE)
+#   rpi <- Matrix::rowSums(M)
+#   rpi <- rpi/sum(rpi)
+#   M <- M/Matrix::rowSums(M)
+#
+#   alpha <- rep(NA,vcount(g))
+#   P <- c()
+#   alpha[1] <- 0
+#   P <- c(P,which.min(rpi))
+#   nodes <- setdiff(1:vcount(g),P)
+#   for(i in 2:(vcount(g))){
+#     diagP <- diag(rpi[P],nrow = length(P),ncol = length(P))
+#     diagpi <- diag(rpi[nodes],nrow = length(nodes),ncol = length(nodes))
+#     res <- (sum(diagP%*%M[P,P]) +
+#               colSums(diagP%*%M[P,nodes]) +
+#               rowSums(diagpi%*%M[nodes,P]))/
+#       (sum(rpi[P])+rpi[nodes])
+#
+#     idx <- which(res==min(res))
+#     id <- sample(idx,1)
+#     P <- c(P,nodes[id])
+#     alpha[i] <- min(res)
+#     nodes <- nodes[-id]
+#   }
+#   return(alpha)
+# }

R/dyad_census_attr.R

@@ -0,0 +1,26 @@
+#' dyad census with node attributes
+#'
+#' @param g igraph object. should be a directed graph.
+#' @param vattr name of vertex attribute to be used.
+#' @return dyad census with node attributes.
+#' @details The node attribute should be integers from 1 to max(attr). Currently only works for 2
+#' @author David Schoch
+
+dyad_census_attr <- function(g,vattr){
+  if(!igraph::is_directed(g)){
+    stop("g must be a directed graph")
+  }
+  if(!vattr%in%igraph::vertex_attr_names(g)){
+    stop(paste0("there is no vertex attribute called ",vattr))
+  }
+  attr <- igraph::get.vertex.attribute(g,vattr)
+  if(!all(is.numeric(attr))){
+    stop("vertex attribute must be numeric ")
+  }
+  A <- igraph::as_adj(g)
+  # attrcomb <- as.matrix(expand.grid(1:max(attr),1:max(attr)))
+  # codes <- apply(attrcomb,1,paste0,collapse="")
+  # types <- c("asym","mut","null")
+  types <- c("asym-11", "mut-11", "null-11", "asym-12", "mut-12", "null-12", "asym-22", "mut-22", "null-22")
+  stop("not implemented yet")
+}