Retaining existing selection in filtered shiny plotly scatter plot

Question

I'm attempting to make a filtered scatter plot in shiny and am nearly ready to integrate it into my main project, however, whenever the selection changes the filter-dependent selections reset to their default settings.

For context my example uses the Iris data set, displaying each petal width as selectable to plot and allowing you to look at the petal length associated with those widths independently. The problem is whenever I change what pedal width is selected petal length resets to its default.

I think that this could result in an error where I'm looking for a length that isn't a valid option with my example data however for my project use case this would be extremely helpful.

Attached is my code in its current state.

library(shinydashboard)
library(shinyWidgets)
library(plotly)
library(shiny)

#______________________________________________________________________________#
server <- function(input, output, session) { 
    df <- reactive({
        subset(iris, Petal.Width %in% input$Petalw)
    })
    
    # Extract list of Petal Lengths from selected data - to be used as a filter
    p.lengths <- reactive({
        unique(df()$Petal.Length)
    })
    
    # Filter based on Petal Length
    output$PetalL <- renderUI({
        pickerInput("PetalLengthSelector", "PetalLength", as.list(p.lengths()), as.list(p.lengths()), options = list(`actions-box` = TRUE),multiple = T)
        
    })
    
    # Subset this data based on the values selected by user
    df_1 <- reactive({
        foo <- subset(df(), Petal.Length %in% input$PetalLengthSelector)
        return(foo)
    })
    
    #output table
    output$table <- DT::renderDataTable(
        DT::datatable(df_1(), options = list(searching = FALSE,pageLength = 25))
    )
    #output scatter plot
    
    output$correlation_plot <- renderPlotly({
        fig <- plot_ly(
            data = df_1(),
            x = ~Sepal.Length, 
            y = ~Sepal.Width, 
            type = 'scatter', 
            mode = 'markers',
            #mode ="lines+markers",
            color =~Petal.Length,
            text = ~paste("Sepal.Length:",Sepal.Length,"<br>",
                          "Sepal.Width:",Sepal.Width,"<br>",
                          "Petal.Length:",Petal.Length,"<br>",
                          "Petal.Width:",Petal.Width,"<br>",
                          "Species:",Species),
            hoverinfo = 'text'
        ) 
        
    })
    
}

#______________________________________________________________________________#
ui <- navbarPage(
    title = 'Select values in two columns based on two inputs respectively',
    
    fluidRow(
        column(width = 12,
               plotlyOutput('correlation_plot')
        )
    ),
    
    
    fluidRow(
        column(width = 6,
               pickerInput("Petalw","PetalWidth", choices = unique(iris$Petal.Width),selected = unique(iris$Petal.Width), options = list(`actions-box` = TRUE),multiple = T)
        ),
        column(width = 6,
               uiOutput("PetalL")
        )
    ),
    
    fluidRow(
        column(12,
               tabPanel('Table', DT::dataTableOutput('table'))
        )
    )
)
shinyApp(ui, server)

score 1 · Answer 1 · answered Jul 08 '21 at 16:19

I would define df dataframe as a eventReactive object with a new actionButton. This way it only updates when you click on the actionButton. Then you can avoid updating the second pickerInput while still selecting items in the first pickerInput. Try this

library(shinydashboard)
library(shinyWidgets)
library(tidyverse)
library(plotly)
library(shiny)
library(DT)

#______________________________________________________________________________#
server <- function(input, output, session) {
  df <- eventReactive(input$update, {
    req(input$Petalw)
    subset(iris, Petal.Width %in% input$Petalw)
  })
  
  # Extract list of Petal Lengths from selected data - to be used as a filter
  p.lengths <- reactive({
    req(df())
    unique(df()$Petal.Length)
  })
  
  # Filter based on Petal Length
  output$PetalL <- renderUI({
    req(p.lengths())
    pickerInput("PetalLengthSelector", "PetalLength", 
                choices = as.list(p.lengths()), 
                selected = as.list(p.lengths()),
                options = list(`actions-box` = TRUE),multiple = T)
    
  })
  
  # Subset this data based on the values selected by user
  df_1 <- reactive({
    req(df(),input$PetalLengthSelector)
    foo <- subset(df(), Petal.Length %in% input$PetalLengthSelector)
    return(foo)
  })
  
  output$table <- DT::renderDataTable(
    DT::datatable(df_1(), options = list(searching = FALSE,pageLength = 25))
  )
  
  ### this works
  
  # output$correlation_plot <- renderPlotly({
  #   req(df_1())
  #   text = paste("Sepal.Length:",df_1()$Sepal.Length,"<br>",
  #                "Sepal.Width:", df_1()$Sepal.Width,"<br>",
  #                "Petal.Length:",df_1()$Petal.Length,"<br>",
  #                "Petal.Width:", df_1()$Petal.Width,"<br>",
  #                "Species:",df_1()$Species)
  #   plot1 <- plot_ly(data=df_1(),
  #                    x = ~Petal.Length,
  #                    y = ~Petal.Width,
  #                    type = 'scatter',
  #                    mode = "markers",
  #                    color =~Petal.Length,
  #                    text = text,
  #                    hoverinfo = 'text'
  #                    
  #   )
  # })
  
  output$correlation_plot <- renderPlotly({
    fig <- plot_ly(
      data = df_1(),
      x = ~Sepal.Length, 
      y = ~Sepal.Width, 
      type = 'scatter', 
      mode = 'markers',
      color =~Petal.Length,
      text = ~paste("Sepal.Length:",Sepal.Length,"<br>",
                    "Sepal.Width:",Sepal.Width,"<br>",
                    "Petal.Length:",Petal.Length,"<br>",
                    "Petal.Width:",Petal.Width,"<br>",
                    "Species:",Species),
      hoverinfo = 'text'
    ) 
    
  })
  

}

#______________________________________________________________________________#
ui <- navbarPage(
  title = 'Select values in two columns based on two inputs respectively',
  
  fluidRow(
    column(width = 12,
           plotlyOutput('correlation_plot')
    )
  ),
  
  
  fluidRow(
    column(width = 3,
           pickerInput("Petalw","PetalWidth", choices = unique(iris$Petal.Width),selected = c("PetalWidth"), options = list(`actions-box` = TRUE),multiple = T)
    ),
    column(2, actionBttn("update","Update")), column(2,""),
    column(width = 5,
           uiOutput("PetalL")
    )
  ),
  tags$style(type='text/css', "#update { width:100%; margin-top: 25px;}"),   ### aligning action button with pickerInput
  fluidRow(
    column(12,
           tabPanel('Table', DT::dataTableOutput('table'))
    )
  )
)
shinyApp(ui, server)

I appreciate the attempt but my particular goal would be for the second `pickerInput` to retain its selection after new information has been provided not delay the update. — Nicholas Darden, Jul 08 '21 at 16:27

Retaining existing selection in filtered shiny plotly scatter plot

1 Answers1