genomewalker
4/19/2016 - 7:24 PM

get_edges.R

plot_lag_mst <- function(X, dist = dist, metadata = metadata, name = name){
  
  plot_net_on_map_mst <- function(all_edges = all_edges, metadata = metadata, name = name){
    
    mapWorld <- borders("world", colour="#0a0c2a", fill="#0a0c2a") # create a layer of borders
    myPalette <- colorRampPalette((brewer.pal(11, "Spectral")))
    sc <- scale_colour_gradientn(colours = myPalette(100))
    mapWorld <- borders("world", colour="#0a0c2a", fill="#0a0c2a") # create a layer of borders
    
    zp1 <- ggplot(all_edges) + mapWorld  # Pretty simple plot code
    zp1 <- zp1 + geom_path(aes(x = y, y = x, group = Group,  # Edges with gradient
                               colour = Similarity, size = -Sequence/200000))  # and taper
    zp1 <- zp1 + scale_size(range = c(0.2, 5), guide = "none")  # Customize taper
    zp1 <- zp1 + scale_colour_gradientn(colours = rev( myPalette(100)), name="distance/tArrive")
    #labels = scales::trans_format("log10", scales::math_format(10^.x))
    zp1 <- zp1 + theme(panel.background = element_rect(fill = "white", colour = "black"), 
                       panel.grid.major = element_blank(),
                       panel.grid.minor = element_blank(),
                       axis.ticks = element_blank(), 
                       axis.text.x = element_text (size = 12, vjust = 0), 
                       axis.text.y = element_text (size = 12, hjust = 1.3)) + 
      coord_cartesian() + 
      labs(y="",x="") 
    zp1 <- zp1+ scale_fill_gradientn(colours = rev(viridis(256)), name = "Centrality")
    
    zp1<-zp1 + geom_point(data = metadata ,  
                          aes(x = longitude, y = latitude, fill = centrality, size = centrality), shape = 21) # Customize gradient v
    zp1 <- zp1 + theme_bw() + coord_equal(ratio=1) + theme(legend.position="right") +
      xlab("") + ylab("") + scale_x_continuous(breaks=c(-100,0,100)) +
      ggtitle(bquote(atop(.(name), atop(italic(.(name)), "")))) #
    return(zp1)
  }
  dist <- induced_subgraph(dist[[X]], vids =  metadata$station)
  dist<- delete_vertices(dist, V(dist)[degree(dist) == 0] )
  dist <- delete_edge_attr(dist, name = "weight_orig")
  tara_all_edges<-get_edges(dist_filt = dist %>% get.data.frame, layout_coordinates = metadata %>% dplyr::select(station, latitude, longitude))
  l<-plot_net_on_map_mst(tara_all_edges, metadata = metadata, name = name) 
  return(l)
}
# Based on https://gist.github.com/dsparks/4331058
get_edges<-function(dist_filt = dist_filt, layout_coordinates = layout_coordinates){
  
  edge_maker <- function(which_row, len = 100, curved = FALSE, layout_coordinates = layout_coordinates, adjacency_list = adjacency_list){
    # Get coordinates for each metagenome
    from_c <- as.numeric(subset(layout_coordinates, station == as.character(adjacency_list[which_row,]$X))[2:3])  # Origin
    to_c <- as.numeric(subset(layout_coordinates, station == as.character(adjacency_list[which_row,]$Y))[2:3])  # Terminus
    
    # Add curve:
    graph_center <- colMeans(layout_coordinates[2:3])  # Center of the overall graph
    bezier_mid <- c(from_c[1], to_c[2])  # A midpoint, for bended edges
    distance1 <- sum((graph_center - bezier_mid)^2)
    if(distance1 < sum((graph_center - c(to_c[1], from_c[2]))^2)){
      bezier_mid <- c(to_c[1], from_c[2])
    }  # To select the best Bezier midpoint
    bezier_mid <- (from_c + to_c + bezier_mid) / 3  # Moderate the Bezier midpoint
    if(curved == FALSE){bezier_mid <- (from_c + to_c) / 2}  # Remove the curve
    
    edge <- data.frame(bezier(c(from_c[1], bezier_mid[1], to_c[1]),  # Generate
                              c(from_c[2], bezier_mid[2], to_c[2]),  # X & y
                              evaluation = len))  # Bezier path coordinates
    edge$Sequence <- 1:len  # For size and colour weighting in plot
    edge$Group <- paste(adjacency_list[which_row,]$X,adjacency_list[which_row,]$Y, sep = "#")
    edge$Similarity <- adjacency_list[which_row,]$dist
    return(edge)
  }
  
  dist_filt<-dist_filt %>%
    setnames(c("X", "Y", "dist"))
  
  layout_coordinates<-layout_coordinates %>%
    setnames(c("station", "latitude", "longitude"))
  
  # Generate a (curved) edge path for each pair of connected nodes
  all_edges <- lapply(1:nrow(dist_filt), edge_maker, 
                      len = 100, curved = TRUE, adjacency_list = dist_filt, 
                      layout_coordinates = layout_coordinates)
  all_edges <- rbindlist(all_edges, fill = T)  # a fine-grained path ^, with bend ^
  return(all_edges)
}