rggnetwork

Custom layout in ggnetwork


I have a network with a custom layout. I would like to customize it with ggnetwork (not shown, See vignette). I can pass the node positions to the ggnetwork (ggplot), but how to pass the arrow (edges) positions?

Minimal example:

myvec<-structure(list(lengths = c(1L, 2L, 27L, 1L, 6L, 1L, 15L, 1L, 
                                  23L, 1L, 4L, 2L, 77L, 1L, 1L, 1L, 22L, 2L, 21L, 1L, 3L, 1L, 30L, 
                                  2L, 38L, 1L, 40L, 2L, 22L, 1L, 12L, 1L, 8L, 1L, 12L, 1L, 9L, 
                                  1L, 9L, 1L, 28L, 2L, 12L, 1L, 31L, 1L, 12L, 1L, 5L, 1L, 15L, 
                                  1L, 10L, 1L, 25L, 1L, 16L, 1L, 27L, 1L, 25L, 1L, 31L, 2L, 20L
), values = c(0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 
              0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 
              1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 
              0, 1, 0, 1, 0, 1, 0)), class = "rle")

mymat <- structure(unlist(mapply(rep, myvec$values, myvec$lengths) ), .Dim = c(26L, 26L), .Dimnames = list(NULL, NULL) )

library(network)
net1 <- network(mymat,
              matrix.type = "adjacency",
              ignore.eval = FALSE
              ,directed=T
)

# finalxy is a modification of:
# library(sna)
# xy = gplot.layout.fruchtermanreingold(net1, NULL)

finalxy<-structure(c(-2, 0, 0, 6, 2, 6, 4, 6, 2, -6, -4, 0, 4, 0, 8, 8, 
            -4, -2, -2, 8, 10, 2, 0, -4, -2, 4, 4, 2, 4, 4, 0, 2, -2, -2, 
            2, -2, -2, 0, -4, -2, -4, -2, 0, 0, -2, 0, 0, -2, -4, -4, -4, 
            4), .Dim = c(26L, 2L) )

net1 %v% "xpos" = finalxy[, 1]
net1 %v% "ypos" = finalxy[, 2]

# ggnet

library(GGally)

gdata <- ggnet2( net1, 
                 label = TRUE,  
                 alpha = 0.9, 
                 label.size = 3 
                 ,mode = c("xpos", "ypos")
                 ,layout.exp = 0
                 ,arrow.size = 12, arrow.gap = 0.025) 
gdata
    
# ggnetwork

library(ggnetwork)

ggplot(net1, aes(x = x, y = y, xend = xend, yend = yend) )  +
  geom_edges(arrow = arrow(length = unit(1, "pt"), type = "closed")
  ) +
  geom_nodes(aes(x=xpos, y=ypos ), size = 4) 

ggnet

enter image description here

ggnetwork

enter image description here


Solution

  • This works:

    # Get edges from network
    library(dplyr)
    
    # From https://stackoverflow.com/questions/42960248/how-to-plot-networks-over-a-map-with-the-least-overlap#answer-43049177
    
    networkdata <- sapply(net1$mel, function(x) 
      c('id_inl' = x$inl, 'id_outl' = x$outl, 'weight' = x$atl$weights)) %>%
      t %>% as_tibble()
    
    posxyOrig<-finalxy[networkdata$id_outl,]
    posxyTarg<-finalxy[networkdata$id_inl,]
    
    colnames(posxyOrig)<-c("xorig","yorig")
    colnames(posxyTarg)<-c("xtarg","ytarg")
    
    posData<-cbind(networkdata,posxyOrig,posxyTarg )
    
    ggplot(net1 )+
      geom_edges(data=posData, aes(x = xorig, y = yorig, xend = xtarg, yend = ytarg),
                 arrow = arrow(length = unit(10, "pt"), type = "closed")
      ) +
      geom_nodes(aes(x=xpos, y=ypos ), size = 4) 
    

    enter image description here