汇总数据的Highchart

Question

我在 R 中使用 highchart 创建了一个折线图，现在我正在尝试根据周和月聚合数据。我在网上搜索并在 java 中找到了一个解决方案，但我不太确定如何使用 R 实现相同的解决方案

下面是我的代码、数据集 sn-p 和当前图表的快照

代码：

highchart(type = "stock") %>% 
    hc_title(text = paste("Number of cases by diseases over time")) %>% 
    hc_subtitle(text = "This dataset was produced from disease data from 2014 to 2017") %>% 
    hc_add_series_times_values(salmonella_all_subset$date,
                               salmonella_all_subset$Gonorrhea,
                               name = "Gonorrhea") %>% 
    hc_add_series_times_values(salmonella_all_subset$date,
                               salmonella_all_subset$Shigellosis,
                               name = "Shigellosis") %>% 
    hc_add_series_times_values(salmonella_all_subset$date,
                               salmonella_all_subset$`Campylobacteriosis Enteritis`,
                               name = "Campylobacteriosis Enteritis") %>% 
    hc_add_series_times_values(salmonella_all_subset$date,
                               salmonella_all_subset$Chlamydia,
                               name = "Chlamydia") %>% 
    hc_add_series_times_values(salmonella_all_subset$date,
                               salmonella_all_subset$Salmonellosis,
                               name = "Salmonellosis") %>% 

    hc_add_theme(hc_theme_sandsignika())




date    Campylobacteriosis Enteritis    Chlamydia   Gonorrhea   Salmonellosis   Shigellosis
1/2/2014    1   10  2   1   0
1/3/2014    2   3   0   1   0
1/4/2014    0   2   0   0   0
1/5/2014    0   1   0   0   0
1/6/2014    3   7   0   0   0
1/7/2014    1   18  4   0   0
1/8/2014    1   14  5   0   0
1/9/2014    0   12  5   0   0
1/10/2014   0   26  3   0   0
1/11/2014   0   5   2   0   0
1/12/2014   1   1   0   1   0
1/13/2014   0   9   4   0   0
1/14/2014   0   21  4   0   0
1/15/2014   1   22  6   0   0
1/16/2014   0   18  4   0   0
1/17/2014   0   14  3   0   0
1/18/2014   0   6   1   0   0
1/19/2014   0   2   2   0   0
1/20/2014   1   4   4   1   0
1/21/2014   0   4   3   0   0
1/22/2014   1   13  2   0   0
1/23/2014   0   12  4   0   0
1/24/2014   0   17  7   0   0
1/25/2014   0   4   0   2   0
1/26/2014   0   5   1   0   0
1/27/2014   0   16  2   0   0
1/28/2014   2   26  3   0   0
1/29/2014   0   14  4   0   0
1/30/2014   0   12  0   0   0
1/31/2014   0   8   5   0   0
2/1/2014    0   5   1   1   0
2/2/2014    1   1   0   0   0
2/3/2014    2   15  5   1   0
2/4/2014    0   19  4   1   1
2/5/2014    1   11  3   1   0
2/6/2014    0   17  6   0   0
2/7/2014    0   19  6   0   0
2/8/2014    0   4   0   0   0
2/9/2014    0   0   1   1   0
2/10/2014   1   17  5   0   0
2/11/2014   0   13  6   0   0
2/12/2014   1   18  5   0   0
2/13/2014   1   6   1   0   1
2/14/2014   1   6   6   0   0
2/15/2014   0   2   2   0   0
2/16/2014   1   2   0   1   0
2/17/2014   0   3   1   1   0
2/18/2014   0   12  2   0   0
2/19/2014   0   9   1   0   0
2/20/2014   0   9   2   0   0
2/21/2014   0   15  4   0   0

下面是我想要的链接，我需要添加日、周和月单选按钮

http://jsfiddle.net/X5WbN/20/

Answer 1

嗨，这可以很容易地在闪亮的情况下完成。您需要的功能是floor_date from lubridate 这是一个工作示例

