提取R中所有没有重复顶点属性的子图

问题描述 投票：0回答：1

我有一个像这样的图形对象：

# Create an empty graph
gss <- make_empty_graph(n = 12, directed = FALSE)

# Define vertex attributes
vertex_attr(gss) <- list(
  name = c("1", "2", "3", "4", "6", "7", "8", "10", "11", "17", "21", "23"),
  label = c("st_con_rt=main-room", "st_con_rt=sub-room", "st_con_tr=direct", "st_con_tr=terrace", "st_th=tsuma", "st_adsb=add", "st_adsb=sub", "tr_adsb=sub", "st_sub_main_th=hira", "roo_com=1a+7", "roo_com=2a+7", "roo_com=4a"),
  index = c(1, 2, 3, 4, 6, 7, 8, 10, 11, 17, 21, 23),
  element = c("st_con_rt", "st_con_rt", "st_con_tr", "st_con_tr", "st_th", "st_adsb", "st_adsb", "tr_adsb", "st_sub_main_th", "roo_com", "roo_com", "roo_com")
)

# Define edges
edges <- c("1", "4", "1", "6", "1", "10", "1", "23", "2", "3", "2", "7", "2", "11", "3", "8", "4", "6", "4", "7", "4", "10", "4", "23", "6", "10", "6", "23", "7", "10", "10", "23", "11", "17", "11", "21")

# Add edges to the graph
gss <- add_edges(gss, edges = edges)

我画了两种类型的图；每个节点带有 

index
的一个，另一个带有 
element
属性，可以轻松了解我需要达到的目标。

plot(gss, vertex.label=V(gss)$index)
plot(gss, vertex.label=V(gss)$element)

图片

element
中存储了 7 个唯一值，即“st_con_rt”、“st_con_tr”、“st_th”、“st_adsb”、“tr_adsb”、“st_sub_main_th”和“roo_com”。该属性将用作条件图提取。

现在，我需要提取所有不包含具有相同

element
的节点的子图。我手动检查了图表，所需结果的一部分可能包含这样的子图。 （抱歉，我无法完成它，但它可以提供所需输出的概述。
st_con_tr
和
st_con_rt
很难手动检查..）

为了实现这一目标，我在脚本中实现了以下过程。但不幸的是它没有完美实现，并且仍然存在算法问题。

  1. 从起始节点开始循环到存储在图形对象中的节点结束
  2. 从起始节点检查相邻节点并将它们存储在向量中
  3. 开始迭代，检查每个邻居节点是否有相同的
    element
  4. 如果它们有相同的元素，请忽略它
  5. 如果没有，则将其保存为从起始节点开始的连接节点
  6. 然后，转到该连接的节点
  7. 检查该连接节点的邻居节点（与#2相同）
  8. 然后，继续与#3-7相同的过程
  9. 一旦到达终点，它就会回到#3中存储的下一个邻居节点
  10. 如果检查了所有分支，则转到下一个起始节点
  11. 对所有节点完成，然后删除重复的子图

在当前的脚本中，它是这样的。让我从节点 1 开始。

  1. 节点 1 作为邻居节点连接到节点 4、6、10 和 23。
  2. 所有相邻节点不具有相同的
    element
    ，因此它可以走4个方向。让我们从节点 4 开始按升序排列。现在节点 1 和节点 4 已连接。该子图已经包含两个
    elements
    ：
    roo_com
    和
    st_con_tr
    。
  3. 节点 4 连接到节点 6、7、10 和 23，它们没有相同的“元素”。让我们转到节点 6。现在节点 1、4 和 6 已连接。现在这个子图包含 
    roo_com
    、
    st_con_tr
    和 
    st_th
    。
  4. 节点 6 连接到节点 1、4、10 和 23。但是在这批中我们已经访问了节点 1 和 4，因此目标节点只有 10 和 23，其中 
    element
    未在当前子图中列出。让我们转到节点 10 并将其连接到它。现在这个子图包含 
    roo_com
    、
    st_con_tr
    、
    st_th
    和 
    tr_adsb
    。
  5. 节点10连接1、4、6、7和23。由于它已经访问过节点1、4、6，所以目标节点只有7和23，其中
    element
    未在当前子图中列出。让我们转到节点 7 并将其连接到它。现在这个子图包含 
    roo_com
    、
    st_con_tr
    、
    st_th
    、
    tr_adsb
    和 
    st_adsb
    。
  6. 等等，这个批次没有访问节点 23，尽管它的 
    element
    没有被使用。 <= THIS IS THE FIRST ISSUE
  7. 现在节点 7 的邻居只是节点 2，但它的 
    element
    是 
    st_con_rt
    。它已在此批次中列出，因为节点 4 具有相同的 
    element
    。现在第一批已经完成了。
  8. 下一批从节点 6 开始，节点 6 已经连接到节点 1。那么节点 6 的邻居是节点 1、4、10 和 23。这个过程会一直持续下去...

