Home > Back-end >  Interactively display values in one selectInput() based on the value chosen in another selectInput()
Interactively display values in one selectInput() based on the value chosen in another selectInput()

Time:10-30

I have a shiny application which produces a distribution plot of some data. The user may select the grouping variable - either "group" or "sample", and the plot is displayed accordingly.

Below I pasted a dummy data, very similar to my IRL datasets. However, in my real datasets there are often more than 2 levels of "group" and "sample". This sometimes results in pasta plots (there are too many overlapping lines, thus plots are hard to interpret).

I would like to add another selectInput(), which would allow to choose from the levels of the "selected_grouping_variable" (either "group" or "sample"). Based on this selection, only the chosen condition shall be plotted.

For instance, if in the first selectInput() the user would select the "group" and in the second selectInput() the user would select "MINUS", then only this condition would be shown.

I do not know how to interactively code the values in the second selectInput() - I put there a temporary hard coded placeholder.

I can switch between the plots, however the interactive list is something which is a problem for me.

EDIT: here I posted code for an app without the reactive for plot type switching (between multiple and chosen condition) to simplify & shorten the example app.

For instance, tried to apply similar approach to this: SelectInput Value update based on previous SelectInput in R shiny

So below is an example without the submenu UI, which does not crash.

library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinyWidgets)
library(plotly)
library(ggplot2)



# dummy dataframe
data <- structure(list(group = c("MINUS", "MINUS", "MINUS", "MINUS",
        "MINUS", "MINUS", "MINUS", "MINUS", "MINUS", "MINUS", "MINUS",
        "MINUS", "MINUS", "MINUS", "MINUS", "MINUS", "MINUS", "MINUS",
        "MINUS", "MINUS", "MINUS", "MINUS", "MINUS", "MINUS", "MINUS",
        "MINUS", "MINUS", "MINUS", "MINUS", "MINUS", "MINUS", "MINUS",
        "MINUS", "MINUS", "MINUS", "MINUS", "MINUS", "MINUS", "MINUS",
        "MINUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS",
        "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS",
        "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS",
        "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS",
        "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS", "PLUS",
        "PLUS"), sample = c("KO1", "KO1", "KO1", "KO1", "KO1", "KO1",
        "KO1", "KO1", "KO1", "KO1", "KO1", "KO1", "KO1", "KO1", "KO1",
        "KO1", "KO1", "KO1", "KO1", "KO1", "KO2", "KO2", "KO2", "KO2",
        "KO2", "KO2", "KO2", "KO2", "KO2", "KO2", "KO2", "KO2", "KO2",
        "KO2", "KO2", "KO2", "KO2", "KO2", "KO2", "KO2", "WT1", "WT1",
        "WT1", "WT1", "WT1", "WT1", "WT1", "WT1", "WT1", "WT1", "WT1",
        "WT1", "WT1", "WT1", "WT1", "WT1", "WT1", "WT1", "WT1", "WT1",
        "WT2", "WT2", "WT2", "WT2", "WT2", "WT2", "WT2", "WT2", "WT2",
        "WT2", "WT2", "WT2", "WT2", "WT2", "WT2", "WT2", "WT2", "WT2",
        "WT2", "WT2"), length = c(5.42698294047075, 5.92635065412571,
        4.731370064085, 5.64220300822762, 5.57228932041387, 6.22026386746176,
        5.61074721076161, 6.90554647566245, 5.2845168449524, 3.13163029626701,
        4.66073669641487, 5.06929532903151, 4.83884351557263, 7.29864563205587,
        6.9234944501749, 5.89882789931708, 8.33838150336101, 6.40770834501188,
        6.10170809180024, 5.50062709014807, 5.32182326770975, 5.02286808631602,
        3.29482390339188, 3.5723347460342, 2.79908656774703, 4.14707862159563,
        3.85551760401575, 3.95853731144376, 3.91487858600316, 5.34250840307844,
        4.52558650790815, 4.1564223236772, 6.19181615459772, 4.32677170175912,
        1.19505550072132, 4.6780122233462, 3.71094058593136, 4.3458027287231,
        2.93368565263858, 2.63858951429245, 8.3543831119607, 8.07219997485341,
        6.54868523535663, 9.23016522553079, 8.01437068778606, 8.05300812158612,
        7.63243258460168, 7.6278281970338, 9.13519373689575, 7.03995083026592,
        7.93447303467706, 7.18315089942801, 9.76152480418088, 5.89079385611074,
        7.66882157847856, 8.34140575588706, 7.58260442324865, 6.76957967862635,
        7.2835361228496, 8.98357195284373, 7.4268512506308, 7.97620131273315,
        5.86921853266739, 6.61585363374368, 6.50643180805718, 7.42291609075115,
        5.77418979693673, 5.99468327535715, 8.11037592398837, 8.65907288581822,
        7.13623962318806, 6.42334395459039, 7.52386894584617, 7.56616341788604,
        4.66900918856588, 7.76433411861569, 6.46868489245131, 6.21478701958505,
        8.11003353085736, 7.74850668112323)), class = "data.frame", row.names = c(NA,-80L))

    
    
    # custom function for plotting data
    plot_distr <- function(data, groupby=NA){
      plot <- ggplot2::ggplot(data,ggplot2::aes(x=length,color=!!rlang::sym(groupby))) 
        ggplot2::geom_line(stat="density",size=1,ggplot2::aes(y=..ndensity..))
      return(plot)
    }
    
    
    
  # Define ui logic ----
