[R-iGraph-Sfnetwork]: Можно ли оптимизировать этот код для установки нового веса в SfNetwork/iGraph

Question

Профилируя свой код, я обнаружил, что та часть, которая задает новый вес на графике,
выполняется дольше всего.
Поскольку мне приходится делать это неоднократно на гораздо большем графике, чем в этом примере, время работы увеличивается.
Можно ли его оптимизировать?

Вот мини-пример:

      library(sfnetworks)
library(sf)

Сначала я создаю пример sf_network (iGraph):

      net = as_sfnetwork(roxel, directed = FALSE) %>%
  st_transform(3035) %>%
  activate("edges") %>%
  mutate(weight = edge_length())

Затем я выбираю два узла и ищу путь между ними:

      paths = st_network_paths(net, from = 495, to = c(458, 121), weights = "weight")

Я выбираю путь (его края) и:

      edges<-unlist(paths$edge_paths[1])

Эта часть занимает больше всего времени для выполнения, и, если возможно, я хотел бы оптимизировать:
прочитать текущий вес ребер, умножить его на 100 и установить новый вес для ребер.

      my_sfn<-set.edge.attribute(graph = net,name = "weight",index = edges,value =  (get.edge.attribute(graph = net,name = "weight",index = edges))*100)

Можно ли оптимизировать эту часть?

#обновлять:

Один из подходов, о котором я думаю, - это, возможно, сделать это параллельно:
в основном разделить вектор ребер на разные процессоры и работать с ним,
но проблема в том, что; в результате я получил бы список графиков.

Например:

края содержат индексы 456,432,124,567,854,235,789,111... (гипотетически) Я бы разделил список на 2 и сделал бы mlapply в сети sfn.

CPU1 -> применить -> 456432124567 в сети sfn -> приводит к копии сети с весом 456432124567 измененных ребер
CPU2 -> применить -> 854235789111 в сети sfn -> приводит к копии сети с весом 854235789111 края изменены

Или еще один подход, о котором я думал: sfnet - это tbl_graph, верно? я не могу использовать как future_apply на этом tbl_graph?

##обновлять

Parallel, похоже, не приносит улучшения в этом случае:

      library(microbenchmark)
library(parallel)

edges_chunks<-split(edges, ceiling(seq_along(edges)/(length(edges)/4)))

microbenchmark::microbenchmark(
new_net<-set.edge.attribute(graph = net,name = "weight",index = edges,value =  10000),
new_net_list<-lapply(edges_chunks, function(x)set.edge.attribute(graph = net,name = "weight",index = x,value =  10000)),
new_net_list<-mclapply(edges_chunks, function(x)set.edge.attribute(graph = net,name = "weight",index = x,value =  10000), mc.preschedule=TRUE,mc.cores = n.cores)
)


      min         lq       mean     median         uq        max neval
    750.120    887.842   1061.393   1036.850   1176.605   1769.066   100
   3111.609   3609.785   4086.067   4002.368   4435.135   7891.939   100
 204809.249 208559.875 213134.374 209879.946 211954.072 320525.229   100

Спасибо.

ОБНОВЛЯТЬ

Привет Андреа!

спасибо, что нашли время ответить на мой вопрос.

Я посмотрел на это, и преимущество подхода igraph исчезает, как только мне приходится работать с координатами GPS вместо самих индексов.

Я проверил код SF_Network, чтобы увидеть, как вы это делаете (найти индексы для координаты GPS), и сделал этот тест.

Замедление, кажется, происходит в той части, где мне нужно сопоставить координату GPS с индексами, которые необходимы для поиска кратчайшего пути.

Поэтому, чтобы увеличить скорость, я должен найти способ ускорить сопоставление координат с индексами.

      library(sfnetworks)
library(sf)
library(tidygraph)
library(tidyverse)
library(igraph)


my_sfn = as_sfnetwork(roxel, directed = FALSE) %>%
  st_transform(4326) %>%
  activate("edges") %>%
  mutate(weight = edge_length())


start_lon<-7.572567248901512 
start_lat<-51.92503522221193 


ziel_lon<-7.68342049920836 
ziel_lat<-52.00488468255698

start_point = st_sfc(st_point(c(start_lon, start_lat)))
start_point<-start_point |> st_set_crs(4326)

dest_point = st_sfc(st_point(c(ziel_lon, y = ziel_lat)))
dest_point<-dest_point |> st_set_crs(4326)


