Надеюсь, вы уже нашли решение, но если нет, вот подход.
Сначала это помогает решить проблему в не блестящей обстановке. Нам нужен список, в котором собраны векторы подсказок. Затем мы перебираем этот список для генерации аннотаций:
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.
Теперь, когда это работает, мы go до блеска. В вашем приложении каждый раз, когда вы нажимаете add annotation, фрейм данных очищенных точек обновляется, и ваш вектор кончиков является просто вектором недавно очищенных кончиков. Все ранее выбранные клады забываются.
Чтобы запомнить их, мы можем ввести два реактивных значения. Один n_annotations - это число c 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)