R - Highcharter：在堆积柱形图上向下钻取

Question

我已经使用 R 在 Highcharter 中创建了一个堆积柱形图，我正在尝试深入研究它。

即在附图中，我希望能够在 CRDT 列的红色部分向下钻取。到目前为止，我只能让 CRDT 的每个颜色部分钻入相同的信息，或者每个红色部分钻入相同的信息。我需要一个组合过滤器。

下面是我为所有红色部分钻取“CRDT Red”信息的代码：

Lvl1Grouping <- aggregate(WIPGate2$Receipt.Qty, by = list(WIPGate$Hold.Code,WIPGate2$Aging),FUN=sum)

Lvl1df <- data_frame(name = Lvl1Grouping$Group.1,
                 y = Lvl1Grouping$x,
                 stack = Lvl1Grouping$Group.2,
                 drilldown = tolower(stack)
                 )

hc <- highchart() %>%
      hc_chart(type = "column") %>%
      hc_title(text = "WIP") %>%
      hc_xAxis(type = "category") %>%
      hc_legend(enabled = FALSE) %>%
      hc_plotOptions(column = list(stacking = "normal")) %>%
      hc_add_series(name = "Greater than 30  days",data=Lvl1dfLvl1df$stack=="Greater than 30 days",], color = "#D20000") %>%
      hc_add_series(name = "Between 20-30 days",data=Lvl1df[Lvl1df$stack=="Between 20-30 days",], color = "#FF7900") %>%
      hc_add_series(name = "Between 10-20 days",data=Lvl1df[Lvl1df$stack=="Between 10-20 days",], color = "#F6FC00") %>%
      hc_add_series(name = "Less than 10 days",data=Lvl1df[Lvl1df$stack=="Less than 10 days",], color = "#009A00")

hc

Lvl2GroupingCRDT <- WIPGate2[WIPGate2$Hold.Code == "CRDT",]
Lvl2GroupingCRDT4 <- Lvl2GroupingCRDT[Lvl2GroupingCRDT$Aging == "Greater than 30 days",]
Lvl2GroupingCRDT4 <- aggregate(Lvl2GroupingCRDT4$Receipt.Qty, by = list(Lvl2GroupingCRDT4$Customer.Name),FUN=sum)

dfCRDT4 <- data_frame(
           name = Lvl2GroupingCRDT4$Group.1,
           value = Lvl2GroupingCRDT4$x
           )

hc <- hc %>%
      hc_drilldown(
         allowPointDrilldown = TRUE,
         series = list(
           list(
            id = "greater than 30 days",
            name = "CRDT",
            data = list_parse2(dfCRDT4)
           )
          )
      )
hc

Current Situation.png

Answer 1

我已经弄清楚了代码，但这不是一个雄辩的解决方案......

诀窍是不是为级别 1 信息提供一个数据帧，而是需要为堆栈的每个部分提供一个单独的数据帧。通过这种方式，您可以为其添加一个 ID 以便能够参考。

我的代码有数百行，以便按照需要的方式拼接数据，所以如果有人有更好的解决方案，请发布！ （我的实际代码除了“CRDT”之外还包括其他 7 个组，所以想象一下 *7 下面的“CRDT”行！！！