node_geom_colname = function(x) {
  col = attr(vertex_attr(x), "sf_column")
  if (is.null(col)) {
    # Take the name of the first sfc column.
    sfc_idx = which(vapply(vertex_attr(x), is.sfc, FUN.VALUE = logical(1)))[1]
    col = vertex_attr_names(x)[sfc_idx]
  }
  col
}

valid_agr = function(agr, names, levels = sf:::agr_levels) {
  if (is.null(agr)) {
    new_agr = empty_agr(names)
  } else {
    new_agr = structure(agr[names], names = names, levels = levels)
  }
  new_agr
}

node_feature_attribute_names = function(x) {
  g_attrs = node_attribute_names(x)
  g_attrs[g_attrs != node_geom_colname(x)]
}


node_attribute_names = function(x) {
  vertex_attr_names(x)
  
}
node_agr = function(x) {
  agr = attr(vertex_attr(x), "agr")
  valid_agr(agr, node_feature_attribute_names(x))
}

nodes_as_sf = function(x, ...) {
  st_as_sf(
    as_tibble(as_tbl_graph(x), "nodes"),
    agr = node_agr(x),
    sf_column_name = node_geom_colname(x)
  )
}

weight <- edge_attr(my_sfn, "weight")


bench::mark(
  sfnetworks = {
    path1_sfn <- st_network_paths(my_sfn, from = st_nearest_feature(st_geometry(start_point), nodes_as_sf(my_sfn)), to = st_nearest_feature(st_geometry(dest_point), nodes_as_sf(my_sfn)), weights = "weight")
    edges <- path1_sfn$edge_paths[[1]]
    my_sfn_2 <- set_edge_attr(
      graph = my_sfn, 
      name = "weight", 
      index = edges, 
      value = edge_attr(my_sfn, "weight", edges) * 100
    )
    path2_sfn <- st_network_paths(my_sfn_2, from = st_nearest_feature(st_geometry(start_point), nodes_as_sf(my_sfn_2)), to = st_nearest_feature(st_geometry(dest_point), nodes_as_sf(my_sfn_2)), weights = "weight")
    path2_sfn$node_paths[[1]]
  }, 
  igraph = {
    weight <- edge_attr(my_sfn, "weight")
    path <- shortest_paths(my_sfn, from = st_nearest_feature(st_geometry(start_point), nodes_as_sf(my_sfn)), to = st_nearest_feature(st_geometry(dest_point), nodes_as_sf(my_sfn)), weights = weight, output = "both")
    weight[path$epath[[1]]] <- weight[path$epath[[1]]] * 100
    path <- shortest_paths(my_sfn, from = st_nearest_feature(st_geometry(start_point), nodes_as_sf(my_sfn)), to = st_nearest_feature(st_geometry(dest_point), nodes_as_sf(my_sfn)), weights = weight, output = "vpath")
    as.integer(path$vpath[[1]])
  }, 
  iterations = 15L
)

Результат

      # A tibble: 2 × 13
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result     memory     time       gc      
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list>     <list>     <list>     <list>  
1 sfnetworks   37.2ms   38.3ms      26.2    2.08MB     4.02    13     2      497ms <int [37]> <Rprofmem> <bench_tm> <tibble>
2 igraph       35.8ms   36.2ms      27.5    1.31MB     4.23    13     2      473ms <int [37]> <Rprofmem> <bench_tm> <tibble>

Answer 1

Я попытаюсь обобщить здесь один пример, а также несколько идей, которые могут быть полезны для повышения вычислительной эффективности вашего кода. Сначала загрузите несколько пакетов

      suppressPackageStartupMessages({
  library(sf)
  library(tidygraph)
  library(igraph)
  library(sfnetworks)
})

Следующий код создает игрушечную сеть с 1e5 узлами и примерно 7e5 ребрами. Я не тестировал код с более крупными сетями.

      set.seed(1)
my_graph <- play_geometry(n = 100000, radius = 0.0066)
my_sfn <- as_sfnetwork(my_graph, coords = c("x", "y")) %>% 
  convert(to_spatial_explicit, .clean = TRUE) %E>% 
  mutate(weight = edge_length())
#> Checking if spatial network structure is valid...
#> Spatial network structure is valid

Теперь попробуем воспроизвести код, который вы показали, с помощью sfnetworks + igraph. Сначала мы вычисляем кратчайший путь между узлами 495 и 458.

      path1_sfn <- st_network_paths(my_sfn, from = 495, to = 458, weights = "weight")

