Here is a basic 9 radio buttons question in Shiny:
Is it possible to format these same 9 options into two labelled groups, with the second group occupying two columns?
library(shiny)
ui <- bootstrapPage(
theme = bs_theme(version = 5,
# bootswatch = "flatly",
"font-scale" = 1.0),
div(class = "container-fluid",
div(class = "row",
div(,
prettyRadioButtons(
inputId = "travel_region",
label = "Group 1",
selected = NULL,
status = "primary",
shape = c("round"),
width = NULL,
choices = LETTERS[1:9]
)
)
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
R Script where "None of the above" breaks the 2 column format (See comments)
library(shiny)
library(bslib)
library(shinyWidgets)
library(htmltools)
prettyRadioButtons9 <- function (
inputId, label, choices = NULL, selected = NULL, status = "primary",
shape = c("round", "square", "curve"), outline = FALSE,
fill = FALSE, thick = FALSE, animation = NULL, icon = NULL,
plain = FALSE, bigger = FALSE, inline = FALSE, width = NULL,
choiceNames = NULL, choiceValues = NULL)
{
status <- match.arg(status, c("default", "primary", "success",
"info", "danger", "warning"))
shape <- match.arg(shape)
if (is.null(choices) && is.null(choiceNames) && is.null(choiceValues)) {
choices <- character(0)
}
args <- shinyWidgets:::normalizeChoicesArgs(choices, choiceNames, choiceValues)
selected <- shiny::restoreInput(id = inputId, default = selected)
selected <- if (is.null(selected)) {
args$choiceValues[[1]]
}
else {
as.character(selected)
}
if (length(selected) > 1)
stop("The 'selected' argument must be of length 1")
options1 <- shinyWidgets:::generatePretty(
inputId = inputId, selected = selected,
inline = inline, type = "radio", choiceNames = args$choiceNames[1:3],
choiceValues = args$choiceValues[1:3], status = status, shape = shape,
outline = outline, fill = fill, thick = thick, animation = animation,
icon = icon, plain = plain, bigger = bigger
)
options2 <- shinyWidgets:::generatePretty(
inputId = inputId, selected = selected,
inline = inline, type = "radio",
choiceNames = c("Amsterdam", "Frankfurt", "London"),
choiceValues = c("amsterdam", "frankfurt", "london"),
status = status, shape = shape,
outline = outline, fill = fill, thick = thick, animation = animation,
icon = icon, plain = plain, bigger = bigger
)
options3 <- shinyWidgets:::generatePretty(
inputId = inputId, selected = selected,
inline = inline, type = "radio",
choiceNames = c("Amsterdam", "Frankfurt", "None of the above"),
choiceValues = c("amsterdam", "frankfurt", "london"),
status = status, shape = shape,
outline = outline, fill = fill, thick = thick, animation = animation,
icon = icon, plain = plain, bigger = bigger
)
options <- tags$div(
tags$div(
tags$fieldset(
tags$legend("Group 1"),
options1
)
),
tags$div(
tags$fieldset(
tags$legend("Group 2"),
tags$div(
style = "display: inline-block;",
options2
),
tags$div(
style = "display: inline-block;",
options3
)
)
)
)
divClass <- "form-group shiny-input-radiogroup shiny-input-container"
if (inline)
divClass <- paste(divClass, "shiny-input-container-inline")
radioTag <- htmltools::tags$div(id = inputId, style = if (!is.null(width))
paste0("width: ", validateCssUnit(width), ";"), class = divClass,
tags$label(class = "control-label", `for` = inputId,
class = if (is.null(label))
"shiny-label-null", label), options)
shinyWidgets:::attachShinyWidgetsDep(radioTag, "pretty")
}
ui <- bootstrapPage(
theme = bs_theme(version = 5,
# bootswatch = "flatly",
"font-scale" = 1.0),
div(class = "container-fluid",
div(class = "row",
div(class = "col-12",
prettyRadioButtons9(
inputId = "travel_region",
label = NULL,
selected = NULL,
status = "primary",
shape = c("round"),
width = NULL,
choices = LETTERS[1:9]
)
)
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
CodePudding user response:
I did a modification of the prettyRadioButtons
function. But this is only specific to your case (3 / 3-3).
library(shiny)
library(bslib)
library(shinyWidgets)
library(htmltools)
prettyRadioButtons9 <- function (
inputId, label, choices = NULL, selected = NULL, status = "primary",
shape = c("round", "square", "curve"), outline = FALSE,
fill = FALSE, thick = FALSE, animation = NULL, icon = NULL,
plain = FALSE, bigger = FALSE, inline = FALSE, width = NULL,
choiceNames = NULL, choiceValues = NULL)
{
status <- match.arg(status, c("default", "primary", "success",
"info", "danger", "warning"))
shape <- match.arg(shape)
if (is.null(choices) && is.null(choiceNames) && is.null(choiceValues)) {
choices <- character(0)
}
args <- shinyWidgets:::normalizeChoicesArgs(choices, choiceNames, choiceValues)
selected <- shiny::restoreInput(id = inputId, default = selected)
selected <- if (is.null(selected)) {
args$choiceValues[[1]]
}
else {
as.character(selected)
}
if (length(selected) > 1)
stop("The 'selected' argument must be of length 1")
options1 <- shinyWidgets:::generatePretty(
inputId = inputId, selected = selected,
inline = inline, type = "radio", choiceNames = args$choiceNames[1:3],
choiceValues = args$choiceValues[1:3], status = status, shape = shape,
outline = outline, fill = fill, thick = thick, animation = animation,
icon = icon, plain = plain, bigger = bigger
)
options2 <- shinyWidgets:::generatePretty(
inputId = inputId, selected = selected,
inline = inline, type = "radio", choiceNames = args$choiceNames[4:6],
choiceValues = args$choiceValues[4:6], status = status, shape = shape,
outline = outline, fill = fill, thick = thick, animation = animation,
icon = icon, plain = plain, bigger = bigger
)
options3 <- shinyWidgets:::generatePretty(
inputId = inputId, selected = selected,
inline = inline, type = "radio", choiceNames = args$choiceNames[7:9],
choiceValues = args$choiceValues[7:9], status = status, shape = shape,
outline = outline, fill = fill, thick = thick, animation = animation,
icon = icon, plain = plain, bigger = bigger
)
options <- tags$div(
tags$div(
tags$fieldset(
tags$legend("Group 1"),
options1
)
),
tags$div(
tags$fieldset(
tags$legend("Group 2"),
tags$div(
style = "display: inline-block;",
options2
),
tags$div(
style = "display: inline-block;",
options3
)
)
)
)
divClass <- "form-group shiny-input-radiogroup shiny-input-container"
if (inline)
divClass <- paste(divClass, "shiny-input-container-inline")
radioTag <- htmltools::tags$div(id = inputId, style = if (!is.null(width))
paste0("width: ", validateCssUnit(width), ";"), class = divClass,
tags$label(class = "control-label", `for` = inputId,
class = if (is.null(label))
"shiny-label-null", label), options)
shinyWidgets:::attachShinyWidgetsDep(radioTag, "pretty")
}
ui <- bootstrapPage(
theme = bs_theme(version = 5,
# bootswatch = "flatly",
"font-scale" = 1.0),
div(class = "container-fluid",
div(class = "row",
div(class = "col-12",
prettyRadioButtons9(
inputId = "travel_region",
label = NULL,
selected = NULL,
status = "primary",
shape = c("round"),
width = NULL,
choices = LETTERS[1:9]
)
)
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)