我尝试用highchart来重现分解后的时间序列图。结果在r的工作目录中是完美的,但是当我把它放在r shinning中时没有结果出来。下面是我的代码
library(shinyjs)
library(shiny)
library(shinydashboard)
library(highcharter)
library(forecast)
shinyOptions(bslib = TRUE)
bs_global_theme()
bs_theme_base_colors(bg = "#002B36", fg = "#EEE8D5")
bs_theme_accent_colors(primary = "#2AA198")
thematic::thematic_shiny()
ui<-fluidPage(
theme=shinytheme("cerulean"),
themeSelector(),
useShinyjs(),
navbarPage(
title= "Stock exchange", position = "static-top",
id="nav",
tabPanel("Single stock analysis",value = "single_stock", icon = icon("chart-area"),
sidebarLayout(
div(id = "Sidebar",
sidebarPanel(width = 3, align = "center",
selectInput("ticker",
strong("Ticker"),
# quotes$Symbole,
choices = c("AirPassengers", "ttrc"),
selectize = TRUE
),
dateRangeInput("date", strong("Select data range"),
start = "2012-01-01", end = (Sys.Date()-1)
),
tags$br(),
fluidPage(column(width = 3, "Session")
)
)),
mainPanel(
fluidRow(align = "center",
selectInput("hideorshow", label = strong("Sidebar disposition"),
choices = c("Show", "Hide"), selected = "Show")),
tabsetPanel(
tabPanel("Data structure and summary",
icon = icon("table"),
h1(align = "center",
strong(" STRUCTURE OF THE DATAFRAME ")),
tags$br(),tags$b(),class="fa fa-table",
verbatimTextOutput("struc"),
tags$br(),tags$br(),
h1(align = "center",strong(" SUMMARY OF THE DATAFRAME ")),
br(),verbatimTextOutput("summary1")
),
tabPanel("Dataset",icon = icon("tablet-alt"), DTOutput('tbl1')),
tabPanel("Plot",icon = shiny::icon('chart-bar'), br(),br(), br(),
airDatepickerInput(inputId = "date.ts",
strong("Time of the first observation"),
value = "2017-01-01",
minDate = "1998-09-16",
maxDate = Sys.Date(),
view = "months",
minView = "months",
dateFormat = "yyyy-mm"),
highchartOutput("closing_pr.ts",width = "auto", height = "600px"),
),
)
)
)),
tabPanel("Multiple stocks analysis", tabName = "mult_stock", icon = icon("th"))
)
)
我认为问题是躲在服务器里;准确的渲染Highchart,但我找不到它。请任何帮助将不胜感激。
cs <- new.env()
dt_new <- eventReactive(c(input$ticker,input$date[1],input$date[2]), {
if (input$ticker =="AirPassengers"){
data(AirPassengers)
mydata1 <- AirPassengers
}
else if (input$ticker =="ttrc"){
data(ttrc)
mydata1 <- ttrc
}
mydata1
})
output$closing_pr.ts<-renderHighchart({
year.ts <- as.numeric(year(input$date.ts))
month.ts <- as.numeric(month(input$date.ts))
dc <- decompose(AirPassengers)
df <- as.data.frame(dc[c("x","trend","seasonal","random")])
df2 <- data.frame(Date = index(dc$x),
apply(df, 2, as.numeric))
names(df2) <- c("Date", "Observed", "Trend", "Seasonal", "Random")
df2$Date <- as.Date(yearmon(df2$Date))
df2 <- as.xts(df2[,-c(1)],
order.by = df2$Date)
df2 <- round(df2, digits = 3)
highchart(type = "stock") %>%
hc_title(text = "TIME SERIE DECOMPOSITION") %>%
hc_add_series(df2[, "Observed"], yAxis = 0, name = "Observed", showInLegend = FALSE) %>%
hc_add_yAxis(nid = 1L, title = list(text = "Observed"), relative = 2) %>%
hc_add_series(df2[, "Trend"], yAxis = 1, type = "line",name = "Trend", showInLegend = FALSE) %>%
hc_add_yAxis(nid = 2L, title = list(text = "Trend"), relative = 1)%>%
hc_add_series(df2[, "Seasonal"], yAxis = 2, type = "line",name = "Seasonal", showInLegend = FALSE) %>%
hc_add_yAxis(nid = 1L, title = list(text = "Seasonal"), relative = 2) %>%
hc_add_series(df2[, "Random"], yAxis = 3, type = "line", name = "Random", showInLegend = FALSE) %>%
hc_add_yAxis(nid = 2L, title = list(text = "Random"), relative = 1)%>%
hc_exporting(
enabled = TRUE, # always enabled,
filename = paste0("Closing price decomposition line charts from ",
min(index(df2)),
" to ", max(index(df2))))%>%
hc_colors(colors = c("blue", "red", "cyan", "darkgreen"))
})
observeEvent(input$hideorshow, {
if ( input$hideorshow== "Show") {
shinyjs::show(id = "Sidebar")}
else {shinyjs::hide(id = "Sidebar")}
})
output$summary1 <- renderPrint({
summary(dt_new())
})
output$struc<- renderPrint({
str(dt_new())
})
}
shinyApp(ui=ui, server = server)
第一次
1条答案
按热度按时间yptwkmov1#
试试这个