使用R igraph和dplyr（purrr）有条件地在列表列图中设置边属性

Question

I have a dataframe with a series of igraph objects in list-column format. I would like to conditionally set the edge color attribute.

I've included the dput output for a sample version of the actual dataframe (very large, thousands of graphs) containing just three graphs. It's still long, so I've put it at the bottom of this post and I'll explain a couple of the ideas I've tried so far.

First attempt was multiple uses of mutate and map using the purrr package.

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"))

No error messages, but the command

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

produced nice graphs with all edges colored grey.

Likewise with my second attempt where I created an edgeColor function and used a single map call.

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)))

No error and grey edges. Dropping the mutate command gives rise to the error message:

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

I'm confident that this is possible and I simply don't have the understanding to get to the correct syntax. Any suggestions will be appreciated. Thanks for looking.

Here's the 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"))

Answer 1

Using set_edge_attr rather than igraph 's idiomatic E() edge function helps. I had to revise the sampleGraph list to a simple list of graphs, upgraded to the newer version of igraph , but this works:

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))

Answer 2

Got it! Thanks to @paqmo for suggestions. I needed to use mutate to redefine the graph list-column variable.

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)))

generates the same image as @paqmo.