[英]add another layer to ggplot2/ggtree based on user input Rshiny
下面的例子是使用ggtree,我可以在其中刷系统发育中的提示并添加注释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)
希望您已经找到了解决方案,但如果没有,这里有一种方法。
首先,它有助于在不发光的环境中解决问题。 我们需要的是一个累积提示向量的列表。 然后我们循环这个列表来生成注释:
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)
嗯 - 好的,当我测试你的建议时
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 的地方缺少值....
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.