我有一系列
textAreaInput
,每个都需要在“下一步”按钮下方进行友好提醒才能填写该字段。 (实际上,每个字段和按钮都位于单独的选项卡上。)我使用 renderText
在每个按钮下方输出提醒。我可以复制并粘贴每个 renderText
的 textOutput
函数,但我有两个以上,所以我觉得我违反了 黄金法则。
Purrr
似乎是一个合适的工具。我怀疑该解决方案与here和here类似,但我无法将这些解决方案应用于我的问题。
如何将相同的
renderText
函数应用于每个 textOutput
? 我更喜欢 purrr
,但我很欣赏学习替代解决方案。
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)
由 reprex 包于 2021 年 11 月 4 日创建(v2.0.1)
老问题,但仍然:
由于您的
renderText
调用需要对不同输入(input$ta1 / input$ta2)的反应依赖,我们不能简单地使用 lapply 或 purrr::map
。
但是,shiny 的模块旨在通过专用命名空间处理这样的场景:
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:还请检查shinyvalidate。