R блестящие фавориты в длинных списках selectInput

Question

Мне было интересно, как обращаться с длинными списками опций. Например, в приведенном ниже примере у меня есть подмножество опций в качестве избранных, но я хочу иметь возможность выбирать все опции, включая не являющиеся избранными. Как мне получить input $ selected, чтобы он возвращал то, что я выбрал последним на основе radiogroupbutton () и selectInput ()? Ура, Люк

РЕДАКТИРОВАТЬ: я хотел бы сохранить вид, который имеет радиокнопки и выпадающий список. Следовательно, я предполагаю, что оба будут нуждаться в различных inputID, которые затем могут быть (как-то) объединены на сайте сервера (как предложил Joris). Я не уверен, как их объединить на сайте сервера и как определить, что было выбрано последним.

ALL.options <- apply(expand.grid(LETTERS, LETTERS), 1, function(x){paste(x, collapse="")})
favourites <- sample(ALL.options, 20)




ui <- fluidPage(

  h3("Favourites:"),
      radioGroupButtons(inputId="selected", 
                        choices = sort(favourites), 
                        individual = TRUE, 
                        selected = NULL, 
                        width="20%"),

  selectInput(inputId="selected", label = "Other options",
              choices = ALL.options, 
              selected = NULL),

    h3("THIS IS YOUR SELECTION:"),

  verbatimTextOutput("choice")

)

)

server <- function(input, output) {

output$choice <- renderPrint(
  input$selected
  )

}

shinyApp(ui, server)

Answer 1

Возможно, достаточно использовать один selectInput или selectizeInput, в котором перечислены Избранное и Другие параметры в отдельных группах параметров (см., Например, Shiny: Группы параметровдля выбора входа ):

library(shiny)

ALL.options <- apply(expand.grid(LETTERS, LETTERS), 1, function(x){paste(x, collapse="")})
favourites <- sample(ALL.options, 20)


ui <- fluidPage(

    selectizeInput(inputId = "selected", label = "All options", choices = list(
            Favourites = favourites,
            `Other options` = setdiff(ALL.options, favourites)
        ), 
        options = list(
            placeholder = '<None selected>',
            onInitialize = I('function() { this.setValue(""); }')
        )
    ),

    h3("THIS IS YOUR SELECTION:"),

    verbatimTextOutput("choice")

)

server <- function(input, output) {

  output$choice <- renderPrint({

        validate(need(input$selected, "None selected"))

        input$selected

      })

}

shinyApp(ui, server)

---

Примечание: если вместо этого вы используете два отдельных входа (radioGroupButtons и selectInput), вы можете объединить выбранные варианты на стороне сервера в реактивобъект.Например:

library(shiny)
library(shinyWidgets)

ALL.options <- apply(expand.grid(LETTERS, LETTERS), 1, function(x){paste(x, collapse="")})
favourites <- sample(ALL.options, 20)

ui <- fluidPage(

    h3("Favourites:"),
    radioGroupButtons(inputId = "radio", 
        choices = sort(favourites), 
        individual = TRUE, 
        selected = character(0), 
        width="20%"),

    selectizeInput(inputId="select", label = "Other options",
        choices = ALL.options,
        options = list(
            placeholder = '<None selected>',
            onInitialize = I('function() { this.setValue(""); }')
        )
    ),  

    h3("THIS IS YOUR SELECTION:"),

    verbatimTextOutput("choice")

)

server <- function(input, output) {

  ## initialize reactive value
  currentSelected <- reactiveVal(NULL)

  ## update based on radioGroupButtons
  observeEvent(input$radio, {

        currentSelected(input$radio)

      })

  ## update based on selectInput
  observeEvent(input$select, {

        currentSelected(input$select)

      })

  output$choice <- renderPrint({

        validate(need(currentSelected(), "None selected"))

        currentSelected()

      })

}

shinyApp(ui, server)

^{Создано в 2019-06-17 с помощью пакета Представить (v0.3.0)}

Answer 2

Я не уверен, полностью ли я понимаю, чего вы пытаетесь достичь. Я также заметил, что и radioGroupButtons, и selectInput имеют одинаковые inputId. Если идея состоит в том, чтобы напечатать оба варианта, вы можете изменить inputId из selectInput, чтобы сказать, select и просто изменить renderPrint как:

output$choice <- renderPrint(
    c(input$selected, input$select)

  )

Это то, что вы ищете?