R Highcharter：将 xAxis 类型从日期时间更改为类别

Question

我想将 x 轴类型从日期时间更改为类别。例如：主图表是按组划分的折线图，向下钻取图是柱形图。

Highcharts 中给出了一个解决方案（Highcharts, Can you change the chart type for drilldowns?，Highcharts chart with 'datetime' xAxis - use categories on drilldown），但我无法将其翻译成 R。

PFB 代码。

library("dplyr")
library("purrr")
library("highcharter")

df <- data_frame(
  car_brand = c("Hyundai","Hyundai","Hyundai", "Benz","Benz","Benz", "Tesla","Tesla","Tesla"),
  units_sold = c(10,15,20,11,8,13,6,5,7),
  date = c("2019-01-01", "2019-02-01","2019-03-01","2019-01-01","2019-02-01","2019-03-01","2019-01-01","2019-02-01","2019-03-01")
)

df$units_sold <- as.numeric(df$units_sold)
df$date <- as.Date(df$date)
df$drilldown <- paste(df$car_brand, ",", df$date)
carBrands<- df %>%
  select(date, car_brand)

getCarDetails<- function(brands){

  carList <- list()
  listofdfs <- list() #Create a list in which you intend to save your df's.

  for(i in 1:nrow(brands)){ #Loop through the numbers of ID's instead of the ID's

    #You are going to use games[i] instead of i to get the ID
    BrandCarData <- data_frame(
      car = c("H1","H2","H3","H4","H5"),
      units = c(1,2,3,4,5)
    )
    BrandCarData$units <- as.numeric(BrandCarData$units)
    dsCar <- list_parse2(BrandCarData)
    listofdfs[[i]] <- dsCar
    carList[[i]] <- list (name = brands[[2]][i],
                          type = "column",
                          id = paste(brands[[2]][i], ",", brands[[1]][i]),
                          data = listofdfs[[i]])
  }

  return(carList) #Return the list of dataframes.
}

listCar <- getCarDetails(brands = carBrands)

dfDates <- NULL
dfDates$Date <- datetime_to_timestamp(as.Date(df$date, format = "%Y-%m-%d"))
hc <- hchart(df,"line", hcaes(x=date, y =
                                units_sold, group
                              = car_brand )) %>%
  hc_xAxis(categories = dfDates$Date, title = list(text = "<b>Date</b>"), type = "datetime") %>%
  hc_plotOptions(column = list(dataLabels = list(enabled = FALSE), enableMouseTracking = TRUE))%>%
  hc_tooltip(borderWidth = 1.5,
             pointFormat = paste('<span style="color:{series.color}">{series.name}</span>: <b>{point.y}</b><br/>')) %>%
  hc_legend(enabled = TRUE) %>%
  hc_title(text = "Brand Units Sold Monthy Trend",
           style = list(fontSize = "12px", fontWeight = "bold")) %>%
  hc_yAxis(title = list(text = "<b>Units <br>(In Thousands)</br></b>"))
hc

hc1 <- hc %>%
  hc_drilldown(allowPointDrilldown = TRUE,
               series = listCar)
hc1

从附图可以看出，第二张图表的 x 轴仍以日期时间格式显示 x 轴标签。

有什么建议吗？

Answer 1

类似问题：Drilldown to multiple series from different groups - Highcharter (in R)

您还可以在 R (Highcharter) 中找到类似的 Highcharts 深入示例：https://stackoverflow.com/users/8618934/raf18seb?tab=answers

编辑：我从上面的链接中复制/粘贴了代码，只添加了一行“type: 'column'”。这是一个从行到列向下钻取的工作示例：

library(highcharter)
library(dplyr)
library(purrr)

df <- tibble(x = c(1, 2, 3, 2, 3, 4, 3, 5, 4), y = c(1, 2, 1, 3, 3, 2, 4, 6, 5), key = c(rep("A", 3), rep("B", 3), rep("C", 3)),
             drilldown = c(rep("a", 3), rep("b", 3), rep("c", 3)))

drill1 <- data.frame(
  x = c(1,2,3),
  y = c(3, 3, 1)
)
drill1 <- list_parse2(drill1)

drill2 <- data.frame(
  x = c(1,2,4),
  y = c(1, 5, 1)
)
drill2 <- list_parse2(drill2)

drill3 <- data.frame(
  x = c(1,2,4),
  y = c(4, 3, 1)
)
drill3 <- list_parse2(drill3)


