r - 如何处理：一个输入窗口和 2 个或更多操作按钮，但选择了不同的输入

Question

我有 2 个不同的数据，第一个数据中的基因符号包含第二个数据中的基因符号。

现在只有一个输入窗口和 3 个操作按钮。

一开始我将第一个数据中的基因符号设置为输入选项。

但它们不包含在第二个数据中。

所以有一个问题，当我点击第二个动作按钮时，条形图甚至不会出现

像这样显示错误：

但是第一个动作按钮效果很好：

有时它可能会在我的真实数据的输出界面中给我一些错误的代码。

我的第一个问题是如何处理它：当我选择一个不在第二个数据中的基因符号并单击第二个操作按钮或第三个操作按钮时，它可以在输出界面中给我一些友好的提示？？

我还有一个问题：

例如：

我选择 Gene_1 作为输入，然后单击 FPKM 按钮，出现 Gene_1 结果。然后我选择 Gene_2 作为输入。但是这次我点击了LogFc。Gene_2结果不会立即出现，但Gene_1结果会突然出现然后消失，然后Gene_2结果出现。

我不知道无论是小数据还是大数据，它总是会发生。

所以我的第二个问题是如何处理这种现象

这是我的示例代码：

options(encoding = "UTF-8")
library(stats)
library(openxlsx)
library(shiny)
library(dplyr)
library(tidyr)      
library(ggplot2)
library(gridExtra)  ##  inline the all the plot
library(ggpubr)
library(shinythemes)
library(shinymanager)
library(psych)
library(DT)

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(
  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 = "Igfbp7"
           ))
  ),
  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("all")
    )
  )
)

server <- function(input, output,session) {
  
  
  plot_data1 <- eventReactive(input$plot1, { 
    subset(data_mean_sd, Gene %in% input$selectGeneSymbol)
  })
  
  plot_data2 <- eventReactive(input$plot2, { 
    subset(data_mean_sd2, Gene %in% input$selectGeneSymbol)
  })
  
  global <- reactiveValues(out = NULL)
  

  
  observeEvent(input$plot1, {
    global$out <- plotOutput("plot1", height=600)
  })
  
  observeEvent(input$plot2, {
    global$out <- plotOutput("plot2", height=600)
  })
  
  observeEvent(input$all, {
    global$out <- plotOutput("plot3", height=800)
  })
  
  
  output$all <- renderUI({
    global$out
  })
  
  p1 <- eventReactive(list(input$plot1,
                           input$all), {
    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)) 
  })  
  
  p2 <- eventReactive(list(input$plot2,
                           input$all), {
    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$plot1 <- renderPlot({ p1() })
  output$plot2 <- renderPlot({ p2() })
  output$plot3 <- renderPlot({ grid.arrange(p1(),p2(), ncol=1) })
  
}

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

标签： rbuttonshiny