文章/答案/技术大牛

发布

社区首页 >问答首页 >使用selectizeInput和updateSelectizeInput在renderUI中工作

问使用selectizeInput和updateSelectizeInput在renderUI中工作
EN

Stack Overflow用户

提问于 2022-04-14 23:17:01

回答 1查看 254关注 0票数 2

我的基本shiny app示例有一个由20,000个基因组成的data.frame，每个基因都有一个效应和p.value数值：

set.seed(1)
df <- data.frame(gene = paste0("g",1:20000), effect = rnorm(20000), p.value = runif(20000,1,0), stringsAsFactors = F)

我的app有两个输出选项要显示：

火山图，是-log10(df$p.value)和df$effect的散点图
与选项1相同，但允许用户选择在火山图中以红色突出显示的多个基因。

如果用户选择了选项1，我希望(从中选择)的基因列表只会出现。

在renderUI中的server中有一个choices参数，其中choices参数包含所有的20,000个基因，这太慢了，所以我使用selectizeInput和updateSelectizeInput跟踪本教程。

下面是我的app代码，我在ui中定义了selectizeInput，在server中定义了updateSelectizeInput。

它做不到我想做的事：

如果label变量未在selectizeInput中定义，则会引发错误：Error in dots_list(...) : argument "label" is missing, with no default。但是，如果我确实定义了它，默认情况下将出现该框，而不是以用户选择选项2为条件。
出现的列表不允许从中进行选择。
我的应用程序不显示渲染的情节。

suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(shiny))
suppressPackageStartupMessages(library(shinyjs))
suppressPackageStartupMessages(library(DT))
suppressPackageStartupMessages(library(readr))
suppressPackageStartupMessages(library(plotly))
suppressPackageStartupMessages(library(rmarkdown))

volcanoPlot <- function(df,selected.gene.set=NULL)
{
  plot.df <- df %>%  dplyr::mutate(log10.p.value = -log10(p.value))
  plot.df <- cbind(plot.df,purrr::imap(plot.df, ~ paste(.y, .x, sep=": ")) %>%
                     dplyr::as_tibble() %>%
                     tidyr::unite(text, sep="\n"))
  if(!is.null(selected.gene.set)){
    plot.df$group <- "unselected"
    plot.df$group[which(plot.df$gene %in% selected.gene.set)] <- "selected"
    plot.df$group <- factor(plot.df$group,levels=c("unselected","selected"))
    volcano.plot <- plotly::plot_ly(type='scatter',mode="markers",marker=list(size=5),color=plot.df$group,colors=c("lightgray","darkred"),x=plot.df$effect,y=plot.df$log10.p.value,text=plot.df$text,hoverinfo="text",showlegend=F) %>%
      plotly::layout(xaxis=list(title="Effect",zeroline=F),yaxis=list(title="-log10(P-value)",zeroline=F))
  } else{
    volcano.plot <- plotly::plot_ly(type='scatter',mode="markers",marker=list(size=5,color="gray"),x=plot.df$effect,y=plot.df$log10.p.value,text=plot.df$text,hoverinfo="text",showlegend=F) %>%
      plotly::layout(xaxis=list(title="Effect",zeroline=F),yaxis=list(title="-log10(P-value)",zeroline=F))
  }
  return(volcano.plot)
}

output.choices <- c("","Volcano Plot","Highlighted Gene Set Volcano Plot")
set.seed(1)
df <- data.frame(gene = paste0("g",1:20000), effect = rnorm(20000), p.value = runif(20000,0,1), stringsAsFactors = F)

server <- function(input, output, session)
{
  output$selected.gene.set <- renderUI({
    req(input$outputType == "Highlighted Gene Set Volcano Plot")
    updateSelectizeInput(session,"selected.gene.set","Select Genes to Highlight",choices=unique(df$gene),multiple=T)
  })

  volcano.plot <- reactive({
    req(input$outputType)
    if(input$outputType == "Volcano Plot"){
      volcano.plot <- volcanoPlot(df=df)
    } else{
      req(input$selected.gene.set)
      volcano.plot <- volcanoPlot(df=df,selected.gene.set=input$selected.gene.set)
    }
    return(volcano.plot)
  })

  output$out.plotly <- plotly::renderPlotly({
    volcano.plot()$volcano.plot
  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      tags$head(
        tags$style(HTML(".multicol {-webkit-column-count: 3; /* Chrome, Safari, Opera */-moz-column-count: 3; /* Firefox */column-count: 3;}")),
        tags$style(type="text/css", "#loadmessage {position: fixed;top: 0px;left: 0px;width: 100%;padding: 5px 0px 5px 0px;text-align: center;font-weight: bold;font-size: 100%;color: #000000;background-color: #CCFF66;z-index: 105;}"),
        tags$style(type="text/css",".shiny-output-error { visibility: hidden; }",".shiny-output-error:before { visibility: hidden; }")),
      conditionalPanel(condition="$('html').hasClass('shiny-busy')",tags$div("In Progress...",id="loadmessage")),
      selectInput("outputType", "Output Type", choices = output.choices),
      selectizeInput(inputId='selected.gene.set',label="Select Genes to Highlight",choices=NULL)
    ),
    mainPanel(
      plotly::plotlyOutput("out.plotly")
    )
  )
)

