Restrict input type in shiny field

Question

As it is, numericInput accepts both string and numeric inputs. If a string is entered it is converted to NA (try with the code below). Is there a way of not allowing the user to type a string in a numeric field in shiny?

ui <- fluidPage(
  numericInput("num", label = "text not allowed", value = 1),
  verbatimTextOutput("value")
)

server <- function(input, output) {
  output$value <- renderPrint({ input$num })      
}

shinyApp(ui = ui, server = server)

So far, I have added a text output next to the numeric input that warns the user that only numbers are accepted if she enters a string in a numericInput field. This solution is far from ideal for me.

I want it to be impossible for the user to enter a character value in a numeric field.

Answer 1

You can add validate to your expression, so only number inputs will be allowed. I'm using windows 7 64-bit with Google Chrome (IE will work too)

Note: Shiny version 0.13.2, doesn't work on Firefox.

library(shiny)
ui <- fluidPage(
  numericInput("num", label = "text not allowed", value = 1),
  verbatimTextOutput("value")
)
server <- function(input, output) {

  numbers <- reactive({
    validate(
      need(is.numeric(input$num), "Please input a number")
    )
  })
  output$value <- renderPrint({ numbers() })      
}
shinyApp(ui = ui, server = server)

Answer 2

IMO the simplest way to accomplish that, it's adding the observer to your input, and when forbidden sign is detected (what probably requires your own function detecting forbidden signs), just delete it form input using updateInput feature.

Update:

observe({

if(is.null(input$myTextInput)) {
  vec <- NULL
  return()
} else vec <- input$myTextInput

  vec <- removeForbiddenSignsFunction(vec)

  updateTextInput(session, "myTextInput", value = vec)
})

Example of removing forbidden signs function (this one removes signs forbidden in Windows file names):

  removeForbiddenSignsFunction <- function(vec) {
  forbidden <- c("|", "?", "*")
  notAllowed <- c(">", "<", ":","/"," ")


  for(i in 1:length(forbidden)) {
    if(grepl(paste0("\\",forbidden[i]),vec)) {
      vec <- sub(paste0("\\",forbidden[i]),"",vec)
    }
  }

  for(i in 1:length(notAllowed)) {
    if(grepl(notAllowed[i],vec)) {
      vec <- sub(notAllowed[i],"",vec)
    }
  }

  if(grepl("\\\\",vec)) vec <- sub("\\\\","",vec)
  if(grepl("\"",vec)) vec <- sub("\"","",vec)

  return(vec)
}

It is splitted for forbidden and notAllowed due to regex special signs (not allowed in regular expressions and windows file names).

Answer 3

My solution was to use an observe() to monitor the input and replace it if it didn't meet the required parameters using updateNumericInput().

observe({
  if (!is.numeric(input$num)) {
    updateNumericInput(session, "num", 0)
  }
})

Answer 4

Here is a solution using HTML rather than Shiny. The solution is to add a pattern attribute to the HTML input tag. It will not remove the undesired characters, but the field will turn, say, pink to let the user know that an invalid character has been typed.

1-- Let the background becomes pink when invalid is raised. For that, we need to add a style in the CSS. In Shiny, this is achieved by adding in the ui a style tag in the head tag that will be attached to input[type='text']:invalid with

tags$head(
    tags$style(HTML("input[type='text']:invalid {background-color: pink;}"))
)

2-- create the ui with the above as well as a text input field, e.g.:

ui <- fluidPage(
    tags$head(
        tags$style(HTML("input[type='text']:invalid {background-color: pink;}"))
      ),
  textInput("mySolution", label = "Only letters are valid here", value = ""),
)

3-- modify this ui to add a pattern to the input tag:

ui <- searchreplaceit(ui, "input", list(id="mySolution"), 
        "input", list(pattern="[A-Za-z]*"), replace=FALSE)

This is it! the server function does not need anything, as validation is all performed whithin the page. Launch the page with

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

The function to add attributes to a tag is given here

searchreplaceit <- function(branch, whattag, whatattribs, totag, toattribs, replace=TRUE) {
    if ("name" %in% names(branch)) {
        if ((branch$name == whattag)&&(identical( branch$attribs[names(whatattribs)], whatattribs))) {
            branch$name    <- totag
            branch$attribs <- if (replace) {toattribs} else { modifyList(branch$attribs, toattribs)}
        }
    }
    if ("shiny.tag" %in% class(branch)) {
        if (length(branch$children)>0) for (i in 1: length(branch$children)) {
            if (!(is.null(branch$children[[i]]))) {
                branch$children[[i]] = searchreplaceit(branch$children[[i]], whattag, whatattribs, totag, toattribs, replace)
        } }
    } else if ("list" %in% class(branch)) {
        if (length(branch)>0) for (i in 1:length(branch) ) {
            if (!(is.null(branch[[i]]))) {
                branch[[i]] <- searchreplaceit(branch[[i]], whattag, whatattribs, totag, toattribs, replace)
        } }
    } 
    return(branch)
}

A related version was given in Edit a shiny.tag element

When you do not type a letter: