我有一个带有三个UI的Shiny Dashboard应用程序。第一个UI是选择输入。第二个UI是动态选择输入,它取决于第一个选择输入的值。第三个UI是动态滑块输入,取决于前两个选择输入的值。
我的问题是,所有3个UI都可以生成结果图。但是,在生成图之前,RStudio会在很短的时间内向我突出以下警告:
警告:as.POSIXlt.default中的错误:不知道如何将'x'转换为“ POSIXlt”类
我希望能够解决上述问题。我设法将问题隔离到代码的renderUI
和sliderInput
小节中:
min = min(year(first_filter()$ Date)),max = max(year(first_filter()$ Date)),
year
包中的lubridate
函数将返回一个数值,该数值又将被馈送到我的dplyr管道中的between
和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)
答案 0 :(得分:1)
这里的主要问题是,初始化应用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)