闪亮：如何在通过 actionButton 评估输入条件时更改输出（视觉数据到警告消息，反之亦然）

Question

我正在开发一个应用程序，该应用程序应该接受数字输入，然后根据所述输入生成一些可视化和优化结果。问题是输入应该满足一些条件，如果违反了条件，我希望为用户弹出一条消息，而不是无意义的结果。

每个数字输入都有一个最小值和最大值。在这种情况下，采用输入 'X'，其中我需要 X 大于比 'X MIN' 和小于 'X MAX'。我正在考虑让算法立即或单击操作按钮后检查输入，如果违反条件，则隐藏输出并弹出一条消息并说明 'please ensure X is greater than the minimum value and less than the maximum value' 。这将适用于任何违反的输入。然后运行成功并在条件验证正确后显示输出。

我已经进行了几次不同的尝试，'feel' observeEvent 是可行的方法，但我的逻辑并不完全正确。 shinyjs::hide 命令似乎只在第一次单击操作按钮时有效，而不是第二次、第三次等...当单击按钮且未评估条件时。令人惊讶的是，'warning' 消息似乎在我自己更改输入时立即发生变化，而不仅仅是当我按下 actionButton 时，所以很明显这里的范围界定与我认为我正在编码的内容 vs .这是怎么回事

除了这些观察之外，我现在意识到这段代码无法同时显示 xwarning 和 ywarning如果不满足 input$x 和 input$y 或任何组合的输入条件，因为这也是可取的，因此也将不胜感激。从我下面的示例中，我希望人们会在第一个运行之后注意到算法没有成功隐藏和显示视觉效果。我将继续致力于此，但如有任何帮助，我们将不胜感激。

也探索 validate 作为一个选项。这也是我的第一个 post，所以对我如何提出这个问题的任何评论也表示赞赏。

library(DT)
library(shiny)
library(shinyjs)
library(plyr)
library(lubridate)
library(data.table)
library(tidyr)
options(scipen=999)
gc()

ui <- dashboardPage(
  
  dashboardHeader(),   # Have to try this one, title is not popping up 
  
  dashboardSidebar(size = "wide", 
                   
                   sidebarMenu(  # Removes spinner from input boxes
                     
                     tags$head(
                       tags$style(HTML("hr {border-top: 1px solid #000000;}"))
                     ),
                     
                     
                     hr(),
                     
                     numericInput('x','X Spend:', value = 1000000, min = 2, max = 5000000),
                     numericInput('y', 'Y Spend:', value = 50000, min = 2, max = 5000000), 
                     numericInput('z', 'Z Spend:', value = 1500000, min = 2, max = 5000000),
                     
                     
                     hr(),
                     
                     
                     numericInput('xlb', 'X MIN:', value = 0, min = 1, max = 5000000),
                     numericInput('ylb', 'Y MIN:', value = 0, min = 1, max = 5000000),
                     numericInput('zlb', 'Z MIN:', value = 0, min = 1, max = 5000000), 
                     
                     hr(),
                     
                     numericInput('xub', 'X MAX:', value = 2500000, min = 1, max = 5000000),
                     numericInput('yub', 'Y MAX:', value = 1500000, min = 1, max = 5000000),
                     numericInput('zub', 'Z MAX:', value = 3000000, min = 1, max = 5000000), 
                     
          
                     hr(),
          
                     
                     menuItem(tabName=  "main","X-Y-Z", icon = icon('chart area')),
                     menuItem(tabName = "xtb", "X Breakdown", icon = icon("table")),
                     menuItem(tabName = "yvb", "Y Breakdown", icon = icon("table")),
                     menuItem(tabName = "zbb", "Z Breakdown", icon = icon("table")),
                
                     
                     actionButton('Run', 'Run App')
                   )
  ),
  
  dashboardBody(
    # Suppresses warning messages
    tags$style(type="text/css",
               ".shiny-output-error { visibility: hidden; }",
               ".shiny-output-error:before { visibility: hidden; }"),
    
    
    
    # Set up Tab regimen
    tabItems(selected = 1,
             
             # Main tab 
             tabItem(tabName = "main", 
                     
                     
                     # Plan Plot 
                     box(width = 8, title = "X-Y-Z Spend",
                         color = "green", ribbon = T, title_side = "top right",
                         column(width = 8,
                                plotOutput(outputId = 'plot1', height = '100%')
                         )
                     ),
                     # Solver Plot 
                     box(width = 8, title = "X-Y-Z Logarithmic Spend",
                         color = "green", ribbon = T, title_side = "top right",
                         column(width = 8,
                                plotOutput(outputId = 'plot2', height = '100%')
                         )
                     ),
                     
                     DT::dataTableOutput('results') ,
                     verbatimTextOutput('xwarning'),
                     verbatimTextOutput('ywarning'),
                     verbatimTextOutput('zwarning'),
                     
             ),
             
             # Results table 1
             tabItem(tabName = "xtb",
                     
                     DT::dataTableOutput('results2') 
             ),
             
             # Results table 2
             tabItem(tabName = "yvb",
                     
                     DT::dataTableOutput('results3') 
             ),
             
             # Results TV
             tabItem(tabName = "zbb",
                     
                     DT::dataTableOutput('results4') 
             )
             
    )
  )
)
####################################################################################################################################################