我意识到当前进程无法获得我想要的东西。这是当前脚本，但它也带来了奇怪的输出，即后续节点的分支迭代无法按预期工作，这可能是由于在嵌套循环期间替换 

visited_node
和 
stack
导致的。我插入了 
visited_recur
和 
stack_recur
来避免它，但它仍然存在。不管怎样，这个脚本包含了上面提到的基本问题。

## Extract all subgraphs without duplicated "element" values
  # It shall be pre-defined as this function contain itlsef recursively
  
  ## Set recursive function for exploring neighbors
  search_neighbor <- function(graph, current_node, visited_node, stack) {
    
    # Get neighbors of the current node
    neighbors <- neighbors(graph, current_node)
    
    # Explore each neighboring node recursively
    for (neighbor_node in neighbors[!visited_node[neighbors]]) {
      if (vertex_attr(graph)$element[current_node] != vertex_attr(graph)$element[neighbor_node]) {
      
      print(paste0("# Recursive search: node ", current_node, " connected to node ", neighbor_node))

      # Update visited node not to revisit
        visited_node[neighbor_node] <- TRUE
      
      # Add the node to the connected subgraph
        stack <- c(stack, neighbor_node)
        
      # Recursive process to go to next neighbor node
        stack <- search_neighbor(gss, neighbor_node, visited_node, stack)
      
      }
    }
  }
  
## Initialize subgraph to store connected nodes and edges
  list_subgraph <- list()
  
## Initialize i
  i <- 1
  
  ## Iteration for all nodes as starting point
  for (start_node in V(gss)) {
    
    # Initialize visited nodes as all FALSE from node list in the graph
    visited_node <- logical(length(V(gss)))
    visited_node[start_node] <- TRUE
    
    # Stack start node as starting point
    stack <- start_node
    
    # Search neighboring nodes from start node
    neighbors <- neighbors(gss, start_node)
    
    # Start node as current node as starting point
    current_node <- start_node
    
    print(paste0("// Start from node ", current_node))
    
      # Iteration for neighboring nodes
      for (neighbor_node in neighbors[!visited_node[neighbors]]) {
        
        # Initialize an empty graph for the connected subgraph
        connected_subgraph <- make_empty_graph(n = 0, directed = FALSE)

        # Check if neighboring node contains a different element
        if (vertex_attr(gss)$element[current_node] != vertex_attr(gss)$element[neighbor_node]) {
          
          print(paste0("Node ", current_node, " connected to node ", neighbor_node))
          
          # Add neighboring node to subgraph
          stack <- c(stack, neighbor_node) ; stack_recur <- stack
          # Update visited node not to revisit
          visited_node[neighbor_node] <- TRUE ; visited_recur <- visited_node

          # Recursive exploration of neighbors from current neighbor node till the end
          search_neighbor(gss, neighbor_node, visited_recur, stack_recur)
          
          # Store connected subgraph
          connected_subgraph <- subgraph(gss, stack)
          
        }
        
        print(paste0("\\ Finished #", i, " search neighbors:", paste(stack, collapse = ", ")))
        
        # Store extracted subgraph from search result
        list_subgraph[[i]] <- connected_subgraph
        
        # Update i
        i <- i + 1
        
      }
    }

  # Remove duplicated subtracted graphs
  unique_subgraphs <- unique(list_subgraph)