hchart(df, "line", 
       hcaes(x = x, y = y, group = key),
       color = c("#A63A50", "#37123C", "#DDA77B"),
       drilldown = TRUE) %>% 
  hc_chart(events = list(drilldown = JS("function(e) {
            e.preventDefault()
            var chart = this,
              series = [{
                type: 'column',
                data: [5, 5, 5, 3, 2]
              }, {
              type: 'column',
                data: [3, 3, 7, 3, 3]
              }];

            chart.addSingleSeriesAsDrilldown(e.point, series[0]);
            chart.addSingleSeriesAsDrilldown(e.point, series[1]);
            chart.applyDrilldown();
        }"))) %>% 
  hc_plotOptions(line = list(marker = list(enabled = FALSE), legendIndex = 1)) %>% 
  hc_drilldown(
    allowPointDrilldown = TRUE,
    series = list(
      list(
        id = "a",
        data = drill1
      ),
      list(
        id = "b",
        data = drill2
      ),
      list(
        id = "c",
        data = drill3
      )
    )
  )

编辑 2：

这是一个代码，可让您在向下钻取后将 xAxis 的类型更改为类别：

hc_chart(events = list(drilldown = JS("function(){
    this.xAxis[0].update({
      categories: ['aaa', 'bbb', 'ccc']
    });
  }"))) %>%

API 参考：https://api.highcharts.com/highcharts/chart.events.drilldown https://api.highcharts.com/class-reference/Highcharts.Axis#update https://api.highcharts.com/highcharts/xAxis.categories

Answer 2

根据 raf18seb 的输入，我找到了自定义钻取 x 轴标签的解决方案。除此之外，我还将分享如何更改图表和轴的标题。

在我之前的代码中，我在 hc_xAxis 中指定了 x 轴类型，如下面的代码所示：

hc_xAxis(categories = dfDates$Date, title = list(text = "<b>Date</b>"), type = "datetime") 

这是问题的主要原因。您不应在主要级别指定类别，而应在深入级别指定类别类型。请在下面找到修改后的代码：

getCarDetails<- function(brands){
  //This function can also be used to dynamically populate the data for drilldown //chart instead of specifiying it inside a JS code.
  carList <- list()
  listofdfs <- list() 
  for(i in 1:nrow(brands)){ 
    BrandCarData <- data_frame(
      car = c("H1","H2","H3","H4","H5"),
      units = c(1,2,3,4,5)
    )
    BrandCarData$units <- as.numeric(BrandCarData$units)
    dsCar <- list_parse2(BrandCarData)
    listofdfs[[i]] <- dsCar
    carList[[i]] <- list (name = brands[[2]][i],
                          type = "column", //Specify the xAxis category type
                          id = paste(brands[[2]][i], ",", brands[[1]][i]),
                          data = listofdfs[[i]])
  }

  return(carList) #Return the list of dataframes.
}

现在，在下面的代码中，我还添加了代码以更改向下钻取和向上钻取的图表和轴的标题。

hchart(df,"line", hcaes(x=format(as.Date(date), "%b,%Y"), y =
                                 units_sold, group
                               = car_brand )
) %>%
  hc_drilldown(allowPointDrilldown = TRUE,
               series = listCar)%>%
  hc_chart(events=list(drilldown=JS('function(e) 
                                      {
                                       this.setTitle({text: "Units Distribution Across Cars"});
                                       this.yAxis[0].axisTitle.attr({ text: "Units (in Thousands)"});
                                       this.xAxis[0].axisTitle.attr({ text: "Car Types" });
                                    }'),
                       drillup = JS("function() {this.update({title: {text: 'Brand-wise Units Sold Monthy Trend' }});
                                                 this.xAxis[0].setTitle({ text: 'Date' });
            this.yAxis[0].setTitle({ text: 'Units Sold (in Thousands)' });}")
  ))%>%
  hc_xAxis(title = list(text = "<b>Date</b>")) %>%
  hc_plotOptions(column = list(dataLabels = list(enabled = FALSE), enableMouseTracking = TRUE))%>%
  hc_tooltip(borderWidth = 1.5,
             pointFormat = paste('<span style="color:{series.color}">{series.name}</span>: <b>{point.y}</b><br/>')) %>%
  hc_legend(enabled = TRUE) %>%
  hc_title(text = "Brand-wise Units Sold Monthy Trend",
           style = list(fontSize = "12px", fontWeight = "bold"))%>%
  hc_yAxis(title = list(text = "<b>Units <br>(In Thousands)</br></b>"))

希望以后遇到这个问题的人会发现这很有用。