如何通过在主面板中输出注意文本来避免错误消息

Posted 2023-03-24

【中文标题】如何通过在主面板中输出注意文本来避免错误消息

【英文标题】：How to avoid error messages by output attention text in mainpanel

【发布时间】：2021-08-01 15:53:31

【问题描述】：

我创建了一个闪亮的应用程序，只有一个选择输入框。还有两个重要的操作按钮。

第一个按钮使用data_mean_sd，第二个按钮使用data_mean_sd2。

但是我遇到了一个问题，当我选择一个存在于data_mean_sd 但不存在于data_mean_sd2 中的基因，然后单击第二个按钮时，可能会出现错误消息。

所以我从@YBS 那里得到了更好的答案。这里： Selectinput enable or disable actionbuttons - has problems

##我的问题是： 现在我想使用另一种解决方案，当我选择一个仅包含在data_mean_sd中的基因并单击第二个按钮我希望注意文本可以在主面板中输出，就像：您选择的基因不包含或未找到。

我发现解决方案来自 https://shiny.rstudio.com/articles/validation.html 使用 validate 为您的 UI 编写错误消息。

但我认为我的问题必须有其他更好的解决方案。

如果我只能修改下面的部分代码？

  observeEvent(input$selectGeneSymbol, 
    if(sum(unique(data_mean_sd2$Gene) %in% input$selectGeneSymbol)>0) 
      shinyjs::enable("plot2")
      shinyjs::enable("all")
    else
      shinyjs::disable("plot2")
      shinyjs::disable("all")
    
  )

希望有人能给我一些建议。不胜感激。

这是我的可重现代码和数据：

mean_data <- data.frame(
  Name = c(paste0("Group_", LETTERS[1:20])),
  matx <- matrix(sample(1:1000, 1000, replace = T), nrow = 20)
)
names(mean_data)[-1] <- c(paste0("Gene_", 1:50))

sd_data <- data.frame(
  Name = c(paste0("Group_", LETTERS[1:20])),
  matx <- matrix(runif(1000, 5, 10), nrow = 20)
)
names(sd_data)[-1] <- c(paste0("Gene_", 1:50))

# Prepare dataset.
#   1. Bind mean and sd data
#   2. Reshape
data <- bind_rows(list(
  mean = mean_data,
  sd = sd_data
), .id = "stat")
data_mean_sd <- data %>%
  pivot_longer(-c(Name, stat), names_to = "Gene", values_to = "value") %>%
  pivot_wider(names_from = "stat", values_from = "value")


data_mean_sd2<-data_mean_sd[data_mean_sd$Gene==paste0("Gene_",1:25),]

###
ui <- fluidPage(
  shinyjs::useShinyjs(),
  
  fluidRow(
    column(8,offset = 3,
           h2("Gene_FPKM Value Barplot")
    )
  ),
  fluidRow(
    column(8,offset = 3,
           selectInput(
             "selectGeneSymbol", 
             "Select Gene Symbol:", 
             choices = unique(data_mean_sd$Gene),
             multiple =F,
             width = 800,
             selected = "123"
           ))
  ),
  fluidRow(
    column(8,offset = 3,
           actionButton(inputId = "plot1", label = "FPKM",width=80),
           actionButton(inputId = "plot2", label = "LogFc",width=80),
           actionButton(inputId = "all",label = "FPKM&LogFc",width=120)
    )
  ),
  fluidRow(
    column(3)
  ),
  fluidRow(
    column(3)
  ),
  fluidRow(
    column(12,align="center",
           uiOutput("plots")
    )
  )
)

server <- function(input, output,session) 
  
  observeEvent(input$selectGeneSymbol, 
    if(sum(unique(data_mean_sd2$Gene) %in% input$selectGeneSymbol)>0) 
      shinyjs::enable("plot2")
      shinyjs::enable("all")
    else
      shinyjs::disable("plot2")
      shinyjs::disable("all")
    
  )
  
  plot_data1 <- eventReactive(list(input$plot1,input$all),  
    subset(data_mean_sd, Gene %in% input$selectGeneSymbol)
  )
  
  plot_data2 <- eventReactive(list(input$plot2,input$all),  
    subset(data_mean_sd2, Gene %in% input$selectGeneSymbol)
  )
  
  global <- reactiveValues()
  
  observeEvent(list(input$plot1,input$all), 
               req(plot_data1())
  #p1 <- eventReactive(list(input$plot1,
  #                         input$all), 
                global$p1 <- ggplot(data = plot_data1(), aes(x = Name, y = mean,fill=Name)) +
                               geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
                               geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
                               theme_classic2() +
                               rotate_x_text(angle = 45) +
                               theme(legend.position = "none") +
                               labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
                               theme(plot.title = element_text(hjust = 0.5)) +
                               theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
                               theme(axis.text.x=element_text(vjust=1,size=12)) 
                           )  
  
  observeEvent(list(input$plot2,input$all), 
               req(plot_data2())
  #p2 <- eventReactive(list(input$plot2,
  #                         input$all), 
                global$p2 <- ggplot(data = plot_data2(), aes(x = Name, y = mean,fill=Name)) +
                               geom_bar(stat = "identity", position = position_dodge(0.9), width = 0.9) +
                               geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = .2, position = position_dodge(0.9)) +
                               theme_classic2() +
                               rotate_x_text(angle = 45) +
                               theme(legend.position = "none") +
                               labs(title = input$selectGeneSymbol, x = NULL, y = "FPKM_value") +
                               theme(plot.title = element_text(hjust = 0.5)) +
                               theme(plot.margin = unit(c(20, 5, 1, 5), "mm"))+
                               theme(axis.text.x=element_text(vjust=1,size=12)) 
                           )  
  
  output$plt1 <- renderPlot( global$p1 )
  output$plt2 <- renderPlot( global$p2 )

  
  observeEvent(input$plot1, 
    global$out <- plotOutput("plt1", height=600)
  )
  
  observeEvent(input$plot2, 
    global$out <- plotOutput("plt2", height=600)
  )
  
  
  output$plots <- renderUI(
    global$out
  )
  


# Create Shiny app ----
shinyApp(ui = ui, server = server)

【问题讨论】：

@YBS 先生，我需要你的帮助。

@YBS ，我自己解决了。谢谢。

【参考方案1】：

我很高兴自己解决了这个问题。

我的解决方案的重要部分是从https://shiny.rstudio.com/articles/validation.html 找到答案

正如官方文档所说：

所以我将validate() 函数放在我的renderPlot() 中，如下所示：

  output$plt2 <- renderPlot(
    validate(
      need(sum(unique(colnames(data_mean_sd2[,-1])) %in% input$selectGeneSymbol)>0, "Error information you personal customized.")
    )
    p2() 
    )

而且效果很好。 不要忘记删除下面的代码和相关信息。

  observeEvent(input$selectGeneSymbol, 
    if(sum(unique(data_mean_sd2$Gene) %in% input$selectGeneSymbol)>0) 
      shinyjs::enable("plot2")
      shinyjs::enable("all")
    else
      shinyjs::disable("plot2")
      shinyjs::disable("all")
    
  )

【讨论】：

太棒了！如果您想显示带有错误的弹出消息，也可以尝试showModal()。