####################################################################################################################################################
server <- shinyServer(function(input, output, session) {
  
  go <- eventReactive(input$Run, {
    
    x.y.z.spend     <- as.matrix(rbind(input$x,
                                   input$y,
                                   input$z))
    
    x.y.z.log.spend <- as.matrix(rbind(log(input$x),
                                       log(input$y),
                                       log(input$z)))
    
    letters           <- as.matrix(rbind('X',
                                       'Y',
                                       'Z'))
    
    
    x.log <- log(input$x)
    y.log <- log(input$y)
    z.log <- log(input$z)
    
    values <- as.matrix(cbind(input$x, input$y, input$z, x.log, y.log, z.log))
    
    table.results <- DT::datatable(values, options = list(paging = F, searching = F, ordering = F, dom = 't',
                                                          columnDefs = list(list(className = 'dt-left', targets = "_all"))), rownames = F)
    
    
    table.x       <- DT::datatable(cbind(input$x,log(input$x)), options = list(paging = F, searching = F, ordering = F, dom = 't',
                                                           columnDefs = list(list(className = 'dt-left', targets = "_all"))), rownames = F)
    
    table.y       <- DT::datatable(cbind(input$y,log(input$y)), options = list(paging = F, searching = F, ordering = F, dom = 't',
                                                            columnDefs = list(list(className = 'dt-left', targets = "_all"))), rownames = F)
    
    table.z       <- DT::datatable(cbind(input$z,log(input$z)), options = list(paging = F, searching = F, ordering = F, dom = 't',
                                                            columnDefs = list(list(className = 'dt-left', targets = "_all"))), rownames = F)
    
    list(table = table.results,
         table2 = table.x,
         table3 = table.y,
         table4 = table.z,
         x.y.z.spend,
         x.y.z.log.spend,
         letters
         )
    
  }) 
  

  observeEvent(input$Run,{
    
    if (input$x > input$xub || input$x < input$xlb){
      
      shinyjs::hide('results')
      shinyjs::hide('results2')
      shinyjs::hide('results3')
      shinyjs::hide('results4')
      shinyjs::hide('plot1')
      shinyjs::hide('plot2')
      shinyjs::hide('ywarning')
      shinyjs::hide('zwarning')
      
      shinyjs::show('xwarning')
      output$xwarning <- renderText({paste('Please ensure that',input$x,'is less than',input$xub,'and greater than',input$xlb)})
      
      
    }
      
    else if (input$y > input$yub || input$y < input$ylb){
      
      shinyjs::hide('results')
      shinyjs::hide('results2')
      shinyjs::hide('results3')
      shinyjs::hide('results4')
      shinyjs::hide('plot1')
      shinyjs::hide('plot2')
      shinyjs::hide('xwarning')
      shinyjs::hide('zwarning')
      
      shinyjs::show('ywarning')
      
      output$ywarning <- renderText({paste('Please ensure that',input$y,'is less than',input$yub,'and greater than',input$ylb)})
      
    }
      
      else if (input$z > input$zub || input$z < input$zlb){
        
        shinyjs::hide('results')
        shinyjs::hide('results2')
        shinyjs::hide('results3')
        shinyjs::hide('results4')
        shinyjs::hide('plot1')
        shinyjs::hide('plot2')
        shinyjs::hide('xwarning')
        shinyjs::hide('ywarning')
        
        shinyjs::show('zwarning')
        
        output$zwarning <- renderText({paste('Please ensure that',input$z,'is less than',input$zub,'and greater than',input$zlb)})
        
      }
      
     else { 
       shinyjs::hide('xwarning')
       shinyjs::hide('ywarning')
       shinyjs::hide('zwarning')
       
       shinyjs::show('results')
       shinyjs::show('results2')
       shinyjs::show('results3')
       shinyjs::show('results4')
       shinyjs::show('plot1')
       shinyjs::show('plot2')
    
    output$results    = renderDataTable({go()$table})
    output$results2   = renderDataTable({go()$table2})
    output$results3  = renderDataTable({go()$table3})
    output$results4  = renderDataTable({go()$table4})
    
    output$plot1 = renderPlot({pie(go()[[5]], labels = go()[[7]],col=c("red2","white","azure"))}, 
                                   height = function(){
                                     session$clientData$output_plot1_width
                                   })
    
    output$plot2 = renderPlot({pie(go()[[6]], labels = go()[[7]],col=c("red2","white","azure"))}, 
                                   height = function(){
                                     session$clientData$output_plot2_width
                                   })
    
     }
  })
  
}) 
################################################################################################
shinyApp(ui, server)