ui <- fluidPage(
  shinyWidgets::useShinydashboard(),
  shinyjs::useShinyjs(),
  titlePanel("Test application"),

  sidebarLayout(
    sidebarPanel(
      width=2,
      selectInput(
        inputId = "selected_grouping_variable",
        label = "Select grouping variable:",
        choices = c(
          "sample" = "sample",
          "condition (group)" = "group")),
      checkboxInput("show_comment",label = "Display comments?",value = FALSE),
      selectInput(
        inputId = "selected_grouping_variable_level",
        label = "Select certain condition:",
        choices = c(unique(data$sample))),#this is only a placeholder with hardcode
      checkboxInput("show_comment2",label = "Plot only selected condition?",value = FALSE)



                 ),
    mainPanel(
      box(
        width=8,
        plotlyOutput("distribution_plot", height = "450px"),
        div(id = "text_div",
            textOutput("textofinterest"),
            style="text-align: justify;")

        ),


    )
  )
)


# Define server logic ----
server <- function(input, output) {


  #select var to plot
  selected_variable_plot <- reactive({
    selected_grouping_variable <- switch(input$selected_grouping_variable,
                                         sample = "sample",
                                         group = "group")
  })


  selected_variable_capt <- shiny::reactive({
    selected_variable_2 <- switch(input$selected_grouping_variable,
                                             sample = "sample",
                                             group = "group")
  })



  # plot
  output$distribution_plot <- renderPlotly({
    distr_plot <- plot_distr(data = data,
                             groupby = selected_variable_plot())
    distr_plot <- ggplotly(distr_plot)

    return(distr_plot)
  })

  # caption
  whichcaption <- reactive(input$selected_grouping_variable)


  which_caption <- reactive({
    if (whichcaption()=="sample") {
      caption1 <- "I'm a Barbie girl, in a Barbie world"
    } else {
      caption2 <- "Life in plastic is fantastic!"
    }
  })

  # display comments or do not
  observe({
    toggle(id = "text_div", condition = input$show_comment)
    output$textofinterest <- renderText({
      which_caption()
    })
  })


}

# Run the app ----
shinyApp(ui = ui, server = server)

CodePudding user response:

Use pickerInput to choose one or more levels. Try this

# custom function for plotting data
plot_distr <- function(data, groupby=NA){
  plot <- ggplot2::ggplot(data,ggplot2::aes(x=length,color=!!rlang::sym(groupby))) 
    ggplot2::geom_line(stat="density",size=1,ggplot2::aes(y=..ndensity..))
  return(plot)
}



# Define ui logic ----
ui <- fluidPage(
  shinyWidgets::useShinydashboard(),
  shinyjs::useShinyjs(),
  titlePanel("Test application"),
  
  sidebarLayout(
    sidebarPanel(
      width=2,
      selectInput(
        inputId = "selected_grouping_variable",
        label = "Select grouping variable:",
        choices = c(
          "sample" = "sample",
          "condition (group)" = "group")),
      checkboxInput("show_comment",label = "Display comments?",value = FALSE),
      uiOutput("level"),
      # selectInput(
      #   inputId = "selected_grouping_variable_level",
      #   label = "Select certain condition:",
      #   choices = c(unique(data$sample))),#this is only a placeholder with hardcode
      checkboxInput("show_comment2",label = "Plot only selected condition?",value = FALSE)
      
      
      
    ),
    mainPanel(
      box(
        width=8,
        plotlyOutput("distribution_plot", height = "450px"),
        div(id = "text_div",
            textOutput("textofinterest"),
            style="text-align: justify;")
        
      ),
      
      
    )
  )
)


# Define server logic ----
server <- function(input, output) {
  
  observe({print(input$show_comment2)})
  #select var to plot
  selected_variable_plot <- reactive({
    selected_grouping_variable <- switch(input$selected_grouping_variable,
                                         sample = "sample",
                                         group = "group")
  })
  
  output$level <- renderUI({
    req(input$selected_grouping_variable)
    choices <- as.list(unique(data[[input$selected_grouping_variable]]))
    pickerInput(inputId = 'selected_grouping_variable_level',
                label = 'Select certain condition:',
                choices = choices, selected=choices[[1]], multiple = TRUE,
                options = list(`style` = "btn-success"))
  })
  
  selected_variable_capt <- shiny::reactive({
    selected_variable_2 <- switch(input$selected_grouping_variable,
                                  sample = "sample",
                                  group = "group")
  })
  
  mydata <- reactive({
    req(input$selected_grouping_variable_level)
    if (input$show_comment2){
      df <- data %>% mutate(newvar = !!sym(input$selected_grouping_variable)) %>% 
        dplyr::filter(newvar %in% input$selected_grouping_variable_level) %>% 
        select(-newvar)
    }else df <- data
    df
  })
  
  # plot
  output$distribution_plot <- renderPlotly({
    req(mydata(),selected_variable_plot())
    distr_plot <- plot_distr(data = mydata(), groupby = selected_variable_plot())
    distr_plot <- ggplotly(distr_plot)
    return(distr_plot)
  })
  
  # caption
  whichcaption <- reactive(input$selected_grouping_variable)
  
  
  which_caption <- reactive({
    if (whichcaption()=="sample") {
      caption1 <- "I'm a Barbie girl, in a Barbie world"
    } else {
      caption2 <- "Life in plastic is fantastic!"
    }
  })
  
  # display comments or do not
  observe({
    toggle(id = "text_div", condition = input$show_comment)
    output$textofinterest <- renderText({
      which_caption()
    })
  })
  
  
}

# Run the app ----
shinyApp(ui = ui, server = server)
  • Related