Условная установка атрибутов ребер в графах со списками и столбцами с использованием R igraph и dplyr (purrr)

У меня есть фрейм данных с серией объектов igraph в формате столбца списка. Я бы хотел условно установить атрибут цвета края.

Я включил dput вывод для демонстрационной версии фактического фрейма данных (очень большого, тысячи графиков), содержащего всего три графика. Он все еще длинный, поэтому я поместил его в конце поста и объясню пару идей, которые пробовал до сих пор.

Первой попыткой было многократное использование mutate и map с использованием пакета purrr.

sampleColored <- sampleGraphs %>% mutate(map(graph, function(x) 
E(x)[weights == 0]$color = "blue")) %>% mutate(map(graph, function(x)
    E(x)[weights < 0]$color = "red"))  %>% mutate(map(graph, function(x)
    E(x)[weights > 0]$color = "green"))

Нет сообщений об ошибках, но команда

 shortPlots <- sampleColored %>%
 mutate(plots = map(graph, function(x) plot(x, layout=layout.circle,
     vertex.size=20,                                                          
     edge.curved=TRUE)))

произвел красивые графы со всеми краями, окрашенными в серый цвет.

То же самое и со второй попыткой, когда я создал функцию edgeColor и использовал единственный вызов map.

edgecolor <- function(x) {
E(x)[weights == 0]$color <- "blue"
E(x)[weights < 0]$color <- "red"
E(x)[weights > 0]$color <- "green"
return(E(x))
}
sampleColored <- sampleGraphs %>% mutate(map(graph, function(x) edgecolor(x)))

Без погрешности и серых краев. Удаление команды mutate вызывает сообщение об ошибке:

Error in as.numeric(n): cannot coerce type 'closure' to vector of type 'double'

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

Вот sampleGraph dput:

sampleGraphs <- structure(list(ID = 997:1000, graph = list(structure(list(5, 
TRUE, c(0, 1, 2, 0, 3, 4, 1, 2, 4, 3, 0, 4, 2, 3, 0, 1, 3, 
1, 4, 2), c(1, 0, 0, 4, 1, 1, 4, 3, 0, 2, 3, 2, 1, 4, 2, 
3, 0, 2, 3, 4), c(0, 14, 10, 3, 1, 17, 15, 6, 2, 12, 7, 19, 
16, 4, 9, 13, 8, 5, 11, 18), c(1, 2, 16, 8, 0, 12, 4, 5, 
14, 17, 9, 11, 10, 15, 7, 18, 3, 6, 19, 13), c(0, 4, 8, 12, 
16, 20), c(0, 4, 8, 12, 16, 20), list(c(1, 0, 1), structure(list(), .Names = character(0)), 
    structure(list(name = c("3", "0", "2", "4", "1")), .Names = "name"), 
    structure(list(weights = c(3L, -4L, 4L, -3L, 43L, 8L, 
    4L, 14L, 1L, 55L, 2L, 22L, 26L, 64L, 9L, 2L, 13L, -12L, 
    25L, 16L)), .Names = "weights")), <environment>), class = "igraph"), 
structure(list(5, TRUE, c(0, 1, 2, 2, 1, 3, 1, 3, 4, 3, 3, 
0, 4, 0, 4, 4, 2, 1, 2, 0), c(3, 3, 4, 0, 2, 1, 4, 2, 0, 
4, 0, 2, 1, 4, 2, 3, 3, 0, 1, 1), c(19, 11, 0, 13, 17, 4, 
1, 6, 3, 18, 16, 2, 10, 5, 7, 9, 8, 12, 14, 15), c(17, 3, 
10, 8, 19, 18, 5, 12, 11, 4, 7, 14, 0, 1, 16, 15, 13, 6, 
2, 9), c(0, 4, 8, 12, 16, 20), c(0, 4, 8, 12, 16, 20), list(
    c(1, 0, 1), structure(list(), .Names = character(0)), 
    structure(list(name = c("2", "0", "1", "3", "4")), .Names = "name"), 
    structure(list(weights = c(4L, -4L, 25L, 22L, 4L, 3L, 
    2L, -3L, 55L, 2L, 9L, 16L, 43L, 14L, 64L, 13L, 1L, -12L, 
    8L, 26L)), .Names = "weights")), <environment>), class = "igraph"), 
structure(list(5, TRUE, c(0, 1, 2, 3, 4, 0, 1, 2, 1, 3, 1, 
3, 2, 4, 2, 4, 0, 0, 3, 4), c(1, 4, 3, 4, 0, 4, 2, 0, 0, 
2, 3, 1, 4, 1, 1, 2, 3, 2, 0, 3), c(0, 17, 16, 5, 8, 6, 10, 
1, 7, 14, 2, 12, 18, 11, 9, 3, 4, 13, 15, 19), c(8, 7, 18, 
4, 0, 14, 11, 13, 17, 6, 9, 15, 16, 10, 2, 19, 5, 1, 12, 
3), c(0, 4, 8, 12, 16, 20), c(0, 4, 8, 12, 16, 20), list(
    c(1, 0, 1), structure(list(), .Names = character(0)), 
    structure(list(name = c("4", "0", "3", "2", "1")), .Names = "name"), 
    structure(list(weights = c(43L, 4L, 9L, 16L, 25L, 64L, 
    -4L, 2L, 2L, 4L, -11L, 26L, -3L, 8L, 3L, 1L, 55L, 13L, 
    14L, 22L)), .Names = "weights")), <environment>), class = "igraph"), 
structure(list(5, TRUE, c(0, 1, 2, 3, 4, 1, 3, 2, 4, 0, 1, 
3, 2, 4, 0, 0, 2, 4, 1, 3), c(4, 4, 4, 1, 2, 0, 2, 3, 0, 
3, 2, 0, 1, 1, 2, 1, 0, 3, 3, 4), c(15, 14, 9, 0, 5, 10, 
18, 1, 16, 12, 7, 2, 11, 3, 6, 19, 8, 13, 4, 17), c(5, 16, 
11, 8, 15, 12, 3, 13, 14, 10, 6, 4, 9, 18, 7, 17, 0, 1, 2, 
19), c(0, 4, 8, 12, 16, 20), c(0, 4, 8, 12, 16, 20), list(
    c(1, 0, 1), structure(list(), .Names = character(0)), 
    structure(list(name = c("1", "4", "0", "2", "3")), .Names = "name"), 
    structure(list(weights = c(1L, 13L, -4L, 14L, 3L, 64L, 
    26L, -11L, -3L, 22L, 43L, 16L, 2L, 2L, 8L, 25L, 4L, 8L, 
    55L, 4L)), .Names = "weights")), <environment>), class = "igraph"))),     class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -4L), .Names = c("ID", 
"graph"))

