how to control the values entered in selectizeInput in Shiny, making sure they belong to a predifined list?

Question

I would like that when user exits the selectizeInput field (clicks outside of selectizeInput), a new option is created and selected (option createOnBlur = TRUE), but I can't figure out how to control the created values to ensure they belong to the "choices" list.

In fact, I would like createOnBlur=TRUE working with create=FALSE, but this obviously doesn't work..

I have looked at selectize.js documentation and I think createFilter and/or onBlur() options could be useful but I didn't succeed in implementing it for my purpose.

Here is a reprex with an age input, I would like that when user tape e.g. "40" and then clik outside of input without pressing "Enter" (ie onBlur), the value 40 is recorded in the input, but if the user tape e.g "444", this impossible age value is not created in the list of choices :

library(shiny)

input_age <- function(mina = 0, maxa =100){
  
  selectizeInput(inputId = "age", 
                 label = "Age",
                 choices = c("choose one" = "", mina:maxa),
                 options = list(create = TRUE,
                                createOnBlur = TRUE)
                 
  ) 
  
}

ui <- shinyUI(fluidPage(
  
  titlePanel("selectize createonblur"),
  
  mainPanel(
    input_age(mina = 20, maxa = 70)
  ) 

))

# SERVER
server <- shinyServer(function(input, output) {
})

shinyApp(ui, server)

Answer 1

You can use updateSelectizeInput to check the selection made against the choices after each interaction with your input.

Please see the following:

library(shiny)

input_age <- function(mina = 0, maxa = 100){
  
  selectizeInput(inputId = "age", 
                 label = "Age",
                 choices = c("choose one" = "", mina:maxa),
                 options = list(create = TRUE,
                                createOnBlur = TRUE)
                 
  ) 
  
}

minAge <- 20
maxAge <- 70

ui <- shinyUI(fluidPage(
  
  titlePanel("selectize createonblur"),
  
  mainPanel(
    input_age(mina = minAge, maxa = maxAge)
  ) 
  
))

# SERVER
server <- shinyServer(function(input, output, session) {
  observeEvent(req(input$age), {
    if(length(setdiff(input$age, as.character(seq(minAge, maxAge)))) > 0){
      updateSelectizeInput(session,
                           inputId = "age",
                           choices = seq(minAge, maxAge),
                           selected = "")  
    }
  })
  
})

shinyApp(ui, server)

---

Update - Here is a JS approach:

library(shiny)

input_age <- function(mina = 0, maxa = 100){
  selectizeInput(inputId = "age", 
                 label = "Age",
                 choices = c("choose one" = "", mina:maxa),
                 options = list(create = TRUE,
                                createOnBlur = TRUE))
}

ui <- shinyUI(fluidPage(
  tags$head(tags$script(HTML("
                  $(document).on('shiny:inputchanged', function(event) {
                    if (event.name === 'age') {
                        if (isNaN(parseInt(event.value)) || event.value > 70 || event.value < 20) {
                        var $select = $('#age').selectize();
                        var selectize = $select[0].selectize;
                        selectize.setValue(null, true);
                        }
                    }
                  });
            "))),
  titlePanel("selectize createonblur"),
  mainPanel(
    input_age(mina = 20, maxa = 70)
  ) 
  
))

# SERVER
server <- shinyServer(function(input, output, session) {
})

shinyApp(ui, server)

Answer 2

You can supply a regular expression to the createFilter option. If the user types something which doesn't match this regular expression, then "Add ..." will not appear and it will not be possible to add this item.

library(shiny)

ui <- fluidPage(
  titlePanel("selectize createonblur"),
  mainPanel(
    selectizeInput(
      inputId = "age", 
      label = "Age",
      choices = c("choose one" = "", 20:70),
      options = list(
        create = TRUE,
        createOnBlur = TRUE,
        createFilter = I("/^([2-6][0-9]|70)$/")
      )
    ) 
  ) 
)

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

shinyApp(ui, server)