使用R中的图计算属性类之间的网络统计
使用R中的图计算属性类之间的网络统计
提问于 2020-02-18 19:26:18
我正在使用R 3.5.2中的igraph版本1.2.4.2来分析网络数据。顶点(节点)具有像“性别”和“Age_class”这样的分类属性，而边是无向的和加权的。我导入了邻接矩阵，并使用“set_vertex_attr”命令附加了顶点属性。我想要计算的网络指标不仅包括全局网络的介数和强度，还包括属性类之间和属性类内的介数，即雌雄之间加权连接的介数。
我能够通过删除其他属性类的顶点来计算类内网络统计信息，例如
gMM <- delete.vertices(g, V(g)[Sex != 'M']) # making a network of only males
betweenness(gMM, direction = F) # calculating male-male only betweenness但是，这种方法不适用于类间统计，我想知道是否有人知道如何在图形中计算类间统计，谢谢。
回答 2
Stack Overflow用户
发布于 2020-02-21 01:37:07
我还没有找到一种令人满意的方式(我能记住的)在igraph中做这类事情，所以我总是像下面这样做。
首先，这里有一些示例数据...
library(igraph, warn.conflicts = FALSE); set.seed(831); n_nodes <- 12
g <- random.graph.game(n_nodes, 0.2)
vertex_attr(g) <- list(name = letters[seq_len(n_nodes)],
sex = sample(c("male", "female"), n_nodes, replace = TRUE))
edge_attr(g) <- list(weight = sample(1:50, size = ecount(g)))
g
#> IGRAPH 8ef5eee UNW- 12 10 -- Erdos renyi (gnp) graph
#> + attr: name (g/c), type (g/c), loops (g/l), p (g/n), name (v/c), sex
#> | (v/c), weight (e/n)
#> + edges from 8ef5eee (vertex names):
#> [1] b--c f--g c--h f--h a--i b--i f--j e--k i--k c--l..。这是一个函数，可以提取只包含同嗜性或异嗜性边的网络...
subgraph_edges_homophily <- function(graph, vattr_name, heterophily = FALSE,
drop_isolates = FALSE) {
stopifnot( # arg checks
igraph::is.igraph(graph) || is.character(vattr_name) ||
length(vattr_name) == 1L || !is.na(vattr_name) ||
vattr %in% igraph::vertex_attr_names(vattr_name)
)
vattrs <- igraph::vertex_attr(graph, name = vattr_name)
total_el <- igraph::as_edgelist(graph, names = FALSE)
# rows from total_el where the attribute of the edge source == attribute of edge target
edges_to_keep <- vattrs[total_el[, 1L]] == vattrs[total_el[, 2L]]
# for heterophilous ties, just negate the "in_group" version
if (heterophily) edges_to_keep <- !edges_to_keep
igraph::subgraph.edges(graph,
eids = which(edges_to_keep),
delete.vertices = drop_isolates)
}subgraph_edges_homophily()会让你提取你正在寻找的网络，就像这样……
# homophily
subgraph_edges_homophily(g, vattr_name = "sex")
#> IGRAPH 1bc4a38 UNW- 12 3 -- Erdos renyi (gnp) graph
#> + attr: name (g/c), type (g/c), loops (g/l), p (g/n), name (v/c), sex
#> | (v/c), weight (e/n)
#> + edges from 1bc4a38 (vertex names):
#> [1] e--k i--k c--l
# heterophily
subgraph_edges_homophily(g, vattr_name = "sex", heterophily = TRUE)
#> IGRAPH e79e82d UNW- 12 7 -- Erdos renyi (gnp) graph
#> + attr: name (g/c), type (g/c), loops (g/l), p (g/n), name (v/c), sex
#> | (v/c), weight (e/n)
#> + edges from e79e82d (vertex names):
#> [1] b--c f--g c--h f--h a--i b--i f--j
# no isolates
subgraph_edges_homophily(g, vattr_name = "sex", drop_isolates = TRUE)
#> IGRAPH 8ce3efe UNW- 5 3 -- Erdos renyi (gnp) graph
#> + attr: name (g/c), type (g/c), loops (g/l), p (g/n), name (v/c), sex
#> | (v/c), weight (e/n)
#> + edges from 8ce3efe (vertex names):
#> [1] e--k i--k c--l..。然后，您可以根据需要在这些网络上运行指标。这是一个计算类间度量的示例，就像您所问的那样……
g %>%
subgraph_edges_homophily(vattr_name = "sex", heterophily = TRUE) %>%
betweenness(directed = FALSE)
#> a b c d e f g h i j k l
#> 0 10 12 0 0 11 0 12 6 0 0 0-
sessionInfo()
#> R version 3.6.2 (2019-12-12)
#> Platform: x86_64-pc-linux-gnu (64-bit)
#> Running under: Ubuntu 18.04.4 LTS
#>
#> Matrix products: default
#> BLAS: /usr/lib/x86_64-linux-gnu/blas/libblas.so.3.7.1
#> LAPACK: /usr/lib/x86_64-linux-gnu/lapack/liblapack.so.3.7.1
#>
#> locale:
#> [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
#> [3] LC_TIME=en_US.UTF-8 LC_COLLATE=en_US.UTF-8
#> [5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
#> [7] LC_PAPER=en_US.UTF-8 LC_NAME=C
#> [9] LC_ADDRESS=C LC_TELEPHONE=C
#> [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
#>
#> attached base packages:
#> [1] stats graphics grDevices utils datasets methods base
#>
#> other attached packages:
#> [1] igraph_1.2.4.2
#>
#> loaded via a namespace (and not attached):
#> [1] compiler_3.6.2 magrittr_1.5 tools_3.6.2 htmltools_0.4.0
#> [5] yaml_2.2.1 Rcpp_1.0.3 stringi_1.4.6 rmarkdown_2.1.1
#> [9] highr_0.8 knitr_1.28 stringr_1.4.0 xfun_0.12
#> [13] digest_0.6.24 pkgconfig_2.0.3 rlang_0.4.4 evaluate_0.14Stack Overflow用户
发布于 2020-02-21 23:54:47
我对@knapply提供的解决方案做了一些修改，因此该函数将提供1)类内网络(例如男性-男性)；2)类间网络(男性-女性)；以及3)当属性具有超过2个类(例如年龄类)时提供到其他类的网络。以下是修改后的函数：
## Function - part1 ##
subclass_edges <- function(graph, vattr_name){
stopifnot( # arg checks
igraph::is.igraph(graph) || is.character(vattr_name) ||
length(vattr_name) == 1L || !is.na(vattr_name) ||
vattr %in% igraph::vertex_attr_names(vattr_name)
)
vattrs <- igraph::vertex_attr(graph, name = vattr_name)
vattrs_class <- unique(vattrs)
total_el <- igraph::as_edgelist(graph, names = FALSE)
# Attribute class to single attribute class
list_name <- paste0("to_", vattrs_class)
map(vattrs_class, function(x){
map(1:length(vattrs_class), function(y){
(vattrs[total_el[, 1L]] == x) & (vattrs[total_el[, 2L]] == vattrs_class[y])
}) -> to_class
names(to_class) <- list_name
return(to_class)
}) -> attr_class
names(attr_class) <- vattrs_class
if(length(vattrs_class) > 2){
# Attribute class to all other attribute classes
map(vattrs_class, function(x){
(vattrs[total_el[, 1L]] == x) & (vattrs[total_el[, 2L]] != x)
}) -> to_others
names(to_others) <- vattrs_class
# Combine
map(1:length(vattrs_class), function(c){
fin <- c(attr_class[[c]], to_others[c])
names(fin) <- c(list_name, "to_others")
return(fin)
}) -> combind_edges
names(combind_edges) <- vattrs_class
edges_to_keep <- combind_edges
} else {
edges_to_keep <- attr_class
}
return(edges_to_keep)
}
## Function - part2 ##
subclass <- function(graph, vattr_name, drop_isolates = FALSE){
subclass_edges(graph, vattr_name) -> input
map(input, function(form){
map(form, function(to){
igraph::subgraph.edges(graph,
eids = which(to),
delete.vertices = drop_isolates)
})
})
}下面是一个由@knapply的答案修改的示例，其中包含新属性"age_class“和更多节点(顶点)：
## Example ##
set.seed(100)
n_nodes <- 20
g <- random.graph.game(n_nodes, 0.2)
vertex_attr(g) <- list(name = letters[seq_len(n_nodes)],
sex = sample(c("male", "female"), n_nodes, replace = TRUE),
age_class = sample(c("15-20", "21-25", "26-30"), n_nodes, replace = TRUE))
edge_attr(g) <- list(weight = sample(1:50, size = ecount(g)))
g
#> IGRAPH ce7c899 UNW- 20 44 -- Erdos renyi (gnp) graph
#> + attr: name (g/c), type (g/c), loops (g/l), p (g/n), name (v/c), sex (v/c), age_class (v/c), weight (e/n)
#> + edges from ce7c899 (vertex names):
#> [1] b--c a--d b--e c--e b--f a--g e--g g--h f--i g--i a--j e--j a--k b--k h--k b--l h--l k--l c--m f--m l--m i--n m--n b--o g--o
#> [26] k--o b--p f--p h--p c--q p--q f--r k--r n--r p--r b--s h--s m--s n--s p--s q--s i--t k--t n--t
g %>% subclass(vattr_name = "age_class") -> g_a
g_a$`15-20`$`to_26-30` %>% igraph::betweenness(directed = F)
# betweenness of indviduals in '15-20' age class with individuals in '26-30' age class
#> a b c d e f g h i j k l m n o p q r s t
#> 0 9 0 0 0 15 10 0 11 0 9 0 0 0 18 9 0 18 0 0
g_a$`15-20`$to_others %>% igraph::betweenness(directed = F)
# betweenness of indviduals in '15-20' age class with individuals in all age classes except '15-20'
#> a b c d e f g h i j k l m n o p q r s t
#> 0 45 0 0 0 16 32 0 16 0 21 21 0 0 34 18 0 16 10 0 希望这能对有类似问题的人有所帮助。
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/60279825
复制相关文章
相似问题
腾讯云开发者
