Add option to scroll selected items once done using selectizeInput

问题

I'm using selectizeInput to have multiple selections for an input. I have also added a "Select All or None" option that automatically selects all options or nonw (there are A LOT of options). However, my issue is that when it selects all, there are so many options that it shows all of them in the selectizeInput box and it makes my page super long and you have to scroll to the bottom to see anything else in my app. Wondering if there's an option that allows you to have a max number of items selected, and once that is reached, it adds a scroll bar so that the selected items don't all show up and take up the whole page. Any suggestions?

EDIT: REFER TO THE BELOW Here is my next issue: when i utilize the deselect all option from pickerInput, I need to somehow reflect that for the pivot table that either includes all the tickers, includes none of the tickers, or includes some of the tickers. My data is first in a table and then that table is reactive to the inputs. My pivot table then used this data. here is some code: (this just test data)

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

ext <- reactive ({
    name <- c('a', 'b', 'c', 'd', 'e', 'f', 'g')
    shortcut <- c('aa', 'bb', 'cc', 'dd', 'ee', 'ff', 'gg')
    counter <- c('aaaa', 'bbbb', 'cccc', 'dddd', 'eeee', 'ffff', 'gggg')
    external <- data.frame(name, shortcut, counter)
    return(external)   
})

selections <- reactive({
    temp1 = ext()
    tick <- sort(unique(temp1$counter))
    tick <- tick[order((tick), decreasing = FALSE)]
    list1 <- list(tick = tick)
    return(list1)   
})

# making this reactive to inputs and run button   
extFiltered <- eventReactive(input$runButton, {
    filteredTable <- ext()
    if(!is.null(input$tick)){
      filteredTable <- filteredTable[(filteredTable$counter %in% input$tick)]
    }
    return(filteredTable)   
})

observe({
    updatePickerInput(session, 'tick', choices = selections()$tick)   
})

# external table that has been filtered from input   
output$table <- DT::renderDataTable({ extFiltered() })

# pivot table   
output$extPt <- renderPivottabler({
    temp = extFiltered()
    extPt <- PivotTable$new()
    extPt$addData(temp)
    extPt$addColumnDataGroups("name")
   extPt$addRowDataGroups("shortcut")
    extPt$addRowDataGroups("counter")
    extPt$evaluatePivot()
    pivottabler(extPt)   
})

}

ui <- fluidPage(   
pickerInput(inputId = 'tick', label = 'Select Ticker(s)', choices = NULL, 
options = list(`actions-box` = TRUE, 'live-search' = TRUE), multiple = TRUE) 
)

shinyApp(ui, server)

The logic I would like is something like this:

if(input$tick == 'Deselect All') {
  filteredTable <- subset(filteredTable, select=-c(filteredTable$counter))
}
else if(input$tick == 'Select All') {
  filteredTable <- filteredTable[(filteredTable$counter)]
}
else {
  filteredTable <- filteredTable[(filteredTable$counter %in% input$tick)]
}
# which would replace this:

if(!is.null(input$tick)){
  filteredTable <- filteredTable[(filteredTable$counter %in% input$tick)]
}

回答1:

Unless you really require selectizeInput I would suggest using shinyWidgets::pickerInput with a Select All/Deselect All option built in (using actions-box) as below:

pickerInput(
  inputId = 'tick', 
  label = 'Select Ticker(s)', 
  choices = NULL, 
  options = list(
    `actions-box` = TRUE,
    `live-search` = TRUE
  ), 
  multiple = TRUE
)

and then

updatepickerInput(session, 'tick', choices = selections()$tick, 
                     selected = if(input$includeAllTick) selections()$tick)

See shinyWidgets.

Example from the link:

Update

After your edit. All you should need is this line:

filteredTable <- filteredTable[(filteredTable$counter %in% input$tick),]

to replace

if(!is.null(input$tick)){
  filteredTable <- filteredTable[(filteredTable$counter %in% input$tick),]
}

The Select All/Deselect All buttons do all the work for you.

See below for full working example:

library(shiny)
library(DT)
library(pivottabler)
library(shinyWidgets)

ext <- data.frame(
  name = c('a', 'b', 'c', 'd', 'e', 'f', 'g'),
  shortcut = c('aa', 'bb', 'cc', 'dd', 'ee', 'ff', 'gg'),
  counter = c('aaaa', 'bbbb', 'cccc', 'dddd', 'eeee', 'ffff', 'gggg'),
  stringsAsFactors = FALSE
)

