首页 > 解决方案 > 当从其他 UI 动态生成最小和最大日期时,闪亮的动态滑块输入显示警告

问题描述

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

我的问题是所有 3 个 UI 都可以生成结果图。然而,在情节生成之前,有一个短暂的时刻,RStudio 向我强调了以下警告:

警告:as.POSIXlt.default 中的错误:不知道如何将“x”转换为“POSIXlt”类</p>

我希望能够解决上述问题。我设法将问题隔离到我的代码的renderUIandsliderInput小节:

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

包中的year函数lubridate将返回一个数值,然后将其输入到我的 dplyr 管道中的betweenand函数中。filter应该是正确的数据类型,但是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")

用户界面:

# 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)

标签: rshinyshinydashboardlubridate

解决方案


概述

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

req()是检查输入和反应变量是否可用的首选方法。它测试“真实性”。尽管其余代码有效,但作为最佳实践,我建议您将其更改为使用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)

推荐阅读