当从其他 UI 动态生成最小和最大日期时,Shiny Dynamic sliderInput 显示警告

Shiny Dynamic sliderInput displaying warning when min and max dates are dynamically generated from other UIs

我有一个包含三个 UI 的 Shiny Dashboard 应用程序。第一个 UI 是 select 输入。第二个 UI 是一个动态 select 输入,它取决于第一个 select 输入的值。第三个 UI 是一个动态滑块输入,它取决于前两个 select 输入的值。

我的问题是所有 3 个 UI 都可以生成结果图。然而,在生成情节之前,RStudio 会及时向我突出显示以下警告:

Warning: Error in as.POSIXlt.default: do not know how to convert 'x' to class “POSIXlt”

我希望能够解决上述问题。我设法将问题隔离到代码的 renderUIsliderInput 部分:

min = min(year(first_filter()$Date)), max = max(year(first_filter()$Date)),

lubridate 包中的 year 函数将 return 一个数值,然后将其输入 betweenfilter在我的 dplyr 管道中运行。应该是正确的数据类型,但是R表示数据类型错误。

提前致谢!

我的代码如下:

数据样本:

df <- structure(list(Date = structure(c(1546214400, 1538265600, 1530316800, 
                                    1522454400, 1514678400, 1506729600, 1498780800, 1490918400, 1483142400, 
                                    1475193600, 1546214400, 1538265600, 1530316800, 1522454400, 1514678400, 
                                    1506729600, 1498780800, 1490918400, 1483142400, 1475193600, 1546214400, 
                                    1538265600, 1530316800, 1522454400, 1514678400, 1506729600, 1498780800, 
                                    1490918400, 1483142400, 1475193600, 1546214400, 1538265600, 1530316800, 
                                    1522454400, 1514678400, 1506729600, 1498780800, 1490918400, 1483142400, 
                                    1475193600, 1467244800, 1459382400, 1451520000, 1443571200, 1435622400, 
                                    1427760000, 1419984000, 1412035200, 1404086400, 1396224000, 1546214400, 
                                    1538265600, 1530316800, 1522454400, 1514678400, 1506729600, 1498780800, 
                                    1490918400, 1483142400, 1475193600, 1467244800, 1459382400, 1451520000, 
                                    1443571200, 1435622400, 1427760000, 1419984000, 1412035200, 1404086400, 
                                    1396224000), class = c("POSIXct", "POSIXt"), tzone = "UTC"), 
                 Group = c("Group B", "Group B", "Group B", "Group B", "Group B", 
                           "Group B", "Group B", "Group B", "Group B", "Group B", "Group B", 
                           "Group B", "Group B", "Group B", "Group B", "Group B", "Group B", 
                           "Group B", "Group B", "Group B", "Group B", "Group B", "Group B", 
                           "Group B", "Group B", "Group B", "Group B", "Group B", "Group B", 
                           "Group B", "Group A", "Group A", "Group A", "Group A", "Group A", 
                           "Group A", "Group A", "Group A", "Group A", "Group A", "Group A", 
                           "Group A", "Group A", "Group A", "Group A", "Group A", "Group A", 
                           "Group A", "Group A", "Group A", "Group A", "Group A", "Group A", 
                           "Group A", "Group A", "Group A", "Group A", "Group A", "Group A", 
                           "Group A", "Group A", "Group A", "Group A", "Group A", "Group A", 
                           "Group A", "Group A", "Group A", "Group A", "Group A"), Subgroup = c("Subgroup A", 
                                                                                                "Subgroup A", "Subgroup A", "Subgroup A", "Subgroup A", "Subgroup A", 
                                                                                                "Subgroup A", "Subgroup A", "Subgroup A", "Subgroup A", "Subgroup B", 
                                                                                                "Subgroup B", "Subgroup B", "Subgroup B", "Subgroup B", "Subgroup B", 
                                                                                                "Subgroup B", "Subgroup B", "Subgroup B", "Subgroup B", "Subgroup C", 
                                                                                                "Subgroup C", "Subgroup C", "Subgroup C", "Subgroup C", "Subgroup C", 
                                                                                                "Subgroup C", "Subgroup C", "Subgroup C", "Subgroup C", "Subgroup A", 
                                                                                                "Subgroup A", "Subgroup A", "Subgroup A", "Subgroup A", "Subgroup A", 
                                                                                                "Subgroup A", "Subgroup A", "Subgroup A", "Subgroup A", "Subgroup A", 
                                                                                                "Subgroup A", "Subgroup A", "Subgroup A", "Subgroup A", "Subgroup A", 
                                                                                                "Subgroup A", "Subgroup A", "Subgroup A", "Subgroup A", "Subgroup B", 
                                                                                                "Subgroup B", "Subgroup B", "Subgroup B", "Subgroup B", "Subgroup B", 
                                                                                                "Subgroup B", "Subgroup B", "Subgroup B", "Subgroup B", "Subgroup B", 
                                                                                                "Subgroup B", "Subgroup B", "Subgroup B", "Subgroup B", "Subgroup B", 
                                                                                                "Subgroup B", "Subgroup B", "Subgroup B", "Subgroup B"), 
                 Value = c(4.3, 4.4, 4.4, 4.5, 5.3, 5.4, 5.4, 5.4, 5.4, 5.44, 
                           31.5, 30.7, 29.5, 28.9, 29.2, 29.2, 29.2, 28.6, 27.6, 28.1, 
                           99.2, 99.2, 99.2, 100, 100, 100, 100, 98.3, 100, NA, 3.5, 
                           3.5, 3.5, 3.4, 3.5, 3.5, 3.4, 3.4, 3.6, 3.4, 3.53, 3.56, 
                           3.45, 3.16, 2.74, 2.88, 2.81, 2.57, 2.59, 2.47, 39.3, 41.4, 
                           40.3, 40.5, 37.3, 36.9, 36.4, 36.2, 39.8, 40.8, 40.2, 40.5, 
                           40.1, 33.9, 37.9, 38.6, 38.3, 39.8, 39.5, 40.8)), row.names = c(NA, 
                                                                                           -70L), class = c("tbl_df", "tbl", "data.frame"))


