highcharts highchart未在rshiny中呈现,但正在我的目录中工作

webghufk  于 2022-11-10  发布在  Highcharts
关注(0)|答案(1)|浏览(191)

我尝试用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)

第一次

yptwkmov

yptwkmov1#

试试这个

library(shinyjs)
library(shiny)
library(shinydashboard)
library(highcharter)
library(forecast)
library(lubridate)
library(zoo)
library(xts)

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_prts",width = "auto", height = "600px"),
                   ),
                 )
               )
             )),
    tabPanel("Multiple stocks analysis", tabName = "mult_stock", icon = icon("th"))
  )
)

server <- function(input, output, session){
  cs <- new.env()
  # dt_new <- eventReactive(c(input$ticker,input$date[1],input$date[2]), {
  dt_new <- reactive({
    if (input$ticker =="AirPassengers"){
      data(AirPassengers)
      print("Hello")
      mydata1 <- AirPassengers
    } else if (input$ticker =="ttrc"){
      data(ttrc) 
      mydata1 <- ttrc
    }

    as.data.frame(mydata1)
  })

  df1 <- reactive({
    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)
    df2
  })

  output$closing_prts <- renderHighchart({
    df2 <- df1()
    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$tbl1 <- renderDT({datatable(dt_new())})

  output$summary1 <- renderPrint({
    summary(dt_new())
  })

  output$struc<- renderPrint({
    str(dt_new())
  })

}

shinyApp(ui, server)

相关问题