Shiny searchInput - r

Question

Does anyone know if it is possible to create a "shinyWidget :: searchInput" designed with a grid that would allow entering only 9 digits in the field?
https://pasteboard.co/J3mduIS.png

Answer 1

Here is a shiny implementation of bootstrap-pincode-input.
Download the files bootstrap-pincode-input.js and bootstrap-pincode-input.css from here. Put them in the www subfolder of the folder containing the shiny app.
Also add the JS file below to the www subfolder, call it pincodeBinding.js.
var pincodeBinding = new Shiny.InputBinding();
$.extend(pincodeBinding, {
find: function (scope) {
return $(scope).find(".pincode");
},
getValue: function (el) {
return $(el).val();
},
setValue: function(el, value) {
$(el).val(value);
},
subscribe: function (el, callback) {
$(el).on("change.pincodeBinding", function (e) {
callback();
});
},
unsubscribe: function (el) {
$(el).off(".pincodeBinding");
},
initialize: function(el) {
var $el = $(el);
$el.pincodeInput({
inputs: $el.data("ndigits"),
hidedigits: $el.data("hide"),
complete: function(value, e, errorElement){
Shiny.setInputValue($el.attr("id"), value);
}
});
}
});
Shiny.inputBindings.register(pincodeBinding);
Now, the shiny app:
library(shiny)
pincodeInput <- function(inputId, width = "30%", height = "100px",
label = NULL, ndigits = 4, hideDigits = FALSE){
tags$div(style = sprintf("width: %s; height: %s;", width, height),
shiny:::shinyInputLabel(inputId, label),
tags$input(id = inputId, class = "pincode", type = "text",
`data-ndigits` = ndigits,
`data-hide` = ifelse(hideDigits, "true", "false")
)
)
}
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "bootstrap-pincode-input.css"),
tags$script(src = "bootstrap-pincode-input.js"),
tags$script(src = "pincodeBinding.js")
),
br(),
pincodeInput("pincode", label = "Enter pincode"),
br(),
h3("You entered:"),
verbatimTextOutput("pincodeValue")
)
server <- function(input, output, session){
output[["pincodeValue"]] <- renderPrint({
input[["pincode"]]
})
}
shinyApp(ui, server)
Note that the pincode input only accepts digits, not alphabetical characters. I don't know whether this is what you want?
EDIT: clearable pincode input
Add this CSS file in the www folder, name it pincode-input.css:
.clearable {
padding: 1px 6px 1px 1px;
display: inline-flex;
}
.clearable span {
cursor: pointer;
color: blue;
font-weight: bold;
visibility: hidden;
margin-left: 5px;
}
Replace pincodeBinding.js with this file:
var pincodeBinding = new Shiny.InputBinding();
$.extend(pincodeBinding, {
find: function (scope) {
return $(scope).find(".pincode");
},
getValue: function (el) {
return $(el).val();
},
setValue: function(el, value) {
$(el).val(value);
},
subscribe: function (el, callback) {
$(el).on("change.pincodeBinding", function (e) {
callback();
});
},
unsubscribe: function (el) {
$(el).off(".pincodeBinding");
},
initialize: function(el) {
var $el = $(el);
var clearBtn = el.nextElementSibling;
$el.pincodeInput({
inputs: $el.data("ndigits"),
hidedigits: $el.data("hide"),
complete: function(value, e, errorElement){
Shiny.setInputValue($el.attr("id"), value);
},
change: function(){
clearBtn.style.visibility = ($el.val().length) ? "visible" : "hidden";
}
});
clearBtn.onclick = function() {
this.style.visibility = "hidden";
$el.pincodeInput().data("plugin_pincodeInput").clear();
Shiny.setInputValue($el.attr("id"), "");
};
}
});
Shiny.inputBindings.register(pincodeBinding);
The app:
library(shiny)
pincodeInput <- function(inputId, width = "30%", height = "100px",
label = NULL, ndigits = 4, hideDigits = FALSE){
tags$div(style = sprintf("width: %s; height: %s;", width, height),
shiny:::shinyInputLabel(inputId, label),
tags$span(
class = "clearable",
tags$input(id = inputId, class = "pincode", type = "text",
`data-ndigits` = ndigits,
`data-hide` = ifelse(hideDigits, "true", "false")
),
tags$span(title = "Clear", HTML("×"))
)
)
}
ui <- fluidPage(
tags$head(
tags$link(rel = "stylesheet", href = "bootstrap-pincode-input.css"),
tags$link(rel = "stylesheet", href = "pincode-input.css"),
tags$script(src = "bootstrap-pincode-input.js"),
tags$script(src = "pincodeBinding.js")
),
br(),
pincodeInput("pincode", label = "Enter pincode"),
br(),
h3("You entered:"),
verbatimTextOutput("pincodeValue")
)
server <- function(input, output, session){
output[["pincodeValue"]] <- renderPrint({
input[["pincode"]]
})
}
shinyApp(ui, server)