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 table 转换为 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)

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

xts argument error in an R Shiny application

r

shiny

xts