Анализ графов с использованием «tidyverse»
2019-03-06
by Edgar Ruiz
Хоть я и не эксперт по анализу графов, но я подумал,
что очень важно все же написать эту статью. Для тех, кто разбирается в терминах
отдельных прямоугольных массивов данных, это что-то вроде «интеллектуального
скачка» для понимания того, как правильно применять принципы функции tidy
к более сложному объекту, такому, например, как таблица. К счастью, есть два
пакета, которые значительно облегчают эту работу:
- tidygraph
- предоставляет способ взаимодействия dplyr с графами.
- ggraph
- расширение до ggplot2
для анализа графов.
Краткое введение
Проще говоря, теория графов изучает связи между
объектами в группе. Визуально мы можем представить граф как серию
взаимосвязанных точек, каждая из которых представляет участника группы,
например, людей в социальной сети. Линии, нарисованные между точками,
представляют связь между участниками, например, дружбу в социальной сети.
Анализ графов помогает выявить такие вещи, как влияние определенного
участника на остальных, или то, у кого больше друзей из двух участников группы.
Более правильное определение и подробное объяснение теории графов можно найти в
Википедии здесь.
Пример
На примере этой статьи будут показаны концепции работы
по анализу графов, а также то, как для такого анализа могут использоваться смежные
инструменты tidyverse.
Источник данных
Еженедельный проект «Tidytuesday»
призывает как новичков, так и опытных пользователей использовать инструменты tidyverse для анализа наборов данных, которые меняются каждую
неделю. Я использовал эту возможность для освоения новых инструментов и методов.
Один из самых свежих наборов данных касается французских поездов; он содержит количество
ежедневных поездок от станции до станции.
library(readr)
url <-
"https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-02-26/small_trains.csv"
small_trains <- read_csv(url)
head(small_trains)
# A tibble: 6 x 13
year month
service departure_stati~ arrival_station journey_time_avg total_num_trips
avg_delay_all_d~ avg_delay_all_a~ num_late_at_dep~
<dbl>
<dbl> <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
1 2017 9 Nation~ PARIS EST METZ 85.1 299 0.752 0.420 15
2 2017 9 Nation~ REIMS PARIS EST 47.1 218 1.26 1.14 10
3 2017 9 Nation~ PARIS EST STRASBOURG 116. 333 1.14 1.59 20
4 2017 9 Nation~ PARIS LYON AVIGNON TGV 161. 481 1.41 4.79 36
5 2017 9 Nation~ PARIS LYON BELLEGARDE (AI~ 164. 190 1.73 6.01 16
6 2017 9 Nation~ PARIS LYON BESANCON FRANC~ 129. 191 1.84 5.03 18
# ... with 3 more variables: num_arriving_late <dbl>,
delay_cause <chr>, delayed_number <dbl>
Подготовка данных
Хоть это изначально и предназначалось для анализа
задержек поездов, я подумал, что было бы интересно использовать данные, для
того чтобы понять, как станции соединены друг с другом. Создается новый сводный
набор данных, называемый маршрутами, в котором каждая станция
содержится лишь один раз. Он также включает в себя среднее время в пути,
необходимое для того чтобы доехать от одной станции до другой.
library(dplyr)
routes <- small_trains %>%
group_by(departure_station, arrival_station) %>%
summarise(journey_time =
mean(journey_time_avg)) %>%
ungroup() %>%
mutate(from
= departure_station,
to =
arrival_station) %>%
select(from, to, journey_time)
routes
# A tibble: 130 x 3
from to journey_time
<chr> <chr> <dbl>
1 AIX EN
PROVENCE TGV PARIS LYON 186.
2 ANGERS SAINT
LAUD PARIS MONTPARNASSE 97.5
3
ANGOULEME PARIS
MONTPARNASSE 146.
4 ANNECY PARIS LYON 225.
5 ARRAS PARIS NORD 52.8
6 AVIGNON
TGV PARIS LYON 161.
7
BARCELONA PARIS
LYON 358.
8 BELLEGARDE
(AIN) PARIS LYON 163.
9 BESANCON
FRANCHE COMTE TGV PARIS LYON
131.
10 BORDEAUX ST JEAN PARIS MONTPARNASSE 186.
# ...
with 120 more rows
Следующим шагом является преобразование набора данных
в графическую таблицу. Чтобы подготовить маршруты для преобразования, этот
набор данных должен содержать две переменные под названием from (от)
и to (к), которые tidygraph ожидает увидеть. Эти переменные должны содержать названия
каждой станции (например, станция «AIX
EN PROVENCE
TGV») и их связь (станция «AIX EN
PROVENCE TGV» -> станция «PARIS LYON»).
В графической терминологии член группы называется
узлом (или вершиной) на графе, а связь между узлами - ребром.
library(tidygraph)
graph_routes <- as_tbl_graph(routes)
graph_routes
# A tbl_graph: 59 nodes and 130 edges
#
# A directed simple graph with 1 component
#
# Node Data: 59 x 1 (active)
name
<chr>
1 AIX EN PROVENCE TGV
2 ANGERS SAINT LAUD
3 ANGOULEME
4 ANNECY
5 ARRAS
6 AVIGNON TGV
# ... with 53 more rows
#
# Edge Data: 130 x 3
from to journey_time
<int> <int> <dbl>
1 1 39 186.
2 2 40 97.5
3 3 40 146.
# ... with 127 more rows
Функция as_tbl_graph()
разбивает маршруты на две части:
·
данные узла -
содержит все уникальные значения, найденные в переменных from и to. В данном случае
это таблица с одним столбцом, содержащая названия всех станций.
·
данные ребра - это
таблица со всеми связями между from и to. Особенность tidygraph состоит в том,
что он использует позицию строки узла в качестве идентификатора для for
и to вместо его исходного имени.
Еще одна интересная особенность tidygraph состоит в том, что
он позволяет нам прикрепить дополнительную информацию об узле или ребре в новый
столбец. В этом случае для создания графической таблицы не требуется journey_time, но оно может понадобиться для анализа, который мы планируем
сделать. Функция as_tbl_graph()
автоматически создала для нас столбец.
Представление graph_routes
в качестве двух столбцов внутри большой графической таблицы было одним из двух
главных ментальных прорывов, которые произошли во мне во время решения этой
задачи. В этот момент стало очевидно, что dplyr
нуждается в том, чтобы узнать, в какой из двух таблиц (узлов или ребер) надо выполнить
преобразования. В tidygraph это делается с помощью функции activ(). Чтобы продемонстрировать это, таблица узлов будет
«активирована» для добавления двух новых строковых переменных, полученных из name.
library(stringr)
graph_routes <- graph_routes %>%
activate(nodes) %>%
mutate(
title = str_to_title(name),
label = str_replace_all(title, " ", "\n")
)
graph_routes
# A tbl_graph: 59 nodes and 130 edges
#
# A directed simple graph with 1 component
#
# Node Data: 59 x 3 (active)
name title label
<chr> <chr> <chr>
1 AIX EN PROVENCE TGV Aix En Provence Tgv "Aix\nEn\nProvence\nTgv"
2 ANGERS SAINT LAUD Angers Saint Laud "Angers\nSaint\nLaud"
3 ANGOULEME Angouleme Angouleme
4 ANNECY Annecy Annecy
5 ARRAS Arras Arras
6 AVIGNON TGV Avignon Tgv "Avignon\nTgv"
# ... with 53 more rows
#
# Edge Data: 130 x 3
from to journey_time
<int> <int> <dbl>
1 1 39 186.
2 2 40 97.5
3 3 40 146.
# ... with 127 more rows
Действительно впечатляюще то, как легко было
манипулировать графической таблицей, потому что после активации одной из двух
таблиц все изменения можно вносить с помощью инструментов tidyverse. Тот же подход можно использовать для извлечения
данных из графической таблицы. В этом случае список всех станций выводится в
один символьный вектор.
stations <- graph_routes %>%
activate(nodes) %>%
pull(title)
stations
[1] "Aix En Provence Tgv" "Angers Saint Laud" "Angouleme" "Annecy"
[5] "Arras" "Avignon Tgv" "Barcelona" "Bellegarde (Ain)"
[9] "Besancon Franche Comte Tgv" "Bordeaux St Jean" "Brest" "Chambery Challes Les Eaux"
[13] "Dijon Ville" "Douai" "Dunkerque" "Francfort"
[17] "Geneve" "Grenoble" "Italie" "La Rochelle Ville"
[21] "Lausanne" "Laval" "Le Creusot Montceau Montchanin" "Le Mans"
[25] "Lille" "Lyon Part Dieu" "Macon Loche" "Madrid"
[29] "Marne La Vallee" "Marseille St Charles" "Metz" "Montpellier"
[33] "Mulhouse Ville" "Nancy" "Nantes" "Nice Ville"
[37] "Nimes" "Paris Est" "Paris Lyon" "Paris Montparnasse"
[41] "Paris Nord" "Paris Vaugirard" "Perpignan" "Poitiers"
[45] "Quimper" "Reims" "Rennes" "Saint Etienne Chateaucreux"
[49] "St Malo" "St Pierre Des Corps" "Strasbourg" "Stuttgart"
[53] "Toulon" "Toulouse Matabiau" "Tourcoing" "Tours"
[57] "Valence Alixan Tgv" "Vannes" "Zurich"
Визуализация
На графах абсолютная позиция каждого узла не так
важна, как в других видах визуализации. Минималистичный ggplot2 настроен так,
чтобы было легче просматривать построенный граф.
library(ggplot2)
thm <- theme_minimal() +
theme( legend.position = "none", axis.title = element_blank(), axis.text = element_blank(), panel.grid = element_blank(), panel.grid.major = element_blank(), ) theme_set(thm) |
|
Для создания графа, начните с ggraph() вместо ggplot2().
Пакет ggraph содержит geoms, они уникальны для анализа графов. Пакет содержит geoms для точного построения узлов, а
другие geoms - для ребер.
Для первой базовой проверки будет использован точечный
geom, но вместо вызова geom_point() мы вызываем geom_node_point(). Ребра строятся с использованием
geom_edge_diagonal().
library(ggraph)
graph_routes %>%
ggraph(layout = "kk")
geom_node_point()
geom_edge_diagonal()
Чтобы упростить просмотр местоположения каждой станции
на этом графе, используется geom_node_text().
Как и в случае с обычными geoms в ggplot2,
другие атрибуты, такие, как: размер, цвет и первый член ряда, могут быть
изменены.
graph_routes %>%
ggraph(layout = "kk") +
geom_node_text(aes(label = label, color = name), size = 3) +
geom_edge_diagonal(color = "gray", alpha = 0.4)
Время morph`инга!
Вторым ментальным прорывом было понимание того, как
применяется графический алгоритм. Как правило, выходные данные функции модели
являются объектом модели, а не объектом данных. С tidygraph процесс
начинается и заканчивается графической таблицей. Шаги следующие:
1.
Начните с
графической таблицы.
2.
Временно
преобразуйте граф, чтобы он соответствовал запрашиваемой модели (morph()).
3.
Сделайте
дополнительные преобразования к преобразованным данным, используя dplyr
(необязательно).
4.
Восстановите
исходную графическую таблицу, но сохраните изменения, сделанные во время
преобразования.
Алгоритм кратчайшего пути определяет «длину» как
количество ребер между двумя узлами. Может быть несколько маршрутов из точки A в точку B, но алгоритм
выбирает тот, который имеет наименьшее количество «скачков». Способ вызова
алгоритма находится внутри функции morph(). Даже если to_shortest_path() сама по себе является функцией, и ее можно запустить
без morph(), она не предназначена для использования таким
образом. В этом примере в качестве weights используется journey_time, чтобы помочь алгоритму найти оптимальный маршрут
между станциями Arras и Nancy. Выведенный на экран граф не будет похож на
исходную графическую таблицу.
from <- which(stations == "Arras")
to <- which(stations == "Nancy")
shortest <- graph_routes %>%
morph(to_shortest_path, from, to, weights = journey_time)
shortest
# A tbl_graph temporarily morphed to a shortest path
representation
#
# Original graph is a directed simple graph with 1
component
#
consisting of 59 nodes and 130 edges
Можно сделать больше преобразований с помощью функций activ() и dplyr.
Результаты можно предварительно просмотреть или зафиксировать обратно в
исходную переменную R с помощью unmorph(). По умолчанию
узлы активны на преобразованном графе, поэтому нет необходимости еще раз это
упоминать.
shortest %>%
mutate(selected_node
= TRUE) %>%
unmorph()
# A tbl_graph: 59 nodes and 130 edges
#
# A directed simple graph with 1 component
#
# Node Data: 59 x 4 (active)
name title label selected_node
<chr> <chr> <chr> <lgl>
1 AIX EN PROVENCE TGV Aix En Provence Tgv
"Aix\nEn\nProvence\nTgv" NA
2 ANGERS SAINT LAUD
Angers Saint Laud
"Angers\nSaint\nLaud"
NA
3 ANGOULEME
Angouleme Angouleme NA
4 ANNECY
Annecy Annecy NA
5 ARRAS
Arras Arras TRUE
6 AVIGNON TGV
Avignon Tgv
"Avignon\nTgv"
NA
# ... with 53 more rows
#
# Edge Data: 130 x 3
from to journey_time
<int>
<int> <dbl>
1 1
39 186.
2 2
40 97.5
3 3
40 146.
# ...
with 127 more rows
В то время как происходило преобразование, были
выбраны только несколько узлов, которые составляют связи между станциями Arras и Nansy. Довольно простой
mutate() добавляет новую переменную selected_node, которая помечает эти узлы
TRUE. Новая переменная и значение сохраняются после восстановления остальных
узлов с помощью команды unmorph().
Чтобы сохранить изменения, самая короткая переменная
обновляется изменениями, внесенными как для ребер, так и для узлов.
shortest <- shortest %>%
mutate(selected_node = TRUE) %>%
activate(edges) %>%
mutate(selected_edge = TRUE) %>%
unmorph()
Следующим шагом является приведение каждого NA в 1, а кратчайший маршрут - в 2. Это позволит нам
легко изменить порядок расположения ребер на графе, гарантируя, что маршрут
будет нарисован сверху.
shortest <- shortest %>%
activate(nodes)
%>%
mutate(selected_node
= ifelse(is.na(selected_node), 1, 2)) %>%
activate(edges)
%>%
mutate(selected_edge
= ifelse(is.na(selected_edge), 1, 2)) %>%
arrange(selected_edge)
shortest
# A tbl_graph: 59 nodes and 130 edges
#
# A directed simple graph with 1 component
#
# Edge Data: 130 x 4 (active)
from to journey_time selected_edge
<int>
<int> <dbl> <dbl>
1 1 39
186. 1
2 2 40
97.5 1
3 3 40
146. 1
4 4 39
225. 1
5 6 39
161. 1
6 7 39
358. 1
# ... with 124 more rows
#
# Node Data: 59 x 4
name title label selected_node
<chr> <chr> <chr> <dbl>
1 AIX EN PROVENCE TGV Aix En Provence Tgv
"Aix\nEn\nProvence\nTgv"
1
2 ANGERS SAINT LAUD
Angers Saint Laud
"Angers\nSaint\nLaud" 1
3 ANGOULEME
Angouleme Angouleme 1
# ... with 56 more rows
Простой способ составить маршрут - использовать selected_variables для изменения первого члена ряда. Это позволит
выделить кратчайший путь без полного удаления других станций. То, как все это
строить - личный выбор каждого, поэтому всегда рекомендуется экспериментировать
с различными способами выделения результатов.
shortest %>%
ggraph(layout
= "kk") +
geom_edge_diagonal(aes(alpha
= selected_edge), color = "gray") +
geom_node_text(aes(label = label, color =name, alpha = selected_node
), size = 3)
|
selected_fields
могут также использоваться в других функциях dplyr для анализа результатов. Например, чтобы узнать совокупную
информацию о поездке, selected_edge
используется для фильтрации ребер, а затем можно уже рассчитать итоговые
значения. Для графических таблиц нет функции summarise(); и это имеет смысл, так как графическая таблица
станет сводной таблицей с такой функцией. Поскольку конечный результат, который
мы ищем, представляет собой итоговую сумму, а не другую графическую таблицу,
простая команда as_tibble() приведет
к появлению ребер, что позволит нам завершить вычисление.
shortest
%>%
ggraph(layout = "kk") +
geom_edge_diagonal(aes(alpha =
selected_edge), color = "gray") +
geom_node_text(aes(label = label, color
=name, alpha = selected_node ), size = 3)
shortest
%>%
activate(edges) %>%
filter(selected_edge == 2) %>%
as_tibble() %>%
summarise(
total_stops = n() - 1,
total_time = round(sum(journey_time) /
60)
)
# A tibble: 1 x
2
total_stops total_time
<dbl> <dbl>
1 8 23
|
Повторное использование кода
Чтобы скомпилировать большую часть кода в одном
фрагменте, вот пример того, как повторно запустить кратчайший путь для другого
набора станций: станции Laval и Montpellier.
from <- which(stations ==
"Montpellier")
to <-
which(stations == "Laval")
shortest <- graph_routes %>%
morph(to_shortest_path,
from, to, weights = journey_time) %>%
mutate(selected_node
= TRUE) %>%
activate(edges)
%>%
mutate(selected_edge
= TRUE) %>%
unmorph()
%>%
activate(nodes)
%>%
mutate(selected_node
= ifelse(is.na(selected_node), 1, 2)) %>%
activate(edges)
%>%
mutate(selected_edge
= ifelse(is.na(selected_edge), 1, 2)) %>%
arrange(selected_edge)
shortest %>%
ggraph(layout
= "kk") +
geom_edge_diagonal(aes(alpha
= selected_edge), color = "gray") +
geom_node_text(aes(label
= label, color =name, alpha = selected_node ), size = 3)
Кроме того, один и тот же код может быть переработан
для получения обобщенных данных о поездке.
shortest %>%
activate(edges) %>%
filter(selected_edge == 2) %>%
as_tibble() %>%
summarise(
total_stops = n() - 1,
total_time = round(sum(journey_time) / 60)
)
# A tibble: 1 x 2
total_stops
total_time
<dbl> <dbl>
1 3 10
Приложение Shiny
Чтобы увидеть, как использовать этот вид анализа в Shiny,
пожалуйста, обратитесь к этомуприложению. Оно позволяет
пользователю выбрать две станции и возвращает маршрут, а также суммированные
данные. Исходный код встроен в приложение.
Комментариев нет:
Отправить комментарий