ui <- fluidPage(   
  pickerInput(inputId = 'tick', label = 'Select Ticker(s)', choices = NULL, 
              options = list(`actions-box` = TRUE, 'live-search' = TRUE), multiple = TRUE),
  actionButton(inputId = 'runButton', label = 'Run'),
  DT::dataTableOutput('table'),
  pivottablerOutput('extPt')
)

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

  selections <- reactive({
    temp1 = ext
    tick <- sort(unique(temp1$counter))
    tick <- tick[order((tick), decreasing = FALSE)]
    list1 <- list(tick = tick)
    return(list1)   
  })

  # making this reactive to inputs and run button   
  extFiltered <- eventReactive(input$runButton, {
    filteredTable <- ext
    filteredTable <- filteredTable[(filteredTable$counter %in% input$tick),]
    return(filteredTable)   
  })

  observe({
    updatePickerInput(session, 'tick', choices = selections()$tick)   
  })

  # external table that has been filtered from input   
  output$table <- DT::renderDataTable({ extFiltered() })

  # pivot table   
  output$extPt <- renderPivottabler({
    temp = extFiltered()
    extPt <- PivotTable$new()
    extPt$addData(temp)
    extPt$addColumnDataGroups("name")
    extPt$addRowDataGroups("shortcut")
    extPt$addRowDataGroups("counter")
    extPt$evaluatePivot()
    pivottabler(extPt)   
  })

}

shinyApp(ui, server)

Update 2

After your comments below and the dummy data you have supplied this is what I have come up with. Please test:

library(shiny)
library(DT)
library(pivottabler)
library(shinyWidgets)
library(dplyr)

ext <- data.frame(
    name = c('a', 'b', 'c', 'd', 'e', 'f', 'g'),
    shortcut = c('aa', 'bb', 'cc', 'dd', 'ee', 'ff', 'gg'),
    counter = c('aaaa', 'bbbb', 'cccc', 'dddd', 'eeee', 'ffff', 'gggg'),
    stringsAsFactors = FALSE
)

ui <- fluidPage(   
    pickerInput(inputId = 'tick', label = 'Select Ticker(s)', choices = NULL, 
                options = list(`actions-box` = TRUE, 'live-search' = TRUE), multiple = TRUE),
    actionButton(inputId = 'runButton', label = 'Run'),
    DT::dataTableOutput('table'),
    pivottablerOutput('extPt')
)

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

    selections <- reactive({
        temp1 = ext
        tick <- sort(unique(temp1$counter))
        tick <- tick[order((tick), decreasing = FALSE)]
        list1 <- list(tick = tick)
        return(list1)   
    })

    # making this reactive to inputs and run button   
    extFiltered <- eventReactive(input$runButton, {
        filteredTable <- ext
        filteredTable <- filteredTable[(filteredTable$counter %in% input$tick),]
        return(filteredTable)   
    })

    observe({
        updatePickerInput(session, 'tick', choices = selections()$tick)   
    })

    # external table that has been filtered from input   
    output$table <- DT::renderDataTable({ extFiltered() })

    # pivot table   
    output$extPt <- renderPivottabler({
        temp = ext %>% 
            select('name', 'shortcut') %>% 
            left_join(extFiltered(), by = c('name', 'shortcut'))
        if(all(is.na(temp$counter))){
            temp = ext %>% 
                select('name', 'shortcut')
            extPt <- PivotTable$new()
            extPt$addData(temp)
            extPt$addColumnDataGroups("name")
            extPt$addRowDataGroups("shortcut")
            # extPt$addRowDataGroups("counter")
            extPt$evaluatePivot()
            pivottabler(extPt)   
        }else{
            temp$counter[is.na(temp$counter)] <- ''
            extPt <- PivotTable$new()
            extPt$addData(temp)
            extPt$addColumnDataGroups("name")
            extPt$addRowDataGroups("shortcut")
            extPt$addRowDataGroups("counter")
            extPt$evaluatePivot()
            pivottabler(extPt)   
        }
    })

}

shinyApp(ui, server)

来源：https://stackoverflow.com/questions/57485223/add-option-to-scroll-selected-items-once-done-using-selectizeinput