如何向 Shiny 中动态生成的 UI 输出添加警告

Question

我正在开发一个闪亮的应用程序，它可以根据用户定义的值以输入的形式生成确定数量的 UI 输出。感谢 @YBS 的帮助，我能够让应用正常运行。但现在我面临一个新问题。虽然我可以为生成的输入定义最小值和最大值，但我想在值大于 100 时在输入中添加警告，我发现 shinyfeedback 包可以做到这一点，但我没有正确放置代码或者在像这里生成的动态输入的情况下该怎么做。

这是正在运行的应用程序：

library(shiny)
library(shinydashboard)
library(DT)
library(shinyFeedback)
#Function

compute <- function(firstitem,seconditem)
{
  Sum <- firstitem+seconditem
  Difference <- firstitem+seconditem
  Product <- firstitem*seconditem
  Ratio <- firstitem/seconditem
  Res <- data.frame(C1=Sum,C2=Difference,C3=Product,C4=Ratio)
  return(Res)
}

#App

ui = shinyUI(fluidPage(
  
  titlePanel("Compare"),
  
  sidebarLayout(
    sidebarPanel(
      numericInput("numitems", label = "Number of items to compare?",
                   min = 1, max = 100, value = 1),
      uiOutput("period_cutpoints"),
      uiOutput("period_cutpoints2"),
      actionButton("submit", "Submit")
    ),
    mainPanel(
      uiOutput("t1")
    )
  )
))

server = shinyServer(function(input, output, session) {
  
  output$period_cutpoints<-renderUI({
    req(input$numitems)
    lapply(1:(input$numitems), function(i) {
      numericInput(inputId=paste0("firstitem",i), 
                   label=paste0("Enter the value of first item ", i, ":"),value = i)
    })
    
  })
  
  output$period_cutpoints2<-renderUI({
    req(input$numitems)
    lapply(1:(input$numitems), function(i) {
      numericInput(inputId=paste0("seconditem",i), 
                   label=paste0("Enter the value of second item ", i, ":"),value = i+i)
    })
  })
  
  seldates <- reactiveValues(x=NULL)
  observeEvent(input$submit, {
    seldates$x <- list()
    lapply(1:(input$numitems), function(i) { 
      seldates$x[[i]] <- compute(firstitem = input[[paste0("firstitem", i)]],seconditem = input[[paste0("seconditem", i)]])
    })
  })
  
  observeEvent(input$submit, {
    
    lapply(1:(input$numitems), function(i) { 
      output[[paste0("table",i)]] <- renderDT(seldates$x[[i]])
    })
    
    output$t1 <- renderUI({
      tagList(
        lapply(1:(input$numitems), function(i) { 
          DTOutput(paste0("table",i))
        })
      )
    })
    
  })
  
})

shinyApp(ui = ui , server = server)

我尝试以这种方式在动态输入中添加一些代码：

#Code demo
  output$period_cutpoints<-renderUI({
    req(input$numitems)
    lapply(1:(input$numitems), function(i) {
      numericInput(inputId=paste0("firstitem",i), 
                   label=paste0("Enter the value of first item ", i, ":"),value = i)
    })
    
    lapply(1:(input$numitems), function(i) {
      observeEvent(input[[paste0('firstitem',i)]], {
        shinyFeedback::feedbackWarning(
          inputId = paste0('firstitem',i),
          show = input[[paste0('firstitem',i)]] > 100,
          text = "Number less than 100 required.",
          color="red"
        )
      })
    })
    
  })

很遗憾，此操作导致应用程序崩溃：

如您所见，第一个输入并未生成。

如何解决此问题，以便在值大于 100 时发出警告？此外，这导致了一个额外的事实，如果在操作按钮中使用动态生成的多个输入，我怎么能做这样的事情：

#How to extend the if condition so that it can consider the number of inputs defined by the user
observeEvent(input$submit,
             {
               if(input$firstitem1 < 0 && input$seconditem1 < 0 && input$firstitem2<0 && input$seconditem1<0)
               {
                 showModal(modalDialog(title ="Warning!!!", "Check fields!!!",easyClose = T))
               }
               else
               {
                 showModal(modalDialog(title ="Congratulations!!!", "Computing Done!!!",easyClose = T))
                 
               }
             })

我如何更改if 以便它考虑所有可以生成的输入。

非常感谢！

Answer 1

我认为你有几个问题。

首先，您忘记在 UI 定义中添加 useShinyFeedback()。

ui = shinyUI(
  fluidPage(
    useShinyFeedback(),
    titlePanel("Compare"),
    ...

其次，您已将监视您的第一个项目值的observeEvents 放入您的renderUI 中。那是行不通的：R 的标准范围意味着这些observeEvents 将无法用于监视相应输入小部件中的更改。解决方案是创建一个单独的observeEvent 以在输入上创建您的观察者：

  observeEvent(input$numitems, {
    lapply(1:(input$numitems), function(i) {
      observeEvent(input[[paste0('firstitem',i)]], {
        shinyFeedback::feedbackWarning(
          inputId = paste0('firstitem',i),
          show = input[[paste0('firstitem',i)]] > 100,
          text = "Number less than 100 required.",
          color="red"
        )
      })
    })
  })

例如，进行这些更改会给我

关于你关于提交actionButton的最后一个问题，作为一般的观察，我认为如果你使用Shiny modules来解决这个问题，你的生活会容易得多。这将允许您将错误检查委托给各个模块，并且无需不断循环遍历动态输入的索引。这将导致代码更短、更简单、更易于理解。

如果您这样做，请记住一件事：确保在模块 UI 的定义中调用 useShinyFeedback。