Сетевой анализ

class: center, middle, inverse, title-slide

.title[
# Сетевой анализ
]
.subtitle[
## Визуализация и анализ географических данных на языке R
]
.author[
### Тимофей Самсонов
]
.institute[
### МГУ имени Ломоносова, Географический факультет
]
.date[
### 2024-12-17
]

---

## Пакеты

Для выполнения кода данной лекции вам понадобятся следующие пакеты:

``` r
library(sf)
library(tidyverse)
library(classInt)
library(osrm)
library(mapsf)
library(sfnetworks)
library(tidygraph)
options(scipen = 999)
```

---

## Исходные данные

``` r
db = '../r-geo-course/data/moscow.gpkg'
roads = read_sf(db, "roads") # Дороги
poi = read_sf(db, "poi") # Точки интереса
rayons = read_sf(db, "districts") # Границы районов
stations = read_sf(db, "metro_stations") # Станции метро
water = read_sf(db, "water") # Водные объекты

frame = roads |>  
  st_bbox() |>
  st_as_sfc() |> 
  st_geometry()

poi_food = poi |>  
    select(NAME, AMENITY) |> 
    filter(AMENITY %in% c("restaurant", "bar", "cafe", "pub", "fast_food"))
```

---

## Картографическая основа

.pull-left[
.code-small[

``` r
stations$label = 'M'
basemap = function(add = FALSE) {
  if (add == FALSE) 
    mf_init(frame)
  mf_base(water, col = 'steelblue3', 
         add = TRUE)
  mf_base(roads, col = 'black', 
         add = T)
  mf_base(poi_food, cex = 0.5, 
         col = "deepskyblue4", 
         add = TRUE)
  mf_base(stations, 
       col = "slategray4", 
       pch = 20, 
       cex = 3, 
       add = TRUE)
  mf_label(stations,
   var = 'label',
   col = "white",
   cex = 0.7)
}
```
]
]
.pull-right[

``` r
basemap()
```

![](16_NetworkAnalysis_files/figure-html/unnamed-chunk-4-1.png)
]

---

## Зоны транспортной доступности

``` r
WGS84 = st_crs(4326) # Инициализируем WGS84, используемую в OSRM

UTM = st_crs(poi) # Система координат исходных точек

# Выбираем целевой объект
psel = poi |>  
  filter(NAME == "Центральный детский магазин" & SHOP == "toys")

psel_wgs = st_transform(psel, WGS84) # Преобразуем в WGS84

# Получаем 5-минутную зону транспортной доступности
service_area = osrmIsochrone(psel_wgs, breaks = 3)

# Преобразуем зону обратно в UTM для дальнейших операций
service_area_utm = st_transform(st_as_sf(service_area), UTM)

# Отбираем точки
selected_poi = poi_food[service_area_utm, ]
```

---

## Зоны транспортной доступности

.pull-left[

``` r
basemap()
mf_base(service_area_utm,
     col = adjustcolor(
       "violetred3", alpha.f = 0.2),
     border = "violetred3",
     add = TRUE)
mf_base(selected_poi , 
     col = "violetred3", 
     pch = 20, 
     cex = 0.5, 
     add = TRUE)
mf_base(psel |> st_geometry(), 
     col = "violetred4", 
     pch = 20, 
     cex = 4, 
     add = TRUE)
```
]

.pull-right[
![](16_NetworkAnalysis_files/figure-html/unnamed-chunk-6-1.png)
]

---

## Кратчайшие маршруты

``` r
# Выбираем и проецируем начальную точку
origin = poi |> filter(NAME == 'Молодая Гвардия')
origin_wgs = st_transform(origin, WGS84)
  
# Выбираем и проецируем конечную точку
destination = poi |> filter(NAME == 'Чебуречная "Дружба"')
destination_wgs = st_transform(destination, WGS84)

# Строим маршрут
route = osrmRoute(origin_wgs, 
                  destination_wgs, 
                  overview = "full") # без генерализации
# Преобразуем результат обратно в UTM
route_utm = st_transform(route, UTM)
origin$label = 'O'
destination$label = 'D'
```

---

## Кратчайшие маршруты

.pull-left[
.code-small[

``` r
basemap()
mf_base(route_utm, lwd = 3,
     col = "orange", add = TRUE)
mf_base(origin, col = "tomato3", 
     pch = 20, cex = 4, add = TRUE)
mf_base(destination, col = "tomato", 
     pch = 20, cex = 4, add = TRUE)
mf_label(origin, var = "label",
     col = "tomato4", cex = 0.5, 
     add = TRUE)
mf_label(destination, var = "label",
     col = "tomato4", cex = 0.7)
```
]
]

.pull-right[
![](16_NetworkAnalysis_files/figure-html/unnamed-chunk-8-1.png)
]

---

## Задача коммивояжёра

**Задача коммивояжера** --- определение оптимального маршрута объезда заданного множества точек

``` r
sber = poi |>  
  filter(OSM_ID %in% c(2298789061, 1705988219, 
                       1531266598, 916076946, 2043705976)) %>% 
  bind_cols(st_coordinates(x = .))

sber_wgs = st_transform(sber, WGS84)

route = osrmTrip(sber, overview = "full")[[1]]$trip |> 
  mutate(order = ordered(row_number()))
```

---

## Задача коммивояжёра

