add another layer to ggplot2/ggtree based on user input Rshiny

Question

The example below is using ggtree in which I can brush the tips in the phylogeny and add an annotation label ("clade"). Steps to get the app going -

1. load the tree - called vert.tree
2. brush over (highlight) tips (test with human and lemur) and press the 'annotate tree' button to add the label in red.

What I want to do is add another annotation onto the tree while maintaining the first annotation (human and lemur). For example, a second label for the pig and cow tips. Essentially, I want to be able to add a line onto a phylogenetic tree based on user input and then repeat that based on second input from the user while maintaining the first line on the image. Currently, the label gets reset every time I brush a different pair so only one annotation is displayed at a time.

# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.

library(shiny)
library(treeio)
library(ggtree)
library(phytools)
library(ape)

#make phylogenetic tree
text.string <-"(((((((cow, pig),whale),(bat,(lemur,human))),(robin,iguana)),coelacanth),gold_fish),shark);"

#read in the tree
vert.tree<-ape::read.tree(text=text.string)

# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("Test"),

  actionButton("add_annotation","Add clade annotation"),

  # Show a plot of the generated distribution
  mainPanel(plotOutput("treeDisplay", brush ="plot_brush")
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {


 #reactive that holds base tree - this is how I am building the base tree 
  make_tree <- reactive({
    ggtree::ggtree(vert.tree)+
      ggtree::geom_tiplab()+
      ggplot2::xlim(NA, 10)})

  #render base tree 
    output$treeDisplay <- renderPlot({
      make_tree()
    })

  #reactive that holds the brushed points on a plot
  dataWithSelection <- reactive({
    brushedPoints(make_tree()$data, input$plot_brush)
  })

  #add to label to vector if isTip == True
  dataWithSelection2 <- reactive({
    tipVector <- c()
    for (i in 1:length(dataWithSelection()$label)){ if(dataWithSelection()$isTip[i] == TRUE) tipVector <- c(tipVector,dataWithSelection()$label[i])}
    return(tipVector)
  })

  # incorporate the tipVector information for adding layer
  layer <- reactive({
    ggtree::geom_cladelabel(node=phytools::findMRCA(ape::as.phylo(make_tree()), dataWithSelection2()), label = "Clade", color = "red")
  })

  #display that layer onto the tree
  observeEvent(input$add_annotation, {
    output$treeDisplay <- renderPlot({make_tree() + layer()})
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Suggestions greatly appreciated!

updated to include a base tree (vert.tree)

Answer 1

Hope you found the solution already, but if not, here is an approach.

First it helps to do the problem in a non-shiny setting. What we need is a list that accumulates vectors of tips. Then we cycle over this list to generate annotations:

tree_plot <-
  ggtree::ggtree(vert.tree) +
  ggtree::geom_tiplab() +
  ggplot2::xlim(NA, 10)

tip_vector <- list(c("human", "lemur"), c("pig", "cow"))

make_layer <- function(tree, tips, label, color) {
  ggtree::geom_cladelabel(
    node = phytools::findMRCA(ape::as.phylo(tree), tips),
    label = label,
    color = color
  )
}

x + lapply(1:2, function(i)
  make_layer(
    tree_plot,
    tips = tip_vector[[i]],
    label = paste("Clade", i),
    color = "red"
  ))

The key bit is in the lapply call, where generate the annotation layer for each member of the tip_vector list.

Now that this is working, we go to shiny. In your app, every time you click add annotation the brushed points data frame is refreshed and your tip vector is just a vector of the newly brushed tips. Any previously selected clades are forgotten.

To remember these, we can introduce two reactive values. One n_annotations is a numeric reactiveVal counting how many times we click add annotation. The other annotations is a reactiveValues list which stores all the brushed clades under the names paste0("ann", n_annotations()).

Then, the actual adding of the layer of annotations proceeds as in the non-reactive example with lapply cycling over the reactiveValues.

App code:

# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.

library(shiny)
library(treeio)
library(ggtree)
library(phytools)
library(ape)

#make phylogenetic tree
text.string <-"(((((((cow, pig),whale),(bat,(lemur,human))),(robin,iguana)),coelacanth),gold_fish),shark);"

#read in the tree
vert.tree<-ape::read.tree(text=text.string)

# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("Test"),

  actionButton("add_annotation","Add clade annotation"),

  # Show a plot of the generated distribution
  mainPanel(plotOutput("treeDisplay", brush ="plot_brush"),
            plotOutput("treeDisplay2")
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

  #reactive that holds base tree - this is how I am building the base tree 
  make_tree <- reactive({
    ggtree::ggtree(vert.tree) +
      ggtree::geom_tiplab() +
      ggplot2::xlim(NA, 10)
  })

  #render base tree
  output$treeDisplay <- renderPlot({
    make_tree()
  })

  # 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(make_tree()$data, input$plot_brush)
  })

  #add to label to vector if isTip == True
  dataWithSelection2 <- eventReactive(input$plot_brush, {
    tipVector <- c()
    for (i in 1:length(dataWithSelection()$label)) {
      if (dataWithSelection()$isTip[i] == TRUE)
        tipVector <- c(tipVector, dataWithSelection()$label[i])
    }

    tipVector
  })

  make_layer <- function(tree, tips, label, color) {
    ggtree::geom_cladelabel(
      node = phytools::findMRCA(ape::as.phylo(tree), tips),
      label = label,
      color = color
    )
  }

  #display that layer onto the tree
  anno_plot <- eventReactive(input$add_annotation, {
    # update the reactive value
    new <- n_annotations() + 1
    n_annotations(new)
    annotations[[paste0("ann", n_annotations())]] <- dataWithSelection2()

    plt <-
      make_tree() +
      lapply(1:n_annotations(), function(i)
        make_layer(
          make_tree(),
          tips = annotations[[paste0("ann", i)]],
          label = paste("Clade", i),
          color = "red"
        ))

    return(plt)
  })

  output$treeDisplay2 <- renderPlot({
    anno_plot()
  })

}

# Run the application 
shinyApp(ui = ui, server = server)

---

Edit: how the reactive values work without the phylo stuff

I tried to comment this thoroughly.

ui <- basicPage(
  actionButton("add_anno", "Add annotation"),
  helpText("n_annotation is counting clicks"),
  textOutput("n_anno"),
  helpText("clades is accumulating clades"),
  verbatimTextOutput("clades")
)

server <- function(input, output) {
  # this initializes a reactive value
  # and sets the initial state to 0
  n_anno <- reactiveVal(0)

  # makes an empty reactive list
  # this can be populated and index
  # like a normal list 
  # e.g., clades[["first"]] <- c("bird", "lizard")
  clades <- reactiveValues()

  observeEvent(input$add_anno, {
    # increment the number of clicks
    new_count <- n_anno() + 1

    # update the reactiveValue
    # works the same way we initialized it
    # except instead of zero we set the incremented value
    n_anno(new_count)

    # making a name for an element in the clades list
    # we use the n_anno number of clicks to increment the clades
    # message just prints it on console
    message( paste0("clade", n_anno() ))

    # populate the list of clades for annotations
    clades[[ paste0("clade", n_anno() ) ]] <- sample(LETTERS, 3)
  })

  output$n_anno <- renderText(n_anno())
  output$clades <- renderPrint(
    str(reactiveValuesToList(clades))
    )
}

shinyApp(ui, server)

Answer 2

hmmm - okay when I tested your suggestion

    dataWithSelection2 <- reactive({
        tipVector <- c()
        for (i in 1:length(dataWithSelection()$label)){ 
            if(!is.null(dataWithSelection()$isTip[i])) {
                tipVector <- c(tipVector,dataWithSelection()$label[i])
            }
        }
                return(tipVector)
    })

I get the error: missing value where TRUE/FALSE needed....