Dynamic Plots Based on One or More Dropdown Values 2

user_12027869 0
Viewed 45

This question is related to one I asked here: Dynamic Plots Based on One or More Dropdown Values. Although I got an answer from Mr.Rlover, the resulting plots do not look the same. If I choose two or more plots, it seems that the data is being added on and this is reflected exactly in the plots. I wonder how one would separate data based on different species.

one species selected two or more species selected

Below was my original question:

I am trying to make multiple dynamic plots (one does not know how many plots will output) based on one or more selected dropdown value(s) (species in this case).

I did succeed making plots based on the dropdown. For instance, two plots are displayed if a user selected two values/species from the dropdown list, one plot is displayed if one value/species is selected.

Although the number of plots match the number of dropdown values, the plots show a duplicate if two or more dropdown values/species are selected (it only works if exactly one value is selected). Any advice would be of great help.

The below code uses the iris dataset in R.

library(shiny)
library(shinyWidgets)
library(ggplot2)
library(tidyverse)
library(shinydashboard)


species = c("setosa", "versicolor", "virginica")

ui <- dashboardPage(
  dashboardHeader(title = "title"),
  
  sidebar <- dashboardSidebar(
    sidebarMenu(
      menuItem("General Overview", tabName = "tab1", icon = icon("dashboard"))
    )
  ),
  
  body <- dashboardBody(
    tabItems(
      tabItem(
        tabName = "tab1",
        uiOutput("species_dropdown"),
        # DT::dataTableOutput("table1"),
        uiOutput("plots")
      )
    )
  )
)

server <- function(input, output) {
  output$species_dropdown <- renderUI({
    pickerInput(
      "var1",
      "Species:",
      choices = species,
      options = pickerOptions(
        actionsBox = T,
        header = "Close",
        liveSearch = T
      ),
      multiple = T
    )
  })
  
  filtered_data <- reactive({
    iris %>% 
      filter(Species %in% input$var1) # I think is causing the problem
  })
  
  output$table1 <- DT::renderDataTable({
    req(input$var1)
    filtered_data()
  })
  
  # Insert the right number of plot output objects into the web page
  output$plots <- renderUI({
    req(input$var1)
    
    plot_output_list <- lapply(1:length(input$var1), function(i) {
      plotname <- paste("plot", i, sep="")
      plotOutput(plotname, height = 280, width = 250)
    })
    
    do.call(tagList, plot_output_list)
  })
  
  for (i in 1:length(species)) {
    
    local({
      my_i <- i #crucial
      
      plotname <- paste("plot", my_i, sep="") # use my_i instead of i
      
      output[[plotname]] <- renderPlot({
        
        ggplot(filtered_data(), aes(x = Sepal.Length, y = Sepal.Width)) + 
          geom_point() +
          labs(title = paste(input$var1[my_i], sep = ""), x = "Sepal Length", y = "Sepal Width") # title needs input$var1 indexed as paste will return a list otherwise, in which case only a first element gets used for the title hence all titles are identical
        
        
      })
    })
  }
  
}

shinyApp(ui, server)
shiny
2 Answers

By doing iris %>% filter(Species %in% input$var1) only one dataset was generated. We need one per number of Species.

Instead we create a list with each corresponding plot:

    filtered_data <- reactive({
        map(input$var1, ~
        iris %>% 
            filter(Species == .x)) 
    })

and subset it with filtered_data()[[index]]

Full app

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(tidyverse)

species <- c("setosa", "versicolor", "virginica")

ui <- dashboardPage(
  dashboardHeader(title = "title"),
  sidebar <- dashboardSidebar(
    sidebarMenu(
      menuItem("General Overview", tabName = "tab1", icon = icon("dashboard"))
    )
  ),
  body <- dashboardBody(
    tabItems(
      tabItem(
        tabName = "tab1",
        uiOutput("species_dropdown"),
        uiOutput("plots")
      )
    )
  )
)

server <- function(input, output) {
    
  output$species_dropdown <- renderUI({
    pickerInput(
      "var1",
      "Species:",
      choices = species,
      options = pickerOptions(
        actionsBox = T,
        header = "Close",
        liveSearch = T
      ),
      multiple = T
    )
  })

  filtered_data <- reactive({
    map(input$var1, ~
    iris %>%
      filter(Species == .x)) %>%
      set_names(input$var1) 
  })


  #Insert the right number of plot output objects into the web page
  output$plots <- renderUI({
    req(input$var1)

    plot_output_list <- lapply(input$var1, function(i) {
      plotname <- paste("plot_", i, sep = "")
      plotOutput(plotname, height = 280, width = 250)
    })

    do.call(tagList, plot_output_list)
  })
  
  observeEvent(filtered_data(), {
  iwalk(filtered_data(), ~{
    output[[paste0("plot_",.y)]] <<- renderPlot({
      ggplot(.x, aes(x = Sepal.Length, y = Sepal.Width)) +
        geom_point() +
        labs(title = .y, x = "Sepal Length", y = "Sepal Width")
    })
  })
  })
}

shinyApp(ui, server)
user_111687660

Using iris %>% filter(Species %in% input$var1[my_i]) directly inside local({}) was the key instead of using:

   filtered_data <- reactive({
     iris %>% 
       filter(Species %in% input$var1)
   })

  for (i in 1:length(species)) {
    local({
      my_i <- i 
      plotname <- paste("plot", my_i, sep="") 
      output[[plotname]] <- renderPlot({
        ggplot(iris %>% filter(Species %in% input$var1[my_i]), aes(x = Sepal.Length, y = Sepal.Width)) + 
          geom_point() +
          labs(title = paste(input$var1[my_i], sep = ""), x = "Sepal Length", y = "Sepal Width") 
      })
    })
  }
user_120278690
Related