用R中的igraph计算属性类间的网络统计

我正在使用R3.5.2中的igraph版本1.2.4.2来分析网络数据。顶点（节点）具有分类属性，如“性别”和“年龄”类，而边是无向的和加权的。我导入了邻接矩阵，并使用“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

---

gMM在igraph中，我还没有找到一种令人满意的方法（我能记得）来做这种事情，所以我总是做下面这样的事情

首先，这里是一些示例数据

库（igraph，warn.conflicts=FALSE）；结实种子（831）；8ef5eee中的n_节点+边（顶点名称）：
#>[1]b--cf--gc--hf--ha--ib--if--je--ki--kc--l

。。。这里有一个函数，它提取只包含同向或异向边的网络

子图\u边\u同态%
子图\u边\u嗜同性（vattr\u name=“sex”，嗜异性=真）%>%
介数（定向=假）
#>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版本3.6.2（2019-12-12）
#>平台：x86_64-pc-linux-gnu（64位）
#>运行于：Ubuntu 18.04.4 LTS
#> 
#>矩阵乘积：默认值
#>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
#> 
#>区域设置：
#>[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_地址=C LC_电话=C
#>[11]LC_测量=en_US.UTF-8 LC_识别=C
#> 
#>附加基本包：
#>[1]统计图形设备GRUTILS数据集方法库
#> 
#>其他随附包裹：
#>[1]IGU 1.2.4.2
#> 
#>通过命名空间加载（未附加）：
#>[1]编译器\u 3.6.2 magrittr\u 1.5工具\u 3.6.2 htmltools\u 0.4.0
#>[5]yaml_2.2.1 Rcpp_1.0.3 stringi_1.4.6 rmarkdown_2.1.1
#>[9]高0.8刀1.28弦1.4.0 xfun 0.12
#>[13]摘要0.6.24 pkgconfig 2.0.3 rlang 0.4.4评估0.14
我还没有找到一种令人满意的方法（我永远都记得）在igraph中做这种事情，所以我总是做下面这样的事情

首先，这里是一些示例数据

库（igraph，warn.conflicts=FALSE）；结实种子（831）；8ef5eee中的n_节点+边（顶点名称）：
#>[1]b--cf--gc--hf--ha--ib--if--je--ki--kc--l

。。。这里有一个函数，它提取只包含同向或异向边的网络

子图\u边\u同态%
子图\u边\u嗜同性（vattr\u name=“sex”，嗜异性=真）%>%
介数（定向=假）
#>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版本3.6.2（2019-12-12）
#>平台：x86_64-pc-linux-gnu（64位）
#>运行于：Ubuntu 18.04.4 LTS
#> 
#>矩阵乘积：默认值
#>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
#> 
#>区域设置：
#>[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_地址=C LC_电话=C
#>[11]LC_测量=en_US.UTF-8 LC_识别=C
#> 
#>附加基本包：
#>[1]统计图形设备GRUTILS数据集方法库
#> 
#>其他随附包裹：
#>[1]IGU 1.2.4.2
#> 
#>通过命名空间加载（未附加）：
#>[1]编译器\u 3.6.2 magrittr\u 1.5工具\u 3.6.2 htmltools\u 0.4.0
#>[5]yaml_2.2.1 Rcpp_1.0.3 stringi_1.4.6 rmarkdown_2.1.1
#>[9]高0.8刀1.28弦1.4.0 xfun 0.12
#>[13]摘要0.6.24 pkgconfig 2.0.3 rlang 0.4.4评估0.14
我对@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)
    })
  })
}



##功能-第1部分##
子类_edges我对@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)
    })
  })
}



##功能-第1部分##
我认为包中会有内置函数来完成任务。非常感谢@knapply，这非常有帮助。我想包中会有内置函数来完成这项任务。非常感谢@knapply，这很有帮助。