Как написать функцию цикла для сетевого анализа после сбоя igraph

tidygraph может упростить некоторые (i) операции с графом, например, здесь мы могли бы преобразовать этот граф в список подграфов, разделенных на id. А затем получите свойства графа, такие как порядок, размер и взвешенный диаметр, а также атрибут края Program из подграфов.

library(igraph, warn.conflicts = FALSE)
library(tidygraph, warn.conflicts = FALSE)
library(dplyr, warn.conflicts = FALSE)

g_tbl <- 
  df |> 
  # igraph::diameter() will use "weights" edge attribute for weights
  rename(weight = dist) |> 
  # use df for edge list, "to" & "from" columns encode nodes
  tbl_graph(edges = _) |> 
  # remove 0-weight (dist) edges
  activate(edges) |> 
  filter(weight > 0) |> 
  # morph graph into a temporary list of subgraphs by "id" attribute
  morph(to_split, id, split_by = "edges") |> 
  # temp list of graphs to a nested tibble with tbl_graph objects
  crystallise() |> 
  # extract graph measures & attributes from subgraphs
  rowwise() |> 
  # outside of tbl_graph context it's bit more convenient to use igraph methods 
  mutate(across(graph, list(nodes = vcount, edges = ecount, netdiam = diameter))) |> 
  mutate(prog = edge_attr(graph, "Program")[1]) |> 
  ungroup()

Результат вложенных тибблов и подграфов:

g_tbl
#> # A tibble: 2 × 6
#>   name     graph      graph_nodes graph_edges graph_netdiam prog 
#>   <chr>    <list>           <dbl>       <dbl>         <dbl> <chr>
#> 1 id: 3811 <tbl_grph>           3           2          177. P1   
#> 2 id: 3832 <tbl_grph>           4           3          544. P1

g_tbl$graph
#> [[1]]
#> # A tbl_graph: 3 nodes and 2 edges
#> #
#> # A rooted tree
#> #
#> # Edge Data: 2 × 10 (active)
#>    from    to id    Program from_lon from_lat to_lon to_lat weight
#>   <int> <int> <chr> <chr>      <dbl>    <dbl>  <dbl>  <dbl>  <dbl>
#> 1     1     2 3811  P1          130.    -30.2   130.  -30.5   44.1
#> 2     2     3 3811  P1          130.    -30.5   130.  -29.6  133. 
#> # ℹ 1 more variable: .tidygraph_edge_index <int>
#> #
#> # Node Data: 3 × 2
#>   name  .tidygraph_node_index
#>   <chr>                 <int>
#> 1 hill                      1
#> 2 town                      2
#> 3 lake                      3
#> 
#> [[2]]
#> # A tbl_graph: 4 nodes and 3 edges
#> #
#> # A rooted tree
#> #
#> # Edge Data: 3 × 10 (active)
#>    from    to id    Program from_lon from_lat to_lon to_lat weight
#>   <int> <int> <chr> <chr>      <dbl>    <dbl>  <dbl>  <dbl>  <dbl>
#> 1     1     4 3832  P1          130.    -30.2   131.  -31.3   161.
#> 2     4     3 3832  P1          131.    -31.3   130.  -29.6   250.
#> 3     3     2 3832  P1          130.    -29.6   130.  -30.5   133.
#> # ℹ 1 more variable: .tidygraph_edge_index <int>
#> #
#> # Node Data: 4 × 2
#>   name  .tidygraph_node_index
#>   <chr>                 <int>
#> 1 hill                      1
#> 2 town                      2
#> 3 lake                      3
#> # ℹ 1 more row

Подграфики сюжета:

par(mfcol = c(1,2))
purrr::pwalk(g_tbl, \(name, graph, ...) plot(graph, vertex.size=50, edge.label = edge_attr(graph, "weight"), edge.label.dist = 0.5,main = name))

В качестве альтернативы вы можете сначала разделить набор данных на id и использовать lapply() или purrr::map() в полученном списке для создания графиков и извлечения деталей. Должно лучше масштабироваться для больших наборов данных, поскольку приходится иметь дело с меньшими графиками, оттуда также легко переключиться на параллельное выполнение, например. furrr::future_map().

# helper to build a graph and extract details, return single-row tibble
graph_measures <- function(edge_df){
  g <- 
    edge_df |> 
    tbl_graph(edges = _) |> 
    activate(edges) |> 
    filter(weight > 0)

  tibble(
    prog    = edge_attr(g, "Program")[1],
    nodes   = vcount(g), 
    edges   = ecount(g), 
    netdiam = diameter(g)
  )
}

# split by id, apply graph_measures() on each resulting list item,
# bind rows and use list names for id column
df |> 
  rename(weight = dist) |> 
  split(~id) |> 
  purrr::map(graph_measures) |> 
  purrr::list_rbind(names_to = "id")
#> # A tibble: 2 × 5
#>   id    prog  nodes edges netdiam
#>   <chr> <chr> <dbl> <dbl>   <dbl>
#> 1 3811  P1        3     2    177.
#> 2 3832  P1        4     3    544.

Пример данных:

df <- data.frame(id = c("3811","3811","3832","3832","3832","3832"),
                 Program = c("P1","P1","P1","P1","P1","P1"),
                 from = c("hill","town","hill","wood","wood","lake"),
                 from_lon = c(130.2,130.5,130.2,131.3,131.3,129.6),
                 from_lat = c(-30.2,-30.5,-30.2,-31.3,-31.3,-29.6),
                 to = c("town","lake","wood","wood","lake","town"),
                 to_lon = c(130.5,129.6,131.3,131.3,129.6,130.5),
                 to_lat = c(-30.5,-29.6,-31.3,-31.3,-29.6,-30.5),
                 dist = c(44.111,132.506,161.456,0,249.847,132.506))

Возможно, вы можете попробовать igraph, как показано ниже.

df %>%
    mutate(
        from_coord = paste0(from_lon, ",", from_lat),
        to_coord = paste0(to_lon, ",", to_lat)
    ) %>%
    select(from_coord, to_coord, id, Program, dist) %>%
    filter(from_coord != to_coord) %>%
    group_split(id) %>%     
    map(~{
        g <- graph_from_data_frame(.x)
        data.frame(
            id = .x$id[1],
            prog = .x$Program[1],
            nodes = vcount(g),
            netdiam = diameter(g, weights = E(g)$dist),
            edges = ecount(g)
        )
    }) %>%
    bind_rows()

который дает

    id prog nodes netdiam edges
1 3811   P1     3 176.617     2
2 3832   P1     4 543.809     3