18 Develop custom input widgets
In the previous chapter, we built template dependencies, the page skeleton, as well as containers like cards. Now is a great time to integrate new inputs, leveraging all knowledge from Chapter 12.
18.1 Tabler action button
Let’s start with a simple input: the action button. Tabler has built-in HTML buttons with a substantial amount of custom styles, compared to the classic Shiny action button.
18.1.2 Application to Tabler
First of all, let’s compare the tabler HTML button to the Shiny action button.
<button class="btn btn-primary">Button</button>We convert it to R code. The button API contains more style and we leave the reader to add extra elements as an exercise.
tabler_button <- function(inputId, label, status = NULL,
icon = NULL, width = NULL, ...) {
# SEE BELOW
}In Tabler, the button status is mandatory, which is the reason why it is a function parameter. We assume that by default, the button has a blue color, which is given by btn-primary:
btn_cl <- paste0(
"btn action-button",
if (is.null(status)) {
" btn-primary"
} else {
paste0(" btn-", status)
}
)Moreover, we add an horizontal right margin to the icon, if provided so that the label renders well (mr-1, where m stands for margin, r is the right direction and 1 is the margin value).
# custom right margin
if (!is.null(icon)) icon$attribs$class <- paste0(
icon$attribs$class, " mr-1"
)The button tag is identical to that of Shiny, which is the reason why we don’t show it here. The whole code may be found here.
### RUN ###
# OSUICode::run_example(
# "tabler/button",
# package = "OSUICode"
# )
### APP CODE ###
library(shiny)
library(OSUICode)
ui <- tabler_page(
tabler_body(
tabler_button(
"btn",
textOutput("val"),
icon = icon("thumbs-up"),
width = "25%"
)
)
)
server <- function(input, output, session) {
output$val <- renderText({
paste("Value:", input$btn)
})
}
shinyApp(ui, server)We easily check that clicking on the button increments the related input. Thus, one may see how easy it is to implement a Tabler input button, built on top of the Shiny action button. The output is shown in Figure 18.1.
FIGURE 18.1: Tabler action button.
As a general rule, don’t try to reinvent the wheel and see whether any existing Shiny element may be used instead.
18.2 Toggle Switch
We implement the toggle switch component. The HTML structure may be inspected here (or in demo/form-elements.html if you already downloaded the repository locally).
<label class="form-check form-switch">
<input class="form-check-input" type="checkbox" checked>
<span class="form-check-label">Option 1</span>
</label>Notice that the tabler switch has the checkbox type, which is very similar to the Shiny checkbox (a switch being a checkbox with a different style):
checkboxInput("test", "Test", TRUE)#> <div class="form-group shiny-input-container">
#> <div class="checkbox">
#> <label>
#> <input id="test" type="checkbox" checked="checked"/>
#> <span>Test</span>
#> </label>
#> </div>
#> </div>Therefore, we should again be able to build on top of an existing input binding. We create the tabler_switch() function.
tabler_switch <- function(inputId, label, value = FALSE,
width = NULL) {
# SEE BELOW
}We start to recover any possible bookmarked value with restoreInput():
value <- restoreInput(id = inputId, default = value)Then, in line with the above HTML structure, we design the input tag. If we want to reuse the shiny::checkboxInput() binding, we must not forget the type = checkbox:
$.extend(checkboxInputBinding, {
find: function(scope) {
return $(scope).find('input[type="checkbox"]');
}
// other methods
});
input_tag <- tags$input(
id = inputId,
type = "checkbox",
class = "form-check-input"
)We conditionally add a checked attribute depending on the current value parameter:
if (!is.null(value) && value) {
input_tag <- tagAppendAttributes(
input_tag,
checked = "checked"
)
}We proceed to the main wrapper creation, which has a label tag having the form-check form-switch class, as well as an optional width parameter:
input_wrapper <- tags$label(
class = "form-check form-switch",
style = if (!is.null(width)) {
paste0("width: ", validateCssUnit(width), ";")
}
)We finally put everything together with tagAppendChildren(), the whole code being accessible here:
tagAppendChildren(
input_wrapper,
input_tag,
span(class = "form-check-label", label)
)Besides, we may also create an update_tabler_switch() function similar to the updateCheckboxInput(). We leverage OSUICode::dropNulls(), a function that removes all NULL elements from a list. If you remember, the session$sendInputMessage from R is received by the receiveMessage method on the JavaScript side:
update_tabler_switch <- function (session, inputId,
label = NULL,
value = NULL) {
message <- dropNulls(list(label = label, value = value))
session$sendInputMessage(inputId, message)
}In the following example, the action button toggles the switch input value when clicked, as shown in Figure 18.2.
### RUN ###
# OSUICode::run_example(
# "tabler/switch",
# package = "OSUICode"
# )
### APP CODE ###
library(shiny)
library(OSUICode)
ui <- tabler_page(
tabler_body(
fluidRow(
tabler_button(
"update",
"Go!",
width = "25%",
class = "mr-2"
),
tabler_switch(
"toggle",
"Switch",
value = TRUE,
width = "25%"
)
)
)
)
server <- function(input, output, session) {
observe(print(input$toggle))
observeEvent(input$update, {
update_tabler_switch(
session,
"toggle",
value = !input$toggle
)
})
}
shinyApp(ui, server)
FIGURE 18.2: Tabler action button updating a toggle input.
Et voilà! Two inputs in just a few minutes.
18.4 Exercises
- Have a look at the Tabler documentation about buttons and extend the
tabler_buttonfunction accordingly. - Propose an implementation of the
Advanced selectboxesshown here and Figure 18.3.
FIGURE 18.3: Advanced select input with user image.
- Cards are central elements of all templates. So are tabset panels. Try to modify the
tabler_card()function to create atabler_tab_card()function, adding tab navigation within the card header.