.pull-left[
.code-small[

``` r
ggplot() + 
  geom_sf(data = roads, 
          color = 'grey', linewidth = 0.25) +
  geom_sf(data = route, 
          mapping = aes(color = order), 
          linewidth = 2, alpha = 0.85) +
  geom_sf(data = sber, size = 5, 
          color = 'darkgreen', alpha = 0.85) +
  ggrepel::geom_label_repel(
    data = sber, 
    box.padding = 1,
    mapping = aes(X,Y, label = NAME), 
    size = 5
  ) +
  theme_void()
```
]
]

.pull-right[
![](16_NetworkAnalysis_files/figure-html/unnamed-chunk-10-1.png)
]

---

## Ближайший пункт обслуживания

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

.pull-left[

``` r
bars = poi_food |> 
 filter(AMENITY %in% c('bar', 'pub')) %>% 
  bind_cols(st_coordinates(x = .)) |> 
  dplyr::sample_n(100)

bars_wgs = st_transform(bars, WGS84)

odmatrix = osrmTable(src = bars_wgs, 
                     dst = sber_wgs, 
        osrm.profile	= 'foot')$durations
        # пешеходы
best = apply(odmatrix, 1, which.min)

```
]

.pull-right[

``` r
connects = st_sfc(
  lapply(seq_along(best), \(i) {
    st_linestring(
      rbind(
        c(bars$X[i], bars$Y[i]),
        c(sber$X[best[i]], sber$Y[best[i]])
      )
    )
  }),
  crs = UTM
)
```
]

---

## Ближайший пункт обслуживания

.pull-left[

``` r
ggplot() + 
  geom_sf(data = roads, color = 'grey', 
          linewidth = 0.25) +
  geom_sf(data = connects, linewidth = 1, 
          alpha = 0.85) +
  geom_sf(data = sber, size = 5, 
          color = 'darkgreen', 
          alpha = 0.85) +
  ggrepel::geom_label_repel(
    data = sber, box.padding = 1,
    mapping = aes(X,Y, label = NAME), 
    size = 5) +
  theme_void()
```
]

.pull-right[
![](16_NetworkAnalysis_files/figure-html/unnamed-chunk-13-1.png)
]

---

## Структурный анализ

.pull-left[
Готовый граф из пакета __sfnetworks__

``` r
net = as_sfnetwork(roxel)
autoplot(net)
```
]

.pull-right[
![](16_NetworkAnalysis_files/figure-html/unnamed-chunk-14-1.png)
]

---

## Структурный анализ

**Центральность по промежуточности** показывает количество маршрутов, проходящих через узел/ребро.

.pull-left[

``` r
net = net |> 
  activate("edges") |> 
  mutate(weight = edge_length(),
   bc = centrality_edge_betweenness())

ggplot() +
  geom_sf(data = st_as_sf(net, "edges"), 
          aes(col = bc, linewidth = bc)) +
  scale_color_viridis_c() +
  ggtitle("Центральность по промежуточности")
```
]

.pull-right[
![](16_NetworkAnalysis_files/figure-html/unnamed-chunk-15-1.png)
]

---

## Структурный анализ

**Центральность по близости** обратно пропорциональна сумме расстояний от вершины до остальных вершин.

.pull-left[
.code-small[

``` r
net = net |> 
  activate("nodes") |> 
  mutate(cc = 
   centrality_closeness(mode = 'all'))
nodes = st_as_sf(net, "nodes") |> 
  filter(cc < 1)
ggplot() +
  geom_sf(data = st_as_sf(net, "edges"), 
          col = "grey50") +
  geom_sf(data = nodes, 
          aes(fill = cc, size = cc), shape = 21) +
  scale_fill_viridis_c(option="magma") +
  scale_size(range = c(1.5, 4)) +
  guides(size = guide_legend(reverse=T)) +
  ggtitle("Центральность по близости")
```
]
]

.pull-right[
![](16_NetworkAnalysis_files/figure-html/unnamed-chunk-16-1.png)
]

---

## Структурный анализ

**Центральность по степени** показывает количество ребер, с которыми связана вершина. Локальная характеристика, которая показывает важность вершины в ее собственной окрестности

.pull-left[
.code-small[

``` r
net = net |> 
  activate("nodes") |> 
  mutate(dc = centrality_degree(mode = 'total'))

ggplot() +
  geom_sf(data = st_as_sf(net, "edges"), col = "grey50") +
  geom_sf(data = st_as_sf(net, "nodes"), 
          aes(fill = dc, size = dc), shape = 21) +
  scale_fill_viridis_c(option="magma") +
  scale_size(range = c(1.5, 4)) +
  guides(size = guide_legend(reverse=T)) +
  theme_void()
```
]
]

.pull-right[
![](16_NetworkAnalysis_files/figure-html/unnamed-chunk-17-1.png)
]

---

## Структурный анализ

**Центральность по влиятельности** показывает сумму степеней вершин, с которыми связана текущая вершина. Позволяет выделить области графа, в которых наблюдается сложная топология сети

.pull-left[
.code-small[

``` r
net = net |> 
  activate("nodes") |> 
  mutate(ec = centrality_eigen())

ggplot() +
  geom_sf(data = st_as_sf(net, "edges"), col = "grey50") +
  geom_sf(data = st_as_sf(net, "nodes"), 
          aes(fill = ec, size = ec), shape = 21) +
  scale_fill_viridis_c(option="magma") +
  scale_size(range = c(1.5, 4)) +
  guides(size = guide_legend(reverse=T)) +
  theme_void()
```
]
]

.pull-right[
![](16_NetworkAnalysis_files/figure-html/unnamed-chunk-18-1.png)
]