genomewalker
6/13/2017 - 12:27 PM

plot_map_bc.r

plot_map_bc <- function(physeq = physeq){

library(vegan)
library(tidyverse)
library(broom)
library(Hmisc)
library(viridis)

# calculate bray-curtis

physeq_data <-  sample_data(physeq_hel)
physeq_data <- as(physeq_data, "data.frame")

physeq_data <- physeq_data %>% 
  filter(Metagenomes %in% sample_names(physeq)) %>% 
  select(Metagenomes, Longitude, Latitude, Depth_Id)

srf <- physeq_data %>% filter(Depth_Id == "SRF")

physeq_hel <- prune_samples(srf$Metagenomes, physeq_hel)

physeq_bc <- vegdist(otu_table(physeq), "bray")
physeq_bc_graph <- tidy(physeq_bc) %>%
  mutate(weight = 1 - distance) %>%
  graph_from_data_frame() %>%
  simplify()

binary_search_filter_1 <- function(g, low, high) {
  x<-g
  if ( high < low ) {
    
    return(NULL)
    
  }else {
    mid <- floor((low + high) / 2)
    x<-igraph::delete.edges(g, which(E(g)$weight <= weights[mid])) 
    cat("low:", low, " mid:", mid, " high:", high, " mid_weight:", weights[mid], " components:", igraph::count_components(x), " edges:", ecount(x), "\n")
    
    if ((mid - low) == 0){
      x<-igraph::delete.edges(g, which(E(g)$weight <= weights[mid-1])) 
      cat("Final: low:", low - 1, " mid:", mid - 1, " high:", high - 1, " mid_weight:", weights[mid - 1], " components:",igraph::count_components(x), " edges:", ecount(x), "\n")
      return(list(weight=mid - 1, graph=x))
      exit
    }
    
    if (((high - low) == 0)){
      x<-igraph::delete.edges(g, which(E(g)$weight <= weights[mid+1])) 
      cat("Final: low:", low, " mid:", mid, " high:", high, " mid_weight:", weights[mid], " components:",igraph::count_components(x), " edges:", ecount(x), "\n")
      return(list(weight=mid , graph=x))
      exit
    }
    
    
    if (!(igraph::is.connected(x))){
      binary_search_filter_1(g, low, mid - 1)
    }else if (igraph::is.connected(x)){
      binary_search_filter_1(g, mid + 1, high)
    }
  }
}

weights <- unique(sort(E(physeq_bc_graph)$weight, decreasing = FALSE))
physeq_bc_graph_filt <- binary_search_filter_1(g = physeq_bc_graph, low = 1, high = length(weights))$graph

layoutCoordinates <- physeq_data
adjacencyList <- igraph::as_data_frame(physeq_bc_graph_filt) 

edgeMaker <- function(whichRow, len = 100, curved = TRUE){
  # Get coordinates for each metagenome
  fromC <- as.numeric(subset(layoutCoordinates, Metagenomes == as.character(adjacencyList[whichRow,]$from))[2:3])  # Origin
  toC <- as.numeric(subset(layoutCoordinates, Metagenomes == as.character(adjacencyList[whichRow,]$to))[2:3])  # Terminus
  
  # Add curve:
  graphCenter <- colMeans(layoutCoordinates[2:3])  # Center of the overall graph
  bezierMid <- c(fromC[1], toC[2])  # A midpoint, for bended edges
  distance1 <- sum((graphCenter - bezierMid)^2)
  if(distance1 < sum((graphCenter - c(toC[1], fromC[2]))^2)){
    bezierMid <- c(toC[1], fromC[2])
  }  # To select the best Bezier midpoint
  bezierMid <- (fromC + toC + bezierMid) / 3  # Moderate the Bezier midpoint
  if(curved == FALSE){bezierMid <- (fromC + toC) / 2}  # Remove the curve
  
  edge <- data.frame(bezier(c(fromC[1], bezierMid[1], toC[1]),  # Generate
                            c(fromC[2], bezierMid[2], toC[2]),  # X & y
                            evaluation = len))  # Bezier path coordinates
  edge$Sequence <- 1:len  # For size and colour weighting in plot
  edge$Group <- paste(adjacencyList[whichRow,]$from,adjacencyList[whichRow,]$to, sep = "#")
  edge$weight <- adjacencyList[whichRow,]$weight
  return(edge)
}

# Generate a (curved) edge path for each pair of connected nodes
allEdges <- lapply(1:nrow(adjacencyList), edgeMaker, len = 500, curved = TRUE)
allEdges <- do.call(rbind, allEdges)  # a fine-grained path ^, with bend ^

# Plot 
mapWorld <- borders("world", colour="#0a0c2a", fill="#0a0c2a") # create a layer of borders

zp1 <- ggplot(allEdges) + mapWorld  # Pretty simple plot code
zp1 <- zp1 + geom_path(aes(x = x, y = y, group = Group,  # Edges with gradient
                           colour = weight, size = -Sequence))  # and taper
zp1 <- zp1 + geom_point(data = data.frame(physeq_data),  # Add nodes
                        aes(x = Longitude, y = Latitude), size = 2, pch = 21,
                        colour = "black", fill = "gray") # Customize gradient v
zp1 <- zp1 + scale_colour_gradientn(colours = rev(viridis(100, option = "C", direction = -1)), labels = scales::percent, name="Similarity")
zp1 <- zp1 + scale_size(range = c(1/10, 1), guide = "none")  # Customize taper
zp1 <- zp1 + theme_bw() + coord_equal(ratio=1) + theme(legend.position="top") +
  xlab("") + ylab("") + scale_x_continuous(breaks=c(-100,0,100))# Clean up plot
zp1
}