根据用户输入向 ggplot2/ggtree 添加另一层 Rshiny

Question

下面的例子是使用ggtree，我可以在其中刷系统发育中的提示并添加注释标签（“进化枝”）。让应用运行的步骤 -

1. 加载树 - 称为 vert.tree
2. 刷过（突出显示）提示（用人类和狐猴测试）并按“注释树”按钮以添加红色标签。

我想要做的是在树上添加另一个注释，同时保留第一个注释（人类和狐猴）。例如，猪和牛提示的第二个标签。本质上，我希望能够根据用户输入在系统发育树上添加一行，然后根据用户的第二个输入重复该操作，同时保持图像上的第一行。目前，每次我刷不同对时，标签都会重置，因此一次只显示一个注释。

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

非常感谢您的建议！

更新为包含基础树 (vert.tree)

Answer 1

希望您已经找到了解决方案，但如果没有，这里有一个方法。

首先，它有助于在不发光的环境中解决问题。我们需要的是一个累积提示向量的列表。然后我们循环遍历这个列表来生成注释：

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)

---

编辑：反应值如何在没有 phylo 的情况下工作

我试图对此进行彻底的评论。

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 - 好的，当我测试你的建议时

    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 的地方缺少值....