добавить еще один слой в ggplot2/ggtree на основе пользовательского ввода Rshiny

Надеюсь, вы уже нашли решение, но если нет, вот подход.

Во-первых, это помогает решить проблему в неблестящей обстановке. Что нам нужно, так это список, в котором накапливаются векторы подсказок. Затем мы прокручиваем этот список, чтобы сгенерировать аннотации:

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"
  ))

Ключевой бит находится в вызове lapply, где создается слой аннотаций для каждого члена списка tip_vector.

Теперь, когда это работает, мы переходим к блестящему. В вашем приложении каждый раз, когда вы нажимаете add annotation, фрейм данных очищенных точек обновляется, и ваш вектор кончиков — это просто вектор новых очищенных кончиков. Любые ранее выбранные клады забываются.

Чтобы запомнить их, мы можем ввести два реактивных значения. Один n_annotations — это числовое reactiveVal, которое показывает, сколько раз мы нажимаем add annotation. Другой annotations — это список reactiveValues, в котором хранятся все очищенные клады под именами paste0("ann", n_annotations()).

Затем фактическое добавление слоя аннотаций происходит, как в нереактивном примере с циклическим циклом lapply по reactiveValues.

Код приложения:

# 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)

Редактировать: как реактивные значения работают без филоматериалов

Я постарался подробно это прокомментировать.

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)

хммм - хорошо, когда я проверил ваше предложение

    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)
    })

Я получаю сообщение об ошибке: отсутствует значение там, где нужно TRUE/FALSE....