在闪亮的应用程序中基于日期范围的子集 xts 索引

Question

在下面的

shiny

应用程序中，我尝试对 xts 对象进行子集化，因此基于日期范围的绘图，但在创建初始绘图时，我得到 A

esthetics must be either length 1 or the same as the data (2514).

## app.R ##
library(shiny)
library(shinydashboard)
library("vctrs")
library("xts")
library('quantmod')
library('tseries')
library('forecast')
library('ggplot2')
library('reshape2')
library(stats)
library(forecast)
library(shinyWidgets)


ABT <- getSymbols(Symbols = "ABT", src = "yahoo", from = Sys.Date() - 20*365, 
                  to = Sys.Date(), auto.assign = FALSE)

# Select only Close price
ABT <- Cl(ABT)

ABV<- getSymbols(Symbols = "ABV", src = "yahoo", from = Sys.Date() - 20*365, 
                 to = Sys.Date(), auto.assign = FALSE)
ABV <- Cl(ABV)

SP500 <- getSymbols(Symbols = "^GSPC", src = "yahoo", from = Sys.Date() - 20*365, 
                    to = Sys.Date(), auto.assign = FALSE)
SP500<-Cl(SP500)
Dow_J <- getSymbols("^DJI", src = "yahoo", from = Sys.Date() - 20*365, 
                    to = Sys.Date(), auto.assign = FALSE)
Dow_J<-Cl(Dow_J)

# Assuming your xts object is named 'my_xts'
first_row_name <- index(ABT)[1]
last_row_name <- index(ABT)[nrow(ABT)]

ui <- dashboardPage(
  dashboardHeader(title = "Share price prediction and movement"),
  dashboardSidebar(
    
    dateRangeInput('dateRange',
                   label = 'Date range',
                   start = first_row_name , end = Sys.Date() 
    )
    
  ),
  dashboardBody(
    
    fluidRow(
      column(12,
             plotOutput("plot2")
      )
    )
  )
)

server <- function(input, output) { 
  
  output$plot2<-renderPlot({
    spf_dw_data <- merge(SP500, Dow_J)
    spf_dw_data<-subset(spf_dw_data, index(spf_dw_data) >= input$dateRange[1] & index(spf_dw_data) <= input$dateRange[2])
    DateSJ <- index(spf_dw_data)
    
    ggplot(spf_dw_data, aes(x=DateSJ)) +
      geom_line(aes(y = SP500, color = "S&P 500"), size = 1) +
      geom_line(aes(y = Dow_J, color = "Dow Jones"), size = 1) +
      labs(title = "Stock Prices Over Time",
           y = "Adjusted Close Price",
           color = "Company") +
      theme_minimal()
    
  })
  
  
}

shinyApp(ui, server)

Answer 1

不要羞于使用

xts

强大的本机日期过滤机制，并记住 ggplot 旨在与

data.frame

对象一起使用......它可以与

xts

对象一起使用，但会有一些怪癖。下面的版本应该按照您期望的方式工作

## app.R ##
library(shiny)
library(shinydashboard)
library("vctrs")
library("xts")
library('quantmod')
library('tseries')
library('forecast')
library('ggplot2')
library('reshape2')
library(stats)
library(forecast)
library(shinyWidgets)


ABT <- getSymbols(Symbols = "ABT", src = "yahoo", from = Sys.Date() - 20*365, 
                  to = Sys.Date(), auto.assign = FALSE)

# Select only Close price
ABT <- Cl(ABT)

ABV<- getSymbols(Symbols = "ABV", src = "yahoo", from = Sys.Date() - 20*365, 
                 to = Sys.Date(), auto.assign = FALSE)
ABV <- Cl(ABV)

SP500 <- getSymbols(Symbols = "^GSPC", src = "yahoo", from = Sys.Date() - 20*365, 
                    to = Sys.Date(), auto.assign = FALSE)
SP500<-Cl(SP500)
Dow_J <- getSymbols("^DJI", src = "yahoo", from = Sys.Date() - 20*365, 
                    to = Sys.Date(), auto.assign = FALSE)
Dow_J<-Cl(Dow_J)

# Assuming your xts object is named 'my_xts'
first_row_name <- index(ABT)[1]
last_row_name <- index(ABT)[nrow(ABT)]

ui <- dashboardPage(
  dashboardHeader(title = "Share price prediction and movement"),
  dashboardSidebar(
    
    dateRangeInput('dateRange',
                   label = 'Date range',
                   start = first_row_name , end = Sys.Date() 
    )
    
  ),
  dashboardBody(
    
    fluidRow(
      column(12,
             plotOutput("plot2")
      )
    )
  )
)

server <- function(input, output) { 
  
  output$plot2 <- renderPlot({
    spf_dw_data <- merge(SP500, Dow_J)
    date_filter_str <- sprintf('%s::%s', input$dateRange[ 1 ], input$dateRange[ 2 ])
    spf_dw_data <- spf_dw_data[ date_filter_str ]
    spf_dw_data_df <- as.data.frame(spf_dw_data)
    spf_dw_data_df$date <- rownames(spf_dw_data_df) |> as.Date()
    
    ggplot(spf_dw_data_df, aes(x = date)) +
      geom_line(aes(y = GSPC.Close, color = "S&P 500"), size = 1) +
      geom_line(aes(y = DJI.Close, color = "Dow Jones"), size = 1) +
      labs(title = "Stock Prices Over Time",
           y = "Adjusted Close Price",
           color = "Company") +
      theme_minimal()
    
  })
  
  
}

shinyApp(ui, server)