r dplyr purrr igraph
person zazizoma    schedule 24.05.2017    source источник

Ответы (2)


arrow_upward
2
arrow_downward

Помогает использование set_edge_attr вместо идиоматической E() краевой функции igraph. Мне пришлось пересмотреть список sampleGraph до простого списка графиков, обновленного до более новой версии igraph, но это работает:

graphs <- sampleGraphs$graph
graphs <- lapply(graphs, function(x) upgrade_graph(x)) #making a simple list of graphs

edgecolor <- function(x) {
  E(x)[weights == 0]$color <- "blue"
  E(x)[weights < 0]$color <- "red"
  E(x)[weights > 0]$color <- "green"
  return(E(x)$color)
} #The function now returns a list of colors conditional on statements

#Pass the function to the "values" argument of "set_edge_attr"

graphs_colored <- graphs %>% map(., function(x) set_edge_attr(x, "color", value = edgecolor(x)))

par(mfrow = c(2,2), mar = c(0,0,0,0))
shortPlots <- graphs_colored %>%
 map(., function(x) plot(x, 
                         layout=layout.circle,
                         vertex.size=20,                                                          
                         edge.curved=TRUE,
                         edge.arrow.size = 0.5))

введите описание изображения здесь

person paqmo    schedule 24.05.2017
comment
Почти! А изображения просто нужны. Хорошая работа с par (). Но мне нужно продолжать работать со столбцом списка в фрейме данных, поскольку мне нужна другая идентифицирующая информация. Я изменил функцию в соответствии с вашей, вернув E(x)$color, изменил функцию map на map(graph, function(x) set_edge_attr(x, "color", value = edgecolor(x))) и снова получил ошибку Error in as.numeric(n): cannot coerce type 'closure' to vector of type 'double'. - person zazizoma; 24.05.2017
comment
Я попробовал sampleGraphs$graph <- lapply(sampleGraphs$graph, function(x) upgrade_graph(x)) и получил ту же ошибку. Я мог бы случайным образом поиграть с unlist () или unnest (). Какую версию igraph вы используете? Я только что установил на прошлой неделе версию 1.0.1 для R на Mac. Спасибо! - person zazizoma; 24.05.2017
comment
Я также пробовал sampleColored <- sampleGraphs %>% mutate(graph = map(graph, function(x) upgrade_graph(x))) %>% map(graph, function(x) set_edge_attr(x, "color", value = edgecolor(x))), похожий на lappy выше, но более dplyerish. Та же ошибка. - person zazizoma; 24.05.2017

arrow_upward
1
arrow_downward

Понятно! Спасибо @paqmo за предложения. Мне нужно было использовать mutate, чтобы переопределить переменную graph list-column.

edgecolor <- function(x) {
  E(x)[weights == 0]$color <- "#FF000000"
  E(x)[weights < 0]$color <- "red"
  E(x)[weights > 0]$color <- "green"
  return(E(x)$color)
}
sampleColored <- sampleGraphs %>% mutate(graph = map(graph, function(x) 
  set_edge_attr(x, "color", value = edgecolor(x))))

par(mfrow = c(2,2), mar = c(0,0,0,0))
samplePlots <- sampleColored %>%
     mutate(plots = map(graph, function(x) plot(x, layout=layout.circle,
       vertex.size=20,                                                          
       edge.curved=TRUE)))

генерирует то же изображение, что и @paqmo.

person zazizoma    schedule 24.05.2017