Answer 1

validate 是一个非常实用的选择，因为它将为您处理输出中的警告消息，避免您尝试实现的显示隐藏逻辑：

创建验证函数

MyValidation <- function(input) {
  msg <- ""
  if (input$x > input$xub || input$x < input$xlb) {
    msg <- paste(
        'Please ensure that',
        input$x,
        'is less than',
        input$xub,
        'and greater than',
        input$xlb)
  } else if (input$y > input$yub || input$y < input$ylb) {
    msg <- paste(
        'Please ensure that',
        input$y,
        'is less than',
        input$yub,
        'and greater than',
        input$ylb)
  } else if (input$z > input$zub || input$z < input$zlb) {
    msg <- paste(
          'Please ensure that',
          input$z,
          'is less than',
          input$zub,
          'and greater than',
          input$zlb)
      }
      validate(need(msg == "", msg))
}

将此函数放在所有渲染函数的开头：

  output$results    = renderDataTable({MyValidation(input); go()$table})
  output$results2   = renderDataTable({MyValidation(input);go()$table2})
  output$results3  = renderDataTable({MyValidation(input);go()$table3})
  output$results4  = renderDataTable({MyValidation(input);go()$table4})

  output$plot1 = renderPlot({MyValidation(input)
                             pie(go()[[5]], labels = go()[[7]],col=c("red2","white","azure"))},
                            height = function(){
                              session$clientData$output_plot1_width
                            })
  output$plot2 = renderPlot({MyValidation(input)
                             pie(go()[[6]], labels = go()[[7]],col=c("red2","white","azure"))},
                            height = function(){
                              session$clientData$output_plot2_width
                            })

最明显的限制是，对于每个错误的输出，您都会收到相同的错误消息，但由于它以用户友好的方式显示，因此不会太令人不安。
如果您更喜欢只有一条消息，您可以为每个选项卡创建一个渲染函数，将许多输出组合在一起，并以相同的验证函数作为起点。

闪亮：如何在通过 actionButton 评估输入条件时更改输出（视觉数据到警告消息，反之亦然）

Shiny: How to change output (visual data to warning message & vice-versa) when input conditions are evaluated via actionButton

r

shiny

shiny-reactivity

shinyjs