R Shiny应用程序中的xts参数错误

Question

我正在尝试基于滑块可视化选定日期的点数据。然而，我在xts方面遇到了问题，因为我得到了以下错误：

Warning: Error in match.arg: 'arg' should be one of “years”, “quarters”, “months”, “weeks”, “days”, “hours”, “minutes”, “seconds”, “milliseconds”, “microseconds”, “ms”, “us”

如何修复此错误？

代码

# This is a Shiny time series map web application
library(shiny)
library(tidyverse)
library(tidyr)
library(leaflet)
library(xts)

# Create sample data
Date= c("2014-04-08", "2014-06-04", "2014-04-30",
"2014-05-30", "2014-05-01")
lat = as.numeric(c("45.53814", "45.51076", "45.43560", "45.54332",
"45.52234"))
lon = as.numeric(c("-73.63672", "-73.61029", "-73.60100",
"-73.56000 ", "-73.59022"))
id = as.numeric(c("1", "2", "3", "4", "5"))
# Create a df from the above columns
df = data.frame(id, lat, lon, Date)
df$Year = lubridate::year(df$Date)
df$Month = lubridate::month(df$Date, label = TRUE, abbr=FALSE)
df$Week = lubridate::week(df$Date)
df$Date = as.Date(df$Date)
ui = fluidPage(

# Title
titlePanel("Time Series Visiualization Map"),
sidebarLayout(

# Define the sidebar
sidebarPanel(

radioButtons(inputId = "Frequency",
label = " Select Timer Series Frequency",
choices = c("Week",
"Month",
"Year"),
selected = "Week",
inline = T),

uiOutput("Time_Series_UI")
),
mainPanel(
leafletOutput("Time_Series_Map")),
))


# Define server logic required to draw a histogram
server = function(input, output) {

# Render slider input depending on data frequency

observe({
# Create an xts object
df_xts = xts(df, order.by = as.Date(df$Date))

#All_Dates = unique(df$Start_Date)

Filtered_Dates = df_xts[xts::endpoints(
df_xts, on = input$Frequency)]

output$Time_Series_UI = renderUI({
sliderInput("Date", "Date:",
min = min(Filtered_Dates),
max = max(Filtered_Dates),
value = min(Filtered_Dates),
step = 1,
timeFormat = "%YYYY-%MM-%DD",
animate = T)
})

})

# Filter data for the date selected
Filtered_Data = reactive({
req(input$Date)
df[df$Date == input$Date]
})


# Create the leaflet map
output$Time_Series_Map = renderLeaflet({
leaflet(df) %>% 
addTiles() %>% 
setView(lat = 0, lng = 0, zoom = 2) 
})

# Create data markers for selected date
observe({
df$id = Filtered_Data()

leafletProxy("Time_Series_Map", data = df) %>%
addCircleMarkers(lng = ~lon, lat = ~lat, 
popup = ~id)
})     

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

Answer 1

为了使endpoints工作，radioButtons的选择必须是weeks、months和years

我还将xts表转换为tibble，以便使用slice_min和slice_max以及pull获得最大和最小日期。

最后在leafletProxy中调用了反应性Filtered_Data()(在本部分中不完全确定(。现在，在滑块的过渡过程中出现了四个点。

应用程序：

# This is a Shiny time series map web application
library(shiny)
library(tidyverse)
library(tidyr)
library(leaflet)
library(xts)

xts_to_tibble <- function(xts_obj) {
data.frame(index(xts_obj), coredata(xts_obj)) %>%
set_names(c("date", names(xts_obj))) %>%
as_tibble()
}
# Create sample data
Date <- c(
"2014-04-08", "2014-06-04", "2014-04-30",
"2014-05-30", "2014-05-01"
)
lat <- as.numeric(c(
"45.53814", "45.51076", "45.43560", "45.54332",
"45.52234"
))
lon <- as.numeric(c(
"-73.63672", "-73.61029", "-73.60100",
"-73.56000 ", "-73.59022"
))
id <- as.numeric(c("1", "2", "3", "4", "5"))
# Create a df from the above columns
df <- data.frame(id, lat, lon, Date)
df$Year <- lubridate::year(df$Date)
df$Month <- lubridate::month(df$Date, label = TRUE, abbr = FALSE)
df$Week <- lubridate::week(df$Date)
df$Date <- as.Date(df$Date)
ui <- fluidPage(
# Title
titlePanel("Time Series Visiualization Map"),
sidebarLayout(
# Define the sidebar
sidebarPanel(
radioButtons(
inputId = "Frequency",
label = " Select Timer Series Frequency",
choices = c(
"weeks",
"months",
"years"
),
selected = "weeks",
inline = T
),
uiOutput("Time_Series_UI")
),
mainPanel(
leafletOutput("Time_Series_Map")
),
)
)

# Define server logic required to draw a histogram
server <- function(input, output) {
# Render slider input depending on data frequency
observe({
# Create an xts object
df_xts <- xts(df, order.by = as.Date(df$Date))
# All_Dates = unique(df$Start_Date)
Filtered_Dates <- df_xts[xts::endpoints(
df_xts,
on = input$Frequency
)] %>% xts_to_tibble()
output$Time_Series_UI <- renderUI({
sliderInput("Date", "Date:",
min = pull(slice_min(Filtered_Dates, date), date),
max = pull(slice_max(Filtered_Dates, date), date),
value = pull(slice_min(Filtered_Dates, date), date),
step = 1,
timeFormat = "%YYYY-%MM-%DD",
animate = T
)
})
})
# Filter data for the date selected
Filtered_Data <- reactive({
req(input$Date)
filter(df, Date == input$Date)
})

# Create the leaflet map
output$Time_Series_Map <- renderLeaflet({
leaflet(df) %>%
addTiles() %>%
setView(lat = 0, lng = 0, zoom = 2)
})
# Create data markers for selected date
observe({
# print(input$Date)
leafletProxy("Time_Series_Map", data = Filtered_Data()) %>%
addCircleMarkers(
lng = ~lon, lat = ~lat,
popup = ~id
)
})
}
# Run the application
shinyApp(ui = ui, server = server)