shinyApp(ui = ui, server = server)

shiny

plotly

selectize.js

renderui

回答 1

Stack Overflow用户

回答已采纳

发布于 2022-04-18 21:38:51

数据：

set.seed(1)
df <- data.frame(gene = paste0("g",1:20000), effect = rnorm(20000), p.value = runif(20000,0,1), stringsAsFactors = F)


suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(shiny))
suppressPackageStartupMessages(library(shinyjs))
suppressPackageStartupMessages(library(DT))
suppressPackageStartupMessages(library(readr))
suppressPackageStartupMessages(library(plotly))
suppressPackageStartupMessages(library(rmarkdown))

volcanoPlot <- function(plot.df,selected.gene.set=NULL)
{
  plot.df <- plot.df %>%  dplyr::mutate(log10.p.value = -log10(p.value))
  plot.df <- cbind(plot.df,purrr::imap(plot.df, ~ paste(.y, .x, sep=": ")) %>%
                     dplyr::as_tibble() %>%
                     tidyr::unite(text, sep="\n"))
  if(!is.null(selected.gene.set)){
    plot.df$group <- "unselected"
    plot.df$group[which(plot.df$gene %in% selected.gene.set)] <- "selected"
    plot.df$group <- factor(plot.df$group,levels=c("unselected","selected"))
    volcano.plot <- plotly::plot_ly(type='scatter',mode="markers",marker=list(size=5),color=plot.df$group,colors=c("lightgray","darkred"),x=plot.df$effect,y=plot.df$log10.p.value,text=plot.df$text,hoverinfo="text",showlegend=F) %>%
      plotly::layout(xaxis=list(title="Effect",zeroline=F),yaxis=list(title="-log10(P-value)",zeroline=F))
  } else{
    volcano.plot <- plotly::plot_ly(type='scatter',mode="markers",marker=list(size=5,color="gray"),x=plot.df$effect,y=plot.df$log10.p.value,text=plot.df$text,hoverinfo="text",showlegend=F) %>%
      plotly::layout(xaxis=list(title="Effect",zeroline=F),yaxis=list(title="-log10(P-value)",zeroline=F))
  }
  return(volcano.plot)
}

output.choices <- c("","Volcano Plot","Highlighted Gene Set Volcano Plot")

server <- function(input, output, session)
{
  observeEvent(input$outputType,{
    if(req(input$outputType == "Highlighted Gene Set Volcano Plot"))
      updateSelectizeInput(session,"selected.gene.set","Select Genes to Highlight",choices=unique(df$gene),server=T)
  })
  
  volcano.plot <- reactive({
    req(input$outputType)
    if(input$outputType == "Volcano Plot"){
      v.plot <- volcanoPlot(plot.df=df)
    } else{
      req(input$selected.gene.set)
      v.plot <- volcanoPlot(plot.df=df,selected.gene.set=input$selected.gene.set)
    }
    return(v.plot)
  })

  output$out.plotly <- plotly::renderPlotly({
    volcano.plot()
  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      tags$head(
        tags$style(HTML(".multicol {-webkit-column-count: 3; /* Chrome, Safari, Opera */-moz-column-count: 3; /* Firefox */column-count: 3;}")),
        tags$style(type="text/css", "#loadmessage {position: fixed;top: 0px;left: 0px;width: 100%;padding: 5px 0px 5px 0px;text-align: center;font-weight: bold;font-size: 100%;color: #000000;background-color: #CCFF66;z-index: 105;}"),
        tags$style(type="text/css",".shiny-output-error { visibility: hidden; }",".shiny-output-error:before { visibility: hidden; }")),
      conditionalPanel(condition="$('html').hasClass('shiny-busy')",tags$div("In Progress...",id="loadmessage")),
      selectInput("outputType", "Output Type", choices = output.choices),
      conditionalPanel(condition = "input.outputType=='Highlighted Gene Set Volcano Plot'",selectizeInput(inputId="selected.gene.set",label=NULL,multiple=T,choices=NULL))
    ),
    mainPanel(
      plotly::plotlyOutput("out.plotly")
    )
  )
)

shinyApp(ui = ui, server = server)

票数 1

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/71878531

复制

相似问题

问使用selectizeInput和updateSelectizeInput在renderUI中工作
EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问使用selectizeInput和updateSelectizeInput在renderUI中工作EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问使用selectizeInput和updateSelectizeInput在renderUI中工作
EN