Блестящий динамический sliderInput отображает предупреждение, когда минимальная и максимальная даты динамически генерируются из других интерфейсов - PullRequest
Новая
       11

Блестящий динамический sliderInput отображает предупреждение, когда минимальная и максимальная даты динамически генерируются из других интерфейсов

0 голосов
/ 23 марта 2019

У меня есть приложение Shiny Dashboard с тремя пользовательскими интерфейсами.Первый пользовательский интерфейс является выбранным входом.Второй пользовательский интерфейс представляет собой вход динамического выбора, который зависит от значения первого входа выбора.Третий пользовательский интерфейс представляет собой вход динамического ползунка, который зависит от значения первых двух входов выбора.

Моя проблема в том, что все 3 интерфейса работают для создания результирующего графика.Тем не менее, перед созданием графика, есть короткий момент, когда RStudio выдвигает мне следующее предупреждение:

Предупреждение: ошибка в as.POSIXlt.default: не знаю, как конвертировать«х» в классе «POSIXlt»

Я бы хотел решить вышеуказанную проблему.Мне удалось выделить проблему в подразделе renderUI и sliderInput моего кода:

min = min (year (first_filter () $ Date)), max = max (year (first_filter () $)Дата)),

Функция year из пакета lubridate вернет числовое значение, которое, в свою очередь, будет передано в функции between и filter в моем канале 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")

Пользовательский интерфейс: 

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

1 Ответ

1 голос
/ 23 марта 2019

Обзор

Основная проблема заключается в том, что при инициализации приложения значение first_filter()$Date равно NULL, как вы установили его в first_filter <- reactive(...).Это можно исправить, поместив req(first_filter()) в output$dyn_slider <- renderUI(...), как показано ниже.

req() является предпочтительным методом проверки наличия входных данных и реактивных переменных.Это проверяет на «правдивость».Несмотря на то, что остальная часть кода работает, я рекомендую вам заменить ее на req() вместо 

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

Fixed Code 

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