服务器端反应式的启动评估

时间:2019-09-12 19:57:29

标签: r shinydashboard

启动后,我需要一个可用的反应式变量(声明为服务器端)。使用我在How to create a conditional renderUI in Shiny dashboard中学到的知识,我尝试在定义UI之前将其包装在reactive()中,但是没有运气。将topValuesSelector移至conditionalPanel内的UI上将起作用,但条件面板显然不喜欢%in%运算符(这是我也尝试解决无法成功的另一个问题)。

if (interactive()) {
  library(shiny)
  library(shinydashboard)
  library(shinydashboardPlus)

  ui <-
    dashboardPage(header = dashboardHeaderPlus(left_menu = tagList(
      dropdownBlock(
        id = "prefDropdown",
        title = "Preferences",
        icon = NULL,
        badgeStatus = NULL,
        checkboxGroupInput(
          inputId = "prefDropdown",
          label = NULL,
          choices = c("Pareto",
                      "Legend on chart",
                      "Cases/1K uniques",
                      "Top 10 only"),
          selected = c("Pareto", "Cases/1K uniques", "Top 10 only")
        ),
        uiOutput("topValues")
      )
    )),
    dashboardSidebar(),
    dashboardBody(fluidRow(box(
      title = "Top",
      textOutput("topN")
    ))))
  server <- function(input, output) {
    topValuesSelector <- reactive({
      if ("Top 10 only" %in% input$prefDropdown) {
        numericInput(
          inputId = "topValues",
          label = NULL,
          width = "25%",
          value = 10,
          min = 1,
          max = 30,
          step = 1
        )
      }
    })
    output$topValues <- renderUI({
      topValuesSelector()
    })

    observe({
      if ("Top 10 only" %in% input$prefDropdown) {
        output$topN <- renderText(input$topValues)
      } else{
        output$topN <- renderText(100)
      }
    })
  }
  shinyApp(ui, server)
}

意图是“ topValues”的初始值为10,并且该值立即可用。但是,没有可用的值会导致错误。使用req()可以通过暂停执行来避免错误,但这不是可行的方法,因为绘图需要“ topValues”。因此,在选择“ prefDropdown”之前,无图。

1 个答案:

答案 0 :(得分:0)

问题似乎是input$topValues直到您单击“首选项”按钮才存在。由于不需要UI元素,因此尚未创建。

要解决此问题,您可以创建一个变量来检测输入是否可用以及是否使用默认值。

if (interactive()) {
  library(shiny)
  library(shinydashboard)
  library(shinydashboardPlus)

  ui <-
    dashboardPage(header = dashboardHeaderPlus(left_menu = tagList(
      dropdownBlock(
        id = "prefDropdown",
        title = "Preferences",
        icon = NULL,
        badgeStatus = NULL,
        checkboxGroupInput(
          inputId = "prefDropdown",
          label = NULL,
          choices = c("Pareto",
                      "Legend on chart",
                      "Cases/1K uniques",
                      "Top 10 only"),
          selected = c("Pareto", "Cases/1K uniques", "Top 10 only")
        ),
        uiOutput("topValues")
      )
    )),
    dashboardSidebar(),
    dashboardBody(fluidRow(box(
      title = "Top",
      textOutput("topN")
    ))))
  server <- function(input, output) {
    ## We want to use the same default value in two places so create a var
    default_value <- 10
    topValuesSelector <- reactive({
      if ("Top 10 only" %in% input$prefDropdown) {
        numericInput(
          inputId = "topValues",
          label = NULL,
          width = "25%",
          value = default_value, ## Change to use the default value
          min = 1,
          max = 30,
          step = 1
        )
      }
    })
    output$topValues <- renderUI({
      topValuesSelector()
    })
    ## Create a variable that is the default value unless the input is available
    myTopN <- reactive({
      if(length(input$topValues)>0){
        return(input$topValues)
      }
      return(default_value)
    })
    observe({
      if ("Top 10 only" %in% input$prefDropdown) {
        # output$topN <- renderText(input$topValues)
        output$topN <- renderText(myTopN()) ## Use our new variable instead of the input directly
      } else{
        output$topN <- renderText(100)
      }
    })
  }
  shinyApp(ui, server)
}

您的代码还有其他几件事。请注意,"Top 10 only" %in% input$prefDropdown不会执行您认为正在执行的操作。您必须检查"Top 10 only"是否为真...如果您再次遇到问题,我将留在那里,开始另一个问题。