Início / coding / Perguntas / 78340918
Accepted
firmo23
Asked: 2024-04-17 20:19:24 +0800 CST

Índice xts de subconjunto com base no intervalo de datas em um aplicativo brilhante

  • 772

No shinyaplicativo abaixo, estou tentando subdividir o objeto xts e, portanto, o gráfico com base no intervalo de datas, mas enquanto o gráfico inicial é criado, recebo Aesthetics 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)

1 respostas

  1. Best Answer

    Não tenha vergonha de usar xtsum poderoso mecanismo nativo de filtragem de datas e lembre-se de que o ggplot foi feito para ser usado com data.frameobjetos... ele funcionará com xtsobjetos, mas haverá peculiaridades. A versão abaixo deve funcionar da maneira que você espera

    ## 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)
    • 2

relate perguntas