仅供参考，我已经更改了一些仪表板和变量，因此它们可能与上述不同......

    WIPGate2Aging <- WIP_Ops_Filtered()[WIP_Ops_Filtered()$Hold.Code!="",]

    WIPGate2G30 <- WIPGate2Aging[WIPGate2Aging$Aging == "Greater than 30 days",]
    WIPGate22030 <- WIPGate2Aging[WIPGate2Aging$Aging == "Between 20-30 days",]
    WIPGate21020 <- WIPGate2Aging[WIPGate2Aging$Aging == "Between 10-20 days",]
    WIPGate2L10 <- WIPGate2Aging[WIPGate2Aging$Aging == "Less than 10 days",]

    try(Lvl1GroupingG30 <- aggregate(WIPGate2G30$Receipt.Qty, by = list(WIPGate2G30$Hold.Code),FUN=sum),silent = TRUE)
    if (exists("Lvl1GroupingG30")) {} else {Lvl1GroupingG30=data.table(Group.1=numeric(), x=numeric())}
    try(Lvl1Grouping2030 <- aggregate(WIPGate22030$Receipt.Qty, by = list(WIPGate22030$Hold.Code),FUN=sum),silent = TRUE)
    if (exists("Lvl1Grouping2030")) {} else {Lvl1Grouping2030=data.table(Group.1=numeric(), x=numeric())}
    try(Lvl1Grouping1020 <- aggregate(WIPGate21020$Receipt.Qty, by = list(WIPGate21020$Hold.Code),FUN=sum),silent = TRUE)
    if (exists("Lvl1Grouping1020")) {} else {Lvl1Grouping1020=data.table(Group.1=numeric(), x=numeric())}
    try(Lvl1GroupingL10 <- aggregate(WIPGate2L10$Receipt.Qty, by = list(WIPGate2L10$Hold.Code),FUN=sum),silent = TRUE)
    if (exists("Lvl1GroupingL10")) {} else {Lvl1GroupingL10=data.table(Group.1=numeric(), x=numeric())}

    Lvl1dfG30 <- data_frame(name = Lvl1GroupingG30$Group.1, y = Lvl1GroupingG30$x, drilldown = tolower((paste(name,"4"))))
    Lvl1df2030 <- data_frame(name = Lvl1Grouping2030$Group.1, y = Lvl1Grouping2030$x, drilldown = tolower((paste(name,"3"))))
    Lvl1df1020 <- data_frame(name = Lvl1Grouping1020$Group.1, y = Lvl1Grouping1020$x, drilldown = tolower((paste(name,"2"))))
    Lvl1dfL10 <- data_frame(name = Lvl1GroupingL10$Group.1, y = Lvl1GroupingL10$x, drilldown = tolower((paste(name,"1"))))

    Lvl2GroupingCRDTG30 <- WIPGate2Aging[WIPGate2Aging$Hold.Code == "CRDT" & WIPGate2Aging$Aging == "Greater than 30 days",]
    try(Lvl2GroupingCRDTG30b <- aggregate(Lvl2GroupingCRDTG30$Receipt.Qty, by = list(Lvl2GroupingCRDTG30$Customer.Name),FUN=sum),silent = TRUE)
    if (exists("Lvl2GroupingCRDTG30b")) {} else {Lvl2GroupingCRDTG30b=data.table(Group.1=numeric(), x=numeric())}
    Lvl2GroupingCRDT2030 <- WIPGate2Aging[WIPGate2Aging$Hold.Code == "CRDT" & WIPGate2Aging$Aging == "Between 20-30 days",]
    try(Lvl2GroupingCRDT2030b <- aggregate(Lvl2GroupingCRDT2030$Receipt.Qty, by = list(Lvl2GroupingCRDT2030$Customer.Name),FUN=sum),silent = TRUE)
    if (exists("Lvl2GroupingCRDT2030b")) {} else {Lvl2GroupingCRDT2030b=data.table(Group.1=numeric(), x=numeric())}
    Lvl2GroupingCRDT1020 <- WIPGate2Aging[WIPGate2Aging$Hold.Code == "CRDT" & WIPGate2Aging$Aging == "Between 10-20 days",]
    try(Lvl2GroupingCRDT1020b <- aggregate(Lvl2GroupingCRDT1020$Receipt.Qty, by = list(Lvl2GroupingCRDT1020$Customer.Name),FUN=sum),silent = TRUE)
    if (exists("Lvl2GroupingCRDT1020b")) {} else {Lvl2GroupingCRDT1020b=data.table(Group.1=numeric(), x=numeric())}
    Lvl2GroupingCRDTL10 <- WIPGate2Aging[WIPGate2Aging$Hold.Code == "CRDT" & WIPGate2Aging$Aging == "Less than 10 days",]
    try(Lvl2GroupingCRDTL10b <- aggregate(Lvl2GroupingCRDTL10$Receipt.Qty, by = list(Lvl2GroupingCRDTL10$Customer.Name),FUN=sum),silent = TRUE)
    if (exists("Lvl2GroupingCRDTL10b")) {} else {Lvl2GroupingCRDTL10b=data.table(Group.1=numeric(), x=numeric())}

    dfCRDTG30 <- arrange(data_frame(name = Lvl2GroupingCRDTG30b$Group.1,value = Lvl2GroupingCRDTG30b$x),desc(value))
    dfCRDT2030 <- arrange(data_frame(name = Lvl2GroupingCRDT2030b$Group.1,value = Lvl2GroupingCRDT2030b$x),desc(value))
    dfCRDT1020 <- arrange(data_frame(name = Lvl2GroupingCRDT1020b$Group.1,value = Lvl2GroupingCRDT1020b$x),desc(value))
    dfCRDTL10 <- arrange(data_frame(name = Lvl2GroupingCRDTL10b$Group.1,value = Lvl2GroupingCRDTL10b$x),desc(value))

highchart() %>%
  hc_chart(type = "column") %>%
  hc_xAxis(type = "category") %>%
  hc_yAxis(gridLineWidth = 0) %>%
  hc_legend(enabled = TRUE) %>%
  hc_plotOptions(column = list(stacking = "normal")) %>%
  hc_add_series(name = "Greater than 30 days",data=Lvl1dfG30, color = "#D20000") %>%
  hc_add_series(name = "Between 20-30 days",data=Lvl1df2030, color = "#FF7900") %>%
  hc_add_series(name = "Between 10-20 days",data=Lvl1df1020, color = "#F6FC00") %>%
  hc_add_series(name = "Less than 10 days",data=Lvl1dfL10, color = "#009A00") %>%

  hc_drilldown(
    allowPointDrilldown = TRUE,
    series = list(
      list(id = "crdt 4", data = list_parse2(dfCRDTG30), name="Customer"),
      list(id = "crdt 3", data = list_parse2(dfCRDT2030), name="Customer"),
      list(id = "crdt 2", data = list_parse2(dfCRDT1020), name="Customer"),
      list(id = "crdt 1", data = list_parse2(dfCRDTL10), name="Customer")))