Parallel links for edges that go in both directions about ggraph HOT 10 CLOSED

edge_shift <- function(x1,y1,x2,y2,shift){
  v <- c(x2 - x1,y2 - y1)
  v <- v/sqrt((v[1]^2 + v[2]^2))
  v_perp <- c( -v[2], v[1] )
  
  return(c(x1 + shift*vperp[1],y1 + shift*vperp[2],
           x2 + shift*vperp[1],y2 + shift*vperp[2]))
}

# function to create parallel edges ----
create_parallels <- function(data,params) {
  data$origID <- 1:nrow(data)
  data$.id <- paste(pmin(data$from, data$to), pmax(data$from, data$to), sep = '-')
  data <- data %>% arrange(.id)
  medge <- data %>% 
    group_by(.id) %>% 
    dplyr::summarise(medge=n()) %>%
    ungroup() %>% 
    transmute(medge)
  
  medge <- medge$medge  
  medge_shift <- unlist(sapply(medge,dseq,spread=params$spread))
  data$shift <- medge_shift*ifelse(data$from<data$to,1,-1)
  shifted <- t(apply(data[,c("x","y","xend","yend","shift")],1,
                     function(x) edge_shift(x[1],x[2],x[3],x[4],x[5])))

  data[,c("x","y","xend","yend")] <- shifted 
  data <- data %>% arrange(origID)
  data[["shift"]] <- NULL
  data[["origID"]] <- NULL
  data[[".id"]] <- NULL
  data[["from"]] <- NULL
  data[["to"]] <- NULL
  data
}

dseq <- function(n,spread){
  seq(-(n-1)*spread/2,(n-1)*spread/2,by=spread)
}
edge_shift <- function(x1,y1,x2,y2,shift){
  
  v <- c(x2 - x1,y2 - y1)
  v <- v/sqrt((v[1]^2 + v[2]^2))
  v_perp <- c( -v[2], v[1] )
  
  return(c(x1 + shift*v_perp[1],y1 + shift*v_perp[2],
           x2 + shift*v_perp[1],y2 + shift*v_perp[2]))
  
}

#Stat Function ----
StatEdgeParallel <- ggproto('StatEdgeParallel', StatLink,
                        setup_data = function(data, params) {
                          if (any(names(data) == 'filter')) {
                            if (!is.logical(data$filter)) {
                              stop('filter must be logical')
                            }
                            data <- data[data$filter, names(data) != 'filter']
                            
                          }
                          data <- create_parallels(data,params)
                          StatLink$setup_data(data, params)
                        },
                        default_aes = aes(filter = TRUE),
                        extra_params = c("na.rm","n",'spread')
)


#geom ----
geom_edge_parallel <- function(mapping = NULL, data = get_edges(),
                           position = "identity", arrow = NULL, spread = 0.02,
                           n = 100,
                           lineend = "butt", linejoin = "round", linemitre = 1,
                           label_colour = 'black',  label_alpha = 1,
                           label_parse = FALSE, check_overlap = FALSE,
                           angle_calc = 'rot', force_flip = TRUE,
                           label_dodge = NULL, label_push = NULL,
                           show.legend = NA, ...) {
  mapping <- complete_edge_aes(mapping)
  mapping <- aes_intersect(mapping, aes_(x=~x, y=~y, xend=~xend, yend=~yend,
                                        from=~from, to=~to))
  layer(data = data, mapping = mapping, stat = StatEdgeParallel,
        geom = GeomEdgePath, position = position, show.legend = show.legend,
        inherit.aes = FALSE,
        params = expand_edge_aes(
          list(arrow = arrow, lineend = lineend, linejoin = linejoin,
               linemitre = linemitre, na.rm = FALSE, spread = spread, n = n,
               interpolate = FALSE,
               label_colour = label_colour, label_alpha = label_alpha,
               label_parse = label_parse, check_overlap = check_overlap,
               angle_calc = angle_calc, force_flip = force_flip,
               label_dodge = label_dodge, label_push = label_push, ...)
        )
  )
}

g <- graph.full(3)
g <- add.edges(g,c(1,2,2,3,2,1))
E(g)$col <- c("a","a","a","b","b","c")
ggraph(g,"stress")+geom_edge_parallel(aes(col=col),spread=0.01)+geom_node_point(size=7)
#> Warning: Ignoring unknown aesthetics: from, to

gr <- graph_from_data_frame(data.frame(
  from = c(1, 1, 1, 1, 1, 2, 2, 2,2,2,2),
  to = c(2, 2, 2, 2, 2, 1, 1, 1,3,3,3),
  class = sample(letters[1:3], 11, TRUE)
))
xy <- cbind(c(1,2,3),c(0,0,0))

ggraph(gr, 'manual',node.positions=data.frame(x=xy[,1],y=xy[,2])) +
  geom_edge_parallel(spread=0.002)+
  geom_node_point(size=7)
#> Warning: Ignoring unknown aesthetics: from, to

ggraph(gr, 'manual',node.positions=data.frame(x=xy[,1],y=xy[,2])) +
  geom_edge_parallel(spread=0.002)+
  geom_node_point(size=7)+scale_y_continuous(limits=c(-0.2,0.2))
#> Warning: Ignoring unknown aesthetics: from, to