Home > Software engineering >  render plot before completing interactive selections with selectizeInput in shiny
render plot before completing interactive selections with selectizeInput in shiny

Time:08-31

I would like r shiny to generate graphics without requiring all selectizeInput fields. In this way I'd like the first plot to be general (a plot of vehicles of all cyl values within a class), and then tailor the plot to be more specific with the ability to view only cyl values of interest. My code does not currently generate a plot until the second (cyl) selection is made.

To be as specific as possible here is what I'm hoping to produce:

  1. An app that initiates with class 'compact' and a plot of 'year' vs. 'hwy' for ALL values of 'cyl'
  2. The ability to select a subset of 'cyl' values using the second dropdown box

Reproducible code is below.

library(shiny)
library(tidyverse)


data("mpg")
mpg


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectizeInput("loc_lev_1", label = "Vehicle Type", choices = unique(mpg$class)),
      
      selectizeInput("loc_lev_2", label = "cyl", choices = unique(mpg$cyl),
                     multiple = TRUE, selected = NULL),
      
      
    ),
    
    mainPanel(
      plotOutput("plot")
    )
  )
)


server <- function(input, output, session) {
  
  loc_lev_1 <- reactive({
    filter(mpg, class == input$loc_lev_1)
  })
  
  observeEvent(loc_lev_1(), {
    choices <- unique(loc_lev_1()$cyl)
    updateSelectizeInput(session, "loc_lev_2", choices = choices)
  })
  
  output$plot <- renderPlot({
    
    mpg %>%
      filter(class == input$loc_lev_1) %>%
      filter(cyl %in% input$loc_lev_2) %>%
      
      ggplot(aes(x = year, y = hwy))    
      geom_point()  
      geom_smooth()  
      
      labs(title = paste(input$loc_lev_1))  
      theme_minimal()  
      theme(legend.position = "bottom", plot.subtitle = element_text(hjust = 0.5),
            plot.title = element_text(hjust = 0.5), panel.grid.minor=element_blank())
    
  })
  
}


shinyApp(ui, server)

Thanks for any help you can provide.

CodePudding user response:

You can just check if input$loc_lev_2 is not null; in that case add the filter on cylinder, otherwise dont. Here is an example:

get_plot <- function(car_class, cylinder) {

  gginput <- filter(mpg, class==car_class)
  if(!is.null(cylinder)) {
    gginput <- filter(gginput, cyl %in% cylinder)
  }

  p <- ggplot(data = gginput, aes(x = year, y = hwy))  
    geom_point()  
    geom_smooth()  

    labs(title = paste(car_class))  
    theme_minimal()  
    theme(legend.position = "bottom", plot.subtitle = element_text(hjust = 0.5),
        plot.title = element_text(hjust = 0.5), panel.grid.minor=element_blank())

  return(p)
}

Then render like this:

output$plot <- renderPlot(get_plot(input$loc_lev_1, input$loc_lev_2))

You can see split the logic out into a function, but it is not necessary; you can keep it all in the renderPlot() call if you like.

Full Code:

library(shiny)
library(tidyverse)


data("mpg")

get_plot <- function(car_class, cylinder) {

  gginput <- filter(mpg, class==car_class)
  if(!is.null(cylinder)) {
    gginput <- filter(gginput, cyl %in% cylinder)
  }

  p <- ggplot(data = gginput, aes(x = year, y = hwy))  
    geom_point()  
    geom_smooth()  

    labs(title = paste(car_class))  
    theme_minimal()  
    theme(legend.position = "bottom", plot.subtitle = element_text(hjust = 0.5),
        plot.title = element_text(hjust = 0.5), panel.grid.minor=element_blank())

  return(p)
}


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectizeInput("loc_lev_1", label = "Vehicle Type", choices = unique(mpg$class)),

      selectizeInput("loc_lev_2", label = "cyl", choices = unique(mpg$cyl),
                     multiple = TRUE, selected = NULL),


    ),

    mainPanel(
      plotOutput("plot")
    )
  )
)


server <- function(input, output, session) {

  loc_lev_1 <- reactive({
    filter(mpg, class == input$loc_lev_1)
  })

  observeEvent(loc_lev_1(), {
    choices <- unique(loc_lev_1()$cyl)
    updateSelectizeInput(session, "loc_lev_2", choices = choices)
  })

  output$plot <- renderPlot(get_plot(input$loc_lev_1, input$loc_lev_2))

}


shinyApp(ui, server)
  • Related