R - как извлечь информацию о дате из объекта Highcharter - PullRequest
0 голосов
/ 14 апреля 2020

Я пытаюсь написать приложение, которое могло бы реактивно брать даты из диаграммы старшего разряда и в конечном итоге сохранять их в реактивном значении (или для этого упражнения просто распечатайте его так, как это сделает textOutput). Таким образом, было бы здорово, если бы даты «от» и «до» (как показано в выводе старшей диаграммы) могли быть извлечены на основе пользовательского ввода на графике. Пожалуйста, дайте мне знать, если мой вопрос не ясен. Спасибо!

Ниже приведен пример кода:

library(tidyverse)
library(highcharter)
library(shiny)

if(interactive()){

  ui <- fluidPage(
    sidebarLayout(
      sidebarPanel(

        fluidRow(
          column(
            6,
            uiOutput("slctInpt_render")
          ),
          column(
            3,
            p("print date FROM here...")
          ),
          column(
            3,
            p("print date TO here...")
          )
        ),

        fluidRow(
          column(
            6,
            highchartOutput(
              "highChrt",
              width = "100%",
              height = "400px"
            )
          )
        ),

        shiny::tags$br(),

        fluidRow(
          column(
            12,
            DT::DTOutput("datatable")
          )
        )

      ),
      mainPanel()
    )
  )

  server <- function(input, output, session) {

    df <- 
      reactive({
        data.frame(
          Date = 
            as.Date(
              c(
                "01-01-2019","02-01-2019","03-01-2019","04-01-2019",
                "05-01-2019","06-01-2019","07-01-2019","08-01-2019",
                "09-01-2019","10-01-2019","11-01-2019","12-01-2019",
                "13-01-2019"
              ),
              format = "%d-%m-%Y"
            ),
          Frequency_1 = c(
            3,5,1,2,6,7,9,7,5,2,3,2,1
          ),
          Frequency_2 = c(
            5,9,7,4,8,13,15,9,11,14,24,28,36
          ),
          Category = c(
            "A", "B", "A", "C", "C", "B", "C",
            "A", "B", "A", "C", "C", "C"
          )
        )
      })

    output$slctInpt_render <- renderUI({
      df <- df()
      selectInput(
        "category",
        "Category",
        choices = c(
          unique(
            as.character(
              df$Category
            )
          )
        ),
        selected = c("A","B","C"), 
        multiple = TRUE, 
        width = "100%"
      )
    })

    observeEvent(input$category, {
      df <- df() %>% 
        dplyr::filter(
          Category == input$category
        )

      output$highChrt <- renderHighchart({
        highchart(
          type = "stock",
        ) %>% 
          hc_add_series(
            df, 
            type = "line",
            hcaes(Date, Frequency_1),
            color = "green"
          ) %>% 
          hc_add_series(
            df, 
            type = "line",
            hcaes(Date, Frequency_2),
            color = "blue"
          )
      })
    })

    output$datatable <- DT::renderDT ({
      DT::datatable(
        data = df()
      )
    })

  }

  shinyApp(ui, server)
}
...