library(shiny)
library(highcharter)
library(lubridate)
library(dplyr)
df <- read.table(header = TRUE,sep = ",",text = "date,Campylobacteriosis Enteritis,Chlamydia,Gonorrhea,Salmonellosis,Shigellosis
1/2/2014,1,10,2,1,0
                 1/3/2014,2,3,0,1,0
                 1/4/2014,0,2,0,0,0
                 1/5/2014,0,1,0,0,0
                 1/6/2014,3,7,0,0,0
                 1/7/2014,1,18,4,0,0
                 1/8/2014,1,14,5,0,0
                 1/9/2014,0,12,5,0,0
                 1/10/2014,0,26,3,0,0
                 1/11/2014,0,5,2,0,0
                 1/12/2014,1,1,0,1,0
                 1/13/2014,0,9,4,0,0
                 1/14/2014,0,21,4,0,0
                 1/15/2014,1,22,6,0,0
                 1/16/2014,0,18,4,0,0
                 1/17/2014,0,14,3,0,0
                 1/18/2014,0,6,1,0,0
                 1/19/2014,0,2,2,0,0
                 1/20/2014,1,4,4,1,0
                 1/21/2014,0,4,3,0,0
                 1/22/2014,1,13,2,0,0
                 1/23/2014,0,12,4,0,0
                 1/24/2014,0,17,7,0,0
                 1/25/2014,0,4,0,2,0
                 1/26/2014,0,5,1,0,0
                 1/27/2014,0,16,2,0,0
                 1/28/2014,2,26,3,0,0
                 1/29/2014,0,14,4,0,0
                 1/30/2014,0,12,0,0,0
                 1/31/2014,0,8,5,0,0
                 2/1/2014,0,5,1,1,0
                 2/2/2014,1,1,0,0,0
                 2/3/2014,2,15,5,1,0
                 2/4/2014,0,19,4,1,1
                 2/5/2014,1,11,3,1,0
                 2/6/2014,0,17,6,0,0
                 2/7/2014,0,19,6,0,0
                 2/8/2014,0,4,0,0,0
                 2/9/2014,0,0,1,1,0
                 2/10/2014,1,17,5,0,0
                 2/11/2014,0,13,6,0,0
                 2/12/2014,1,18,5,0,0
                 2/13/2014,1,6,1,0,1
                 2/14/2014,1,6,6,0,0
                 2/15/2014,0,2,2,0,0
                 2/16/2014,1,2,0,1,0
                 2/17/2014,0,3,1,1,0
                 2/18/2014,0,12,2,0,0
                 2/19/2014,0,9,1,0,0
                 2/20/2014,0,9,2,0,0
                 2/21/2014,0,15,4,0,0")

df$date <- df$date %>% as.character() %>% as.Date(format = "%m/%d/%Y")

# Define UI for application that draws a histogram
ui <- fluidPage(

   # Application title
   titlePanel("Highchart Grouping"), 

   # Sidebar with a slider input for number of bins 
   sidebarLayout(
      sidebarPanel(
         radioButtons("intervall",
                     "Aggregation level:",
                     choices = c("Day" = "day","Month" = "month","Year" = "year"))
      ),

      # Show a plot of the generated distribution
      mainPanel(
         highchartOutput("Plot")
      )
   )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
   dta <- reactive({
     df %>% 
       group_by(date = floor_date(date,input$intervall)) %>% 
       summarise_if(is.numeric,sum)
   })


   output$Plot <- renderHighchart({
     salmonella_all_subset <- dta()
     highchart(type = "stock") %>% 
       hc_title(text = paste("Number of cases by diseases over time")) %>% 
       hc_subtitle(text = "This dataset was produced from disease data from 2014 to 2017") %>% 
       hc_add_series_times_values(salmonella_all_subset$date,
                                  salmonella_all_subset$Gonorrhea,
                                  name = "Gonorrhea") %>% 
       hc_add_series_times_values(salmonella_all_subset$date,
                                  salmonella_all_subset$Shigellosis,
                                  name = "Shigellosis") %>% 
       hc_add_series_times_values(salmonella_all_subset$date,
                                  salmonella_all_subset$Campylobacteriosis.Enteritis,
                                  name = "Campylobacteriosis Enteritis") %>% 
       hc_add_series_times_values(salmonella_all_subset$date,
                                  salmonella_all_subset$Chlamydia,
                                  name = "Chlamydia") %>% 
       hc_add_series_times_values(salmonella_all_subset$date,
                                  salmonella_all_subset$Salmonellosis,
                                  name = "Salmonellosis") %>% 

       hc_add_theme(hc_theme_sandsignika())
   })
}

# Run the application 
shinyApp(ui = ui, server = server)

希望这会有所帮助！

Answer 2

似乎解决这个问题的一个简单方法就是使用 tabPanel。您可以为每个选项卡：日、周、月。然后，您只需创建 3 个不同的输出，其中您的数据基于天、周、月。

用户界面：

mainPanel(
  tabsetPanel(
    tabPanel("Day", plotOutput("dayPlot")),
    tabPanel("Week", plotOutput("weekPlot")),
    tabPanel("Month", plotOutput("monthPlot"))
  )
)

服务器：

output$dayPlot <- renderPlot ({
#code to aggregate data based upon day
#lineplot
})

output$weekPlot <- renderPlot ({
#code to aggregate data based upon week
#lineplot
})

output$monthPlot <- renderPlot ({
#code to aggregate data based upon month
#lineplot
})

我会研究 lubridate 和 dlpyr 包，以帮助根据日、周和月进行汇总