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

Question

I have some information in a file called data.csv. Here is the link to the file https://www.mediafire.com/file/fil4r6noockgl9q/data.csv/file

I'm trying to create a shiny app with that data with the following code.

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)

With the above code, I have it like in the below picture:

To this, I would like to add some more radio buttons/select input where I would like to select the Group (Type1 to Type10), based on my interest.

Along with the above picture, I want to add some options for Group so that I can select only the interesting Group comparisons and download them.

For eg: I want to see the boxplot comparison between Type1 vs Type7 and it should show boxplot only for this comparison and download it.

Another eg: Type1 vs Type5 vs Type4 and it should show boxplot only for this comparison and download it

How do I do this? Can anyone please help me? Thank you.

Answer 1

You can use a selectizeInput with multiple = TRUE to select the groups you want to compare. This input can then be used to filter the dataset, the axis limit, and the comparisons you want to test.

I've just pasted the parts below, where I made changes to your code (selectizeInputin the ui, and your renderPlot expression)

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)
  })