如何 select R Shiny 应用程序中箱线图的特定兴趣组？

Question

我在一个名为 data.csv 的文件中有一些信息。这是文件 https://www.mediafire.com/file/fil4r6noockgl9q/data.csv/file

的 link

我正在尝试使用以下代码 data 创建一个闪亮的应用程序。

library(shiny)
library(EnvStats)
data <- read.csv("data.csv")
choi <- unique(data$GENE)

positions <- c("Type1", "Type2",
               "Type4",'Type5', "Type8",
               "Type9", "Type10", "Type6", "Type3", "Type7")
my_comparisons <- list(c("Type1", "Type2"), 
                       c("Type1", "Type3"),
                       c("Type1", "Type7"),
                       c("Type1", "Type10"),
                       c("Type2", "Type3"),
                       c("Type2", "Type7"),
                       c("Type2", "Type10"),
                       c("Type3", "Type7"),
                       c("Type3", "Type10"),
                       c("Type7", "Type10"))

ui <- fluidPage(
  titlePanel("values"),
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "thegene", label = "Gene", choices = choi, selected = "geneC"),
      selectInput(inputId = "group", label = "Group", choices = my_comparisons, selected=c("Type1")),
      radioButtons(inputId = "colour", label = "Colour", choices=c("white"),selected="white"),
      radioButtons(inputId = "FileType", label = "file type", choices = list("png", "pdf"), selected = "pdf"),
      width = 3),
    mainPanel(
      plotOutput("boxplot"),
      downloadButton(outputId = "downloadPlot", label = "Download"),
      width = 9
    )
  )
)
options(shiny.maxRequestSize = 100*1024^2)

server <- function(input, output, session) {
  vals <- reactiveValues()
  alldat <- reactive({
    choices <- unique(data$GENE)
    selected <- isolate(input$thegene)
    if (!selected %in% choices) selected <- choices[1]
    updateSelectInput(session, "thegene", choices = choices, selected = selected)
    data
  })
  
  dat <- reactive({
    x <- alldat()
    x[ x$GENE == input$thegene,,drop=FALSE]
  })
  
  output$boxplot <- renderPlot({
    gg <- ggboxplot(data = dat(), x = "Group", y = "value", color = "Group", 
                    add = "jitter")+ 
      xlab("") + ylab("values") +
      stat_compare_means(comparisons = my_comparisons, label = "p.signif", method = "wilcox.test")
    gg2 <- gg + scale_x_discrete(limits = positions)+
      theme_bw(base_size = 14) + stat_n_text() +
      theme(axis.text=element_text(size=13, face = "bold", color = "black"),
            axis.title=element_text(size=13, face = "bold", color = "black"),
            strip.text = element_text(size=13, face = "bold", color = "black"),
            legend.text = element_text(size=13, face = "bold", color = "black"),
            legend.title = element_text(size=13, face = "bold", color = "black"),
            legend.position = "none",
            axis.text.x = element_text(angle = 90))
    
    vals$gg2 <- gg2
    
    print(gg2)
  })

  output$downloadPlot <- downloadHandler(
    filename =  function() {
      paste(input$thegene, input$FileType,sep=".")
    },
    # content is a function with argument file. content writes the plot to the device
    content = function(file){
      if(input$FileType=="png")
        png(file, units="in", width=6, height=7, res=300)
      else
        pdf(file, width = 6, height = 7)
      print(vals$gg2)
      dev.off()
    } 
  )
}

# Run the application 
shinyApp(ui = ui, server = server)

通过上面的代码，我得到了如下图所示：

对此，我想根据自己的兴趣在 select Group（Type1 到 Type10）的地方再添加一些 radio buttons/select input。

除了上面的图片，我还想为Group添加一些选项，这样我就可以select只比较interesting Group并下载它们。

例如：我想查看 Type1 与 Type7 之间的箱线图比较，它应该只显示此比较的箱线图并下载它。

另一个例子：Type1 vs Type5 vs Type4 它应该只显示箱线图用于比较并下载它

我该怎么做？谁能帮帮我吗？谢谢。

Answer 1

您可以使用 selectizeInput 和 multiple = TRUE 来 select 您想要比较的组。此输入随后可用于过滤数据集、轴限制和您要测试的比较。

我刚刚粘贴了下面的部分，其中我对您的代码进行了更改（selectizeInput在 ui 中，以及您的 renderPlot 表达式）

ui <- fluidPage(
  titlePanel("values"),
  sidebarLayout(
    sidebarPanel(
      selectInput(inputId = "thegene", label = "Gene", choices = choi, selected = "geneC"),
      selectizeInput(inputId = "group", label = "Group", choices = positions, 
                     multiple = TRUE, selected=positions),
      radioButtons(inputId = "colour", label = "Colour", choices=c("white"),selected="white"),
      radioButtons(inputId = "FileType", label = "file type", choices = list("png", "pdf"), selected = "pdf"),
      width = 3),
    mainPanel(
      plotOutput("boxplot"),
      downloadButton(outputId = "downloadPlot", label = "Download"),
      width = 9
    )
  )
)

output$boxplot <- renderPlot({
    
    # make sure we remove comparisons that are not possible
    comparisons_reduced <- purrr::map(my_comparisons, function(m) {
        if(sum(m %in% input$group) == 2) {
          m
        } else {
          NULL
        }
      }
    )
    comparisons_reduced <- comparisons_reduced[lengths(comparisons_reduced)!=0]
    
    gg <- ggboxplot(data = dat() %>% 
                      dplyr::filter(Group %in% input$group), 
                    x = "Group", y = "value", color = "Group", 
                    add = "jitter") + 
      xlab("") + ylab("values") +
      stat_compare_means(comparisons = comparisons_reduced, label = "p.signif", method = "wilcox.test")
    
    gg2 <- gg + scale_x_discrete(limits = positions[positions %in% input$group])+
      theme_bw(base_size = 14) + stat_n_text() +
      theme(axis.text=element_text(size=13, face = "bold", color = "black"),
            axis.title=element_text(size=13, face = "bold", color = "black"),
            strip.text = element_text(size=13, face = "bold", color = "black"),
            legend.text = element_text(size=13, face = "bold", color = "black"),
            legend.title = element_text(size=13, face = "bold", color = "black"),
            legend.position = "none",
            axis.text.x = element_text(angle = 90))
    
    vals$gg2 <- gg2
    
    print(gg2)
  })

如何 select R Shiny 应用程序中箱线图的特定兴趣组？

How to select specific interesting groups for the boxplot in R Shiny app?

r

shiny

shiny-server

shinydashboard

shinyapps