Проверим вывод (и, в частности, путь узла)

      edges <- path1_sfn$edge_paths[[1]]
(path1_sfn$node_paths[[1]])
#>  [1] 495 336 399 506 558 621 667 898 903 647 493 392 256 185 248 439 380 458

Следующий код умножает веса соответствующих ребер на 100.

      my_sfn <- set_edge_attr(
  graph = my_sfn, 
  name = "weight", 
  index = edges, 
  value = edge_attr(my_sfn, "weight", edges) * 100
)

и, наконец, пересчитываем кратчайший путь между узлами 495 и 458.

      path2_sfn <- st_network_paths(my_sfn, from = 495, to = 458, weights = "weight")

и проверьте вывод

      path2_sfn$node_paths[[1]]
#>  [1] 495 288 336 249 506 538 621 649 881 898 977 970 831 619 750 535 587 439 300
#> [20] 380 481 458

Теперь восстанавливаем исходные веса и повторяем те же операции, что и раньше, используя только код igraph.

      my_sfn <- my_sfn %E>% mutate(weight = edge_length())

0. Извлеките веса

      weight <- edge_attr(my_sfn, "weight")

1. Вычислите кратчайший путь между узлами 495 и 458.

      path <- shortest_paths(my_sfn, from = 495, to = 458, weights = weight, output = "both")

2. Проверьте вывод, чтобы убедиться, что мы извлекаем те же узлы, что и раньше.

      as.integer(path$vpath[[1]])
#>  [1] 495 336 399 506 558 621 667 898 903 647 493 392 256 185 248 439 380 458

3. Отрегулируйте веса

      weight[path$epath[[1]]] <- weight[path$epath[[1]]] * 100

4. Вычислить кратчайший путь

      path <- shortest_paths(my_sfn, from = 495, to = 458, weights = weight, output = "vpath")

5. Проверить снова

      as.integer(path$vpath[[1]])
#>  [1] 495 288 336 249 506 538 621 649 881 898 977 970 831 619 750 535 587 439 300
#> [20] 380 481 458

Восстановите исходный результат и оцените два подхода:

      my_sfn <- my_sfn %E>% mutate(weight = edge_length())

bench::mark(
  sfnetworks = {
    path1_sfn <- st_network_paths(my_sfn, from = 495, to = 458, weights = "weight")
    edges <- path1_sfn$edge_paths[[1]]
    my_sfn_2 <- set_edge_attr(
      graph = my_sfn, 
      name = "weight", 
      index = edges, 
      value = edge_attr(my_sfn, "weight", edges) * 100
    )
    path2_sfn <- st_network_paths(my_sfn_2, from = 495, to = 458, weights = "weight")
    path2_sfn$node_paths[[1]]
  }, 
  igraph = {
    weight <- edge_attr(my_sfn, "weight")
    path <- shortest_paths(my_sfn, from = 495, to = 458, weights = weight, output = "both")
    weight[path$epath[[1]]] <- weight[path$epath[[1]]] * 100
    path <- shortest_paths(my_sfn, from = 495, to = 458, weights = weight, output = "vpath")
    as.integer(path$vpath[[1]])
  }, 
  iterations = 15L
)
#> Warning: Some expressions had a GC in every iteration; so filtering is disabled.
#> # A tibble: 2 x 6
#>   expression      min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 sfnetworks    1.34s    2.85s     0.355   117.2MB     1.11
#> 2 igraph     135.91ms 280.26ms     2.52     37.1MB     1.35

^{Создано 03 сентября 2022 г. с использованием репрекса версии 2.0.2.}

Всего два заключительных замечания:

1. Как мы видим, код «чистого igraph» намного быстрее, чем комбинация двух пакетов (и это неудивительно, sfnetworks — это просто обертка над igraph). Поэтому, если вам действительно нужно сосредоточиться на вычислительной эффективности, я бы предложил использовать sfnetworks только для самого минимума (например, as_sfnetwork + некоторый морфер предварительной обработки) и запускать любой алгоритм кратчайшего пути с чистым кодом igraph;
2. Тем не менее, код igraph немного более многословен и требует немного большей предварительной обработки и внимательности. Возможно, вам придется что-то заново адаптировать, прежде чем вы сможете перевести свой код sfnetwork в чистый код igraph.