Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How do I use purrr in Shiny to apply one renderText to multiple outputs?

Tags:

r

purrr

shiny

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)

like image 418
Michael S Taylor Avatar asked Oct 27 '25 11:10

Michael S Taylor


1 Answers

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.

like image 135
ismirsehregal Avatar answered Oct 29 '25 02:10

ismirsehregal



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!