I have a series of textAreaInput that each require a friendly reminder below the Next button to fill in the field. (In reality, each field and button is on a separate tab.) I use renderText to output the reminder below each button. I can copy and paste the renderText functions for each textOutput, but I have more than two so I feel like I'm violating a golden rule.
Purrr seems like an appropriate tool to use. I suspect the solution will be similar to here and here but I have been unable to apply those solutions to my problem.
How can I apply the same renderText function to each textOutput? I prefer purrr but I appreciate learning alternative solutions.
library(shiny)
library(purrr)
ui <- fluidPage(
fluidRow(
column(3,
textAreaInput(inputId = "ta1",
label = "Fill in this field."),
actionButton(inputId = "btn_next_ta1", label = "Next"),
textOutput("ta1_error")
),
column(3,
textAreaInput(inputId = "ta2",
label = "Fill in this field."),
actionButton(inputId = "btn_next_ta2", label = "Next"),
textOutput("ta2_error")
),
)
)
server <- function(input, output) {
# Is this even close to a suitable start?
# walk(c("ta1", "ta2"), ~ observeEvent(input[[.x]], error_check(.x)))
error_check <- function(x) {
# Need to render the text string and assign
# to each textOutput
# if (x == "") {
# renderText("Please fill in the field."}
}
# ERROR CHECKS that I want to replace
# with a single function.
output$ta1_error <- renderText({
if (input$ta1 == "") {
"Please fill in the field."
}
})
output$ta2_error <- renderText({
if (input$ta2 == "") {
"Please fill in the field."
}
})
}
shinyApp(ui = ui, server = server)
Created on 2021-11-04 by the reprex package (v2.0.1)
Old question, but nevertheless:
A lapply version (can be replaced with purrr::map):
library(shiny)
textAreaInputIDs <- paste0("ta", 1:2)
ui <- fluidPage(
fluidRow(
lapply(textAreaInputIDs, function(id){
column(3,
textAreaInput(inputId = id,
label = "Fill in this field."),
actionButton(inputId = paste0("btn_next_", id), label = "Next"),
textOutput(paste0(id, "_error"))
)
})
)
)
server <- function(input, output) {
lapply(textAreaInputIDs, function(id){
output[[paste0(id, "_error")]] <- renderText({
if (input[[id]] == "") {
"Please fill in the field."
}
})
})
}
shinyApp(ui = ui, server = server)
However, usually shiny's modules are intended to handle scenarios like this, via dedicated namespaces:
library(shiny)
textAreaInputUI <- function(id) {
ns <- NS(id)
column(3,
textAreaInput(inputId = ns("ta"),
label = "Fill in this field."),
actionButton(inputId = ns("btn_next_ta"), label = "Next"),
textOutput(ns("ta_error"))
)
}
textAreaInputServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
output$ta_error <- renderText({
if (input$ta == "") {
"Please fill in the field."
}
})
}
)
}
ui <- fluidPage(
fluidRow(textAreaInputUI("ta1"),
textAreaInputUI("ta2")
)
)
server <- function(input, output, session) {
textAreaInputServer("ta1")
textAreaInputServer("ta2")
}
shinyApp(ui, server)
PS: also please check shinyvalidate.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With