R/mod_annotateTree.R

In jennahamlin/annoatater: An Amazing Shiny App

#' annotateTree UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
mod_annotateTree_ui <- function(id){
  ns <- NS(id)
  tagList(
    actionButton(ns("add_tree"),"Visualize Tree"),
    actionButton(ns("add_annotation"),"Add Annotation to Tree"),
    plotOutput(ns("treeDisplay"), brush = ns("plot_brush"))
    #,
    # downloadButton(ns("downloadPlot"), "Download the plot")
  )
}
    
#' annotateTree Server Function
#'
#' @noRd 
mod_annotateTree_server <- function(input, output, session, makeTreeOut){
  ns <- session$ns
  #displays the tree plot, uses output from the displayTree module 
  observeEvent(input$add_tree, {output$treeDisplay <- renderPlot({
    makeTreeOut()})
  })
  
  # Initialize a reactive value and set to zero
  n_annotations <- reactiveVal(0)
  annotations <- reactiveValues()
  
  #reactive that holds the brushed points on a plot
  dataWithSelection <- reactive({
    brushedPoints(makeTreeOut()$data, input$plot_brush)
  })
  
  tipVector <- c()
  
  #add label to tipVector if isTip == True
  dataWithSelection2 <- eventReactive(input$plot_brush, {
    label <- NULL
    for (i in 1:length(dataWithSelection()$label)) {
      if (dataWithSelection()$isTip[i] == TRUE)
        tipVector <- c(tipVector, dataWithSelection()$label[i])
    }
    return(tipVector)
  })
  
  output$textDisplay <-renderText(dataWithSelection2())
  
  make_layer <- function(tree, tips, label, color, offset) {
    ggtree::geom_cladelabel(
      node = phytools::findMRCA(ape::as.phylo(tree), tips),
      label = label,
      color = color,
      angle = 0,
      offset = offset
    )
  }
  
  check_overlap <- function(previous_plot, incoming_tips) {
    pre_g <- ggplot2::ggplot_build(previous_plot)
    
    tip_labels <- pre_g$data[[3]]
    
    incoming_y_coords <-
      tip_labels[tip_labels$label %in% incoming_tips, "y"]
    
    if (length(pre_g$data) < 4) {
      any_overlap <- FALSE
    } else {
      clade_segments <- pre_g$data[[4]]
      
      overlaps <- sapply(1:nrow(clade_segments), function(i) {
        X <- DescTools::Overlap(
          x = c(clade_segments[i, "y"], clade_segments[i, "yend"]), 
          y = incoming_y_coords)
        Y <- X > 0})
    }
  }
  
  addAnnotations <- function(tree_plot, tip_vector) {
    g <- tree_plot
    
    for (i in seq_along(tip_vector)) {
      any_overlap <- check_overlap(previous_plot = g, incoming_tips = tip_vector[[i]])
      print(tip_vector[[i]])
      
      print(any_overlap)                                                                           
      #print(current_offset)
      
      g <- g +
        make_layer(
          tree_plot,
          tips = tip_vector[[i]],
          label = paste("Clade", i),
          color = rev(colors())[i],
          offset = current_offset <- ifelse(any_overlap, 0.011, 0.008)

            
            #ifelse(any_overlap, 0.01, 
             #                               ifelse(any_overlap, 0.02, 0.008))
            
          #ifelse(any_overlap, 0.016, 0.011)
          
        )
    }
    return(g)
  }
  
  anno_plot<- eventReactive(input$add_annotation, {
    # update the reactive value as a count of - 1
    
    new <- n_annotations() + 1
    n_annotations(new)
    
    #add the tip vector (aka label) to the annotation reactive value
    annotations$data[[paste0("ann", n_annotations())]] <- dataWithSelection2()
    
    tips <- lapply(1:n_annotations(), function(i)
      annotations$data[[paste0("ann", i)]])
    
    return(tips)
    
  })
  
  #display that layer onto the tree
  observeEvent(input$add_annotation, {
    output$treeDisplay <- renderPlot({
      addAnnotations(tree_plot = makeTreeOut() , tip_vector =  anno_plot() )
    })
  })
  
  treePlotOut <- reactive({
    addAnnotations(tree_plot = makeTreeOut() , tip_vector =  anno_plot() )
  })
  
  
  return(treePlotOut)
  
  # output$downloadPlot <- downloadHandler(
  #   filename = function() {
  #     paste("data-", Sys.Date(), ".png", sep="")
  #   },
  #   content = function(file) {
  #     ggplot2::ggsave(file, plot = treePlotOut(), device = "png")
  #   }
  # )

}
    
## To be copied in the UI
# mod_annotateTree_ui("annotateTree_ui_1")
    
## To be copied in the server
# callModule(mod_annotateTree_server, "annotateTree_ui_1")