添加选项以滚动选定的项目，一旦使用selectizeInput完成

Question

我使用selectizeInput对输入进行多个选择。我还添加了一个“选择全部或无”选项，自动选择所有选项或非w选项(有很多选项)。然而，我的问题是，当它选择所有选项时，有太多的选项显示在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和内置的Select /取消选择所有选项(使用操作-框)如下：

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

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

完整的工作示例见下文：

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

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

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)