Question

我正在尝试创建一个包含多个部分的闪亮应用程序，我现在遇到问题的部分现在在gpplot图表上显示计算值。用户从下拉列表中选择一个目标基因，然后图形显示针对其他对照基因的选择而计算出的分析值。到目前为止很简单。

我有一些默认的对照基因组，它们是我预先选择的，并且总是显示出来，然后我可以让用户指定自己的对照基因进行分析。有如果用户要选择自己的控件，则可以选中该复选框。用户还可以选择不同数量的自定义对照，而每个默认对照都有3个对照基因的集合。

默认基因组的代码如下：

ABC_control <- reactive( 
    Analysis_function(c("ACTB", "GAPDH", "TUBB")))

自定义基因集的代码如下：

  CUSTOM_control1 <- reactive( if (input$custom_checkbox1) {
    Analysis_function(input$custom_controls1)
  } else { NA } )

我在“自定义”基因集中有一个if命令，以便在未选中复选框的情况下不计算和显示它们。

第一个问题：即使未选中任何内容且未选中该复选框，该图仍显示Custom控件的x轴标签。这不是主要问题，只是一个令人讨厌的问题。

第二个问题：

仅显示默认基因组时，一切运行正常。当用户选择自己的对照基因时，一切运行正常。

问题是，当用户勾选CheckboxInput（），并且自定义控件基因的selectizeInput（）仍然为空时，图形移动并将其x轴重新排序为字母顺序，而不是水平顺序我已经指定了。一旦选择了对照基因，它就会重新排列回水平顺序。仅当selectizeInput框为空或正在选择新基因时，才会出现此问题。

即使反应式自定义输入为空，如何强制绘图始终以正确的级别顺序显示？另外，最好是，除非选中该复选框，否则如何完全阻止Custom输入显示在grpah上。

完整的“闪亮”应用数据如下：


#### Load packages ####
library(shiny)
library(ggplot2)
library(dplyr)
#### Load data files ####
load("GeneNames.Rda")
load("Dataset.Rda")
#### Define UI  ####
ui <- fluidPage(
  #### Sidebar inputs ####
  sidebarLayout(
    sidebarPanel(width = 3,
                 #first wellpanel for selecting Target gene
                 h4("Target gene selection"),
                 wellPanel(
                   selectInput(
                     inputId = "gene_select",
                     label = NULL,
                     choices = GeneNames,
                     selected = "ESAM")),
                 #Second wellpanel for selecting custom Control genes
                 h4("Custom control genes"),
                 wellPanel(
                   checkboxInput(inputId = "custom_checkbox1",
                                 label = "Custom 1:"),
                   conditionalPanel(condition = "input.custom_checkbox1 == true",
                                    selectizeInput(inputId = "custom_controls1",
                                                   label = NULL,
                                                   choices = GeneNames,
                                                   multiple = TRUE,
                                                   options = list(openOnFocus = FALSE, closeAfterSelect = TRUE, maxOptions = 50, maxItems = 6))))
    ),
    #### Mainpanel results Normal ####
    mainPanel(width = 9,
              #HTML code to have the last entry in any tables bolded (last entry is Mean in all tables)
              #Results title and main bar plot graph
              fluidRow(plotOutput(outputId = "celltype_bar_plot"),width = 9)
    )))
#### Define server ####
server <- function(input, output) {
  target_gene <- reactive({
    input$gene_select
  })
  #### calculations  ####
  Analysis_function <- function(controls){
    cor(Dataset[, target_gene()], Dataset[, controls])
  }
  ABC_control <- reactive( 
    Analysis_function(c("ACTB", "GAPDH", "TUBB")))
  GHI_control <- reactive(
    Analysis_function(c("ACTB", "GAPDH", "TUBB")))
  DEF_control <- reactive(
    Analysis_function(c("ACTB", "GAPDH", "TUBB")))
  CUSTOM_control1 <- reactive( if (input$custom_checkbox1) {
    Analysis_function(input$custom_controls1)
  } else { NA } )

  #### Analysis datatables Normal ####
  control_list <- c("ABC_control", "GHI_control", "DEF_control", "CUSTOM_control1")
  analysis_list <- reactive({ list(ABC_control(), GHI_control(), DEF_control(), CUSTOM_control1()) })
  #generating melted data table of the induvidual analysed gene values, transposed to get in right format, and times = c(length()) to replicate titles the correct no of times
  values_list <- reactive({
    data.frame(Control_types2 = factor(rep(control_list, times = c(unlist(lapply(analysis_list(), length)))), levels =control_list), 
               values =  c(unlist(lapply(analysis_list(), t))))
  })
  #Generating data table of the means of analysed values above
  Mean_list <- reactive({
    data.frame(Control_types = factor(control_list, levels =control_list),
               Mean_correlation = c(unlist(lapply(analysis_list(), mean))))
  })
  #### Main Bar Plot Normal ####
  output$celltype_bar_plot <- renderPlot({
    ggplot() +
      geom_point(data = values_list(),aes(x=Control_types2, y=values,size = 7, color = Control_types2), show.legend = FALSE, position=position_jitter(h=0, w=0.1), alpha = 0.7) +
      geom_boxplot(data = Mean_list(), aes(Control_types, Mean_correlation), size = 0.5, colour = "black") 
  })

}
#### Run application ####

shinyApp(ui = ui, server = server)

如果需要更多信息或不清楚我要做什么，请告诉我。

Answer 1

由于您提供的数据不可用（因此我无法运行该应用程序），因此我无法完全测试此解决方案，但我怀疑以下内容应会有所帮助。

首先，通过使用ordered或factor(..., ordered = TRUE)，您可以告诉图形标签的放置顺序。

第二，为了防止该列显示在图形上，您必须删除该列的所有数据点，包括NA。

control_list <- c("ABC_control", "GHI_control", "DEF_control", "CUSTOM_control1")

# Some data to try out
values_list <- data.frame(
  Control_types2 = ordered(rep(control_list, times = 4), levels =control_list),
  values = c(0.25,0.50,0.75,NA)
)

Mean_list <- data.frame(
  Control_types = ordered(control_list, levels =control_list),
  Mean_correlation = c(0.25,0.50,0.75,NA)
)

# Original plot code
ggplot() +
  geom_point(data = values_list,aes(x=Control_types2, y=values,size = 7, color = Control_types2), show.legend = FALSE, position=position_jitter(h=0, w=0.1), alpha = 0.7) +
  geom_boxplot(data = Mean_list, aes(Control_types, Mean_correlation), size = 0.5, colour = "black")

# New plot with NA values removed
ggplot() + 
  geom_point(data = values_list %>% filter(!is.na(values)),
             aes(x=Control_types2, y=values,size = 7, color = Control_types2), 
             show.legend = FALSE, 
             position=position_jitter(h=0, w=0.1), 
             alpha = 0.7) +
  geom_boxplot(data = Mean_list %>% filter(!is.na(Mean_correlation)), 
               aes(Control_types, Mean_correlation), 
               size = 0.5, 
               colour = "black")

当无功输入为空时，ggplot不会将电平用于x轴顺序

1 个答案: