根據用戶輸入向 ggplot2/ggtree 添加另一層 Rshiny

Question

下面的例子是使用ggtree，我可以在其中刷系統發育中的提示並添加注釋label（“進化枝”）。 讓應用程序運行的步驟 -

1. 加載樹 - 稱為 vert.tree
2. 刷過（突出顯示）提示（用人和狐猴測試）並按下“注釋樹”按鈕以將 label 添加為紅色。

我想要做的是在樹上添加另一個注釋，同時保持第一個注釋（人類和狐猴）。 例如，第二個 label 用於豬和牛的提示。 本質上，我希望能夠根據用戶輸入在系統發育樹上添加一行，然后根據用戶的第二個輸入重復該操作，同時保持圖像上的第一行。 目前，每次我刷不同的一對時，label 都會重置，因此一次只顯示一個注釋。

# 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列表的每個成員生成注釋層。

現在這工作正常了，我們從 go 到 shiny。 在您的應用程序中，每次單擊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

嗯 - 好的，當我測試你的建議時

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