添加选项以在使用 selectizeInput 完成后滚动所选项目

Question

我正在使用 selectizeInput 对输入进行多项选择。我还添加了一个“全选或无”选项，该选项会自动选择所有选项或非选项（有很多选项）。但是，我的问题是，当它全选时，选项太多，以至于它在 selectizeInput 框中显示所有选项，这使我的页面超长，您必须滚动到底部才能查看我的应用程序中的其他任何内容。想知道是否有一个选项可以让您选择最大数量的项目，一旦达到，它会添加一个滚动条，以便所选项目不会全部显示并占据整个页面。有什么建议吗？

编辑：请参阅下文 这是我的下一个问题：当我使用 pickerInput 中的取消全选选项时，我需要以某种方式反映包含所有代码、不包含代码或包含某些代码的数据透视表。我的数据首先在一个表中，然后该表对输入做出反应。然后我的数据透视表使用了这些数据。这是一些代码：（这只是测试数据）

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)

我想要的逻辑是这样的：

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)]
}

Answer 1

除非您真的需要selectizeInput，否则我建议您使用shinyWidgets::pickerInput 和内置的全选/取消全选选项（使用操作框），如下所示：

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

然后

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

见shinyWidgets。

链接示例：

更新

编辑后。 您只需要这一行：

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

替换

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

全选/取消全选按钮为您完成所有工作。

完整的工作示例见下文：

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)

更新 2

在下面的 cmets 和您提供的虚拟数据之后，这就是我想出的。请测试：

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)