r - 当从其他 UI 动态生成最小和最大日期时,闪亮的动态滑块输入显示警告
问题描述
我有一个带有三个 UI 的 Shiny Dashboard 应用程序。第一个 UI 是一个选择输入。第二个 UI 是一个动态选择输入,它取决于第一个选择输入的值。第三个 UI 是一个动态滑块输入,它取决于前两个选择输入的值。
我的问题是所有 3 个 UI 都可以生成结果图。然而,在情节生成之前,有一个短暂的时刻,RStudio 向我强调了以下警告:
警告:as.POSIXlt.default 中的错误:不知道如何将“x”转换为“POSIXlt”类</p>
我希望能够解决上述问题。我设法将问题隔离到我的代码的renderUI
andsliderInput
小节:
min = min(year(first_filter()$Date)), max = max(year(first_filter()$Date)),
包中的year
函数lubridate
将返回一个数值,然后将其输入到我的 dplyr 管道中的between
and函数中。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)
解决方案
概述
这里的主要问题是,当应用程序初始化时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)
推荐阅读
- accelerated-mobile-page - 通过 javascript 使 AMP 页面可被发现
- php - 将 Order By 与 Union 结合使用 - SQL 语句
- javascript - Google Chrome 使用 javascript fetch 将 GET 方法更改为 OPTIONS
- ios - 如何防止多个用户在应用内购买时使用相同的 Apple ID
- javascript - php $_POST 使用javascript调用php函数时返回空
- ajax - ajax查询不传递页面数据laravel 5.6
- java - 处理应用内 WiFi 状态的定期检查
- ruby-on-rails - elasticseach 如何在请求正文中添加搜索类型
- c++ - printf()、scanf() 中的字母“f”和 seekg() 中的“g”代表什么
- html - 如何修复容器内的按钮?