2

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:

enter image description here

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.

beginner
  • 1,059
  • 8
  • 23

1 Answers1

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

enter image description here

pholzm
  • 1,719
  • 4
  • 11
  • thanks a lot. But I used your way and when I selected Type1 and Type7....it is not showing only those two.....it is showing all Types. – beginner Mar 06 '22 at 08:25
  • 1
    @beginner does it still show all data or just the selected data but all Types on the axis? The former should be handled by `data = dat() %>% dplyr::filter(Group %in% input$group)`, the latter by `scale_x_discrete(limits = positions[positions %in% input$group])` – pholzm Mar 06 '22 at 08:49
  • It shows all Types on the x-axis. Output looks like this `https://www.mediafire.com/file/e9xqq9r9iuf7noq/Screen+Shot+2022-03-06+at+10.06.47.png/file` – beginner Mar 06 '22 at 09:09
  • 1
    In your screenshot you still have all types selected. You can deselect them by using e.g. backspace in the "Group" box. – pholzm Mar 06 '22 at 09:13
  • oh yes. it worked now. Thank you. Thank you very much for the help. – beginner Mar 06 '22 at 09:15
  • If you usually just want to compare 2 or 3 Types, you could also change the "selected" argument in "selectizeInput" to not initialize the box with everything pre-selected (but then you probably want to handle an empty selection box differently in server.R) – pholzm Mar 06 '22 at 09:16
  • Okay. But this worked now. Thank you. – beginner Mar 06 '22 at 09:19
  • Hi small question. For example, in the above shiny app if I select `geneC` Is there a way to get that name on the top of image? And if I select `geneA` it should display geneA on the top of image. – beginner Mar 10 '22 at 11:16
  • 1
    `gg2 + labs(title = input$thegene)` should add it as a title, or if you want to position it at a specific place on the graph you could use `+ annotate("text", x = ?, y = ?, label = input$thegene)` – pholzm Mar 10 '22 at 11:41