我不确定这个复杂的问题是否可以在这个论坛中提出，因为它没有指定脚本问题。希望有人可以提供任何见解来改进它。我希望是否有任何功能可以解决这个问题，而无需实现复杂的搜索方法。

r igraph subgraph
1个回答
0
投票

您可以尝试以下代码

lst <- unique(
  Filter(
    \(x) length(x) > 1,
    unlist(
      apply(
        expand.grid(split(V(gss), V(gss)$element)),
        1,
        \(x) {
          lapply(
            decompose(induced_subgraph(gss, x)),
            \(g) V(g)$name
          )
        }
      ),
      recursive = FALSE
    )
  )
)

repeat {
  lgl <- rep(TRUE, length(lst))
  for (k in seq_along(lst)) {
    p <- lst[[k]]
    if (any(sapply(lst[-k], \(x) all(p %in% x)))) {
      lgl[k] <- FALSE
    }
  }
  if (all(lgl)) break
  lst <- lst[lgl]
}

out <- lapply(lst, induced_subgraph, graph = gss)

其中 

out
是所有子图的列表，其中所有顶点都具有不同的 
element
属性

> out
[[1]]
IGRAPH ec008ca UN-- 7 6 --
+ attr: name (v/c), label (v/c), index (v/n), element (v/c)
+ edges from ec008ca (vertex names):
[1] 2 --3  2 --7  2 --11 6 --10 7 --10 11--17

[[2]]
IGRAPH ec009a9 UN-- 7 6 --
+ attr: name (v/c), label (v/c), index (v/n), element (v/c)
+ edges from ec009a9 (vertex names):
[1] 2 --3  2 --7  2 --11 6 --10 7 --10 11--21

[[3]]
IGRAPH ec00a4b UN-- 7 7 --
+ attr: name (v/c), label (v/c), index (v/n), element (v/c)
+ edges from ec00a4b (vertex names):
[1] 2 --3  2 --7  2 --11 6 --10 6 --23 7 --10 10--23

[[4]]
IGRAPH ec00ae0 UN-- 5 4 --
+ attr: name (v/c), label (v/c), index (v/n), element (v/c)
+ edges from ec00ae0 (vertex names):
[1] 2 --3  3 --8  2 --11 11--17

[[5]]
IGRAPH ec00b75 UN-- 5 4 --
+ attr: name (v/c), label (v/c), index (v/n), element (v/c)
+ edges from ec00b75 (vertex names):
[1] 2 --3  3 --8  2 --11 11--21

[[6]]
IGRAPH ec00c12 UN-- 6 12 --
+ attr: name (v/c), label (v/c), index (v/n), element (v/c)
+ edges from ec00c12 (vertex names):
 [1] 1 --4  1 --6  4 --6  4 --7  1 --10 4 --10 6 --10 7 --10 1 --23 4 --23
[11] 6 --23 10--23

[[7]]
IGRAPH ec00c8f UN-- 7 8 --
+ attr: name (v/c), label (v/c), index (v/n), element (v/c)
+ edges from ec00c8f (vertex names):
[1] 2 --7  2 --11 4 --6  4 --7  4 --10 6 --10 7 --10 11--17

[[8]]
IGRAPH ec00d00 UN-- 7 8 --
+ attr: name (v/c), label (v/c), index (v/n), element (v/c)
+ edges from ec00d00 (vertex names):
[1] 2 --7  2 --11 4 --6  4 --7  4 --10 6 --10 7 --10 11--21

[[9]]
IGRAPH ec00d6a UN-- 7 10 --
+ attr: name (v/c), label (v/c), index (v/n), element (v/c)
+ edges from ec00d6a (vertex names):
 [1] 2 --7  2 --11 4 --6  4 --7  4 --10 4 --23 6 --10 6 --23 7 --10 10--23
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.