df$Date <- as.Date(df$Date, format = "%d/%m/%Y")

UI:

# Define UI for application
ui <- dashboardPage(

  # Application title
  dashboardHeader(title = "App"),

  # Dashboard Sidebar
  dashboardSidebar(

    sidebarMenu(

      menuItem("Data", tabName = "data_tab")
    )
  ),

  dashboardBody(

    tabItems(

      tabItem(tabName = "data_tab",
              fluidRow(
                box(
                  selectInput("Group_selector",
                          "Select Group",
                          choices = unique(df$Group)),

                  # Add a UI Output to select Subgroup and Date range
                  uiOutput("dyn_metric"),
                  uiOutput("dyn_slider")
                ),

                box(
                  # Produce output using plotly
                  plotlyOutput("plot")
                )
              )
      )
    )
  )
)

服务器:

library(shiny)
library(shinydashboard)
library(dplyr)
library(plotly)
library(lubridate)

# Define server logic required to plot trend
server <- function(input, output) {

  # Render a UI for selecting of Subgroup metric
  output$dyn_metric <- renderUI({
    selectInput("Subgroup_selector",
                "Select Subgroup", choices = unique(df[df$Group == input$Group_selector, "Subgroup"]))
  })

  # Render a UI for selecting date range
  output$dyn_slider <- renderUI({
    sliderInput("date_range_selector", "Select Date Range", 
                min = min(year(first_filter()$Date)),
                max = max(year(first_filter()$Date)),
                value = c(max(year(first_filter()$Date)-1),
                          max(year(first_filter()$Date))),
                sep = "")
  })

  # Filter by Group and Subgroup first
  first_filter <- reactive({
    if(is.null(input$Subgroup_selector)) {
      return(NULL)
    }

    df %>%
      filter(Group == input$Group_selector & Subgroup == input$Subgroup_selector)
  })

  # Filter by Date Range next
  second_filter <- reactive({
    if(is.null(input$date_range_selector)) {
      return(NULL)
    }

    first_filter() %>%
      filter(between(year(Date), input$date_range_selector[1], input$date_range_selector[2]))
  })

  # Render plot using second filtered dataset
  output$plot <- renderPlotly({
    if(is.null(second_filter())) {
      return()
    }

    plot_ly(second_filter(), x = ~Date, y = ~Value, type = "scatter", mode = "lines+markers")
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

概览

这里的主要问题是当应用程序初始化时 first_filter()$Date 为 NULL,正如您在 first_filter <- reactive(...) 中设置的那样。这可以通过在 output$dyn_slider <- renderUI(...) 中放置 req(first_filter()) 来解决,如下所示。

req() 是检查输入和反应变量是否可用的首选方法。它测试 "truthy-ness"。尽管其余代码有效,但作为最佳实践,我建议您将其更改为使用 req() 而不是

   if(is.null(input$sample)) {
      return(NULL)
    }

固定代码

# Define UI for application
ui <- dashboardPage(

  # Application title
  dashboardHeader(title = "App"),

  # Dashboard Sidebar
  dashboardSidebar(

    sidebarMenu(

      menuItem("Data", tabName = "data_tab")
    )
  ),

  dashboardBody(

    tabItems(

      tabItem(tabName = "data_tab",
              fluidRow(
                box(
                  selectInput("Group_selector",
                              "Select Group",
                              choices = unique(df$Group)),

                  # Add a UI Output to select Subgroup and Date range
                  uiOutput("dyn_metric"),
                  uiOutput("dyn_slider")
                ),

                box(
                  # Produce output using plotly
                  plotlyOutput("plot")
                )
              )
      )
    )
  )
)

library(shiny)
library(shinydashboard)
library(dplyr)
library(plotly)
library(lubridate)

# Define server logic required to plot trend
server <- function(input, output) {

  # Render a UI for selecting of Subgroup metric
  output$dyn_metric <- renderUI({
    selectInput("Subgroup_selector",
                "Select Subgroup", choices = unique(df[df$Group == input$Group_selector, "Subgroup"]))
  })

  # Render a UI for selecting date range
  output$dyn_slider <- renderUI({
    req(first_filter())
    sliderInput("date_range_selector", "Select Date Range", 
                min = min(year(first_filter()$Date)),
                max = max(year(first_filter()$Date)),
                value = c(max(year(first_filter()$Date)-1),
                          max(year(first_filter()$Date))),
                sep = "")
  })

  # Filter by Group and Subgroup first
  first_filter <- reactive({
    if(is.null(input$Subgroup_selector)) {
      return(NULL)
    }

    df %>%
      filter(Group == input$Group_selector & Subgroup == input$Subgroup_selector)
  })

  # Filter by Date Range next
  second_filter <- reactive({
    if(is.null(input$date_range_selector)) {
      return(NULL)
    }

    first_filter() %>%
      filter(between(year(Date), input$date_range_selector[1], input$date_range_selector[2]))
  })

  # Render plot using second filtered dataset
  output$plot <- renderPlotly({
    if(is.null(second_filter())) {
      return()
    }

    plot_ly(second_filter(), x = ~Date, y = ~Value, type = "scatter", mode = "lines+markers")
  })
}

# Run the application 
shinyApp(ui = ui, server = server)