R - Highcharter: Drilldown on stacked column graph

Question

I've created a stacked column chart in Highcharter using R and I am trying to be able to drilldown into it.

I.e. In the picture attached, I want to be able to drill down in the red section of column CRDT. So far, I can only get it so each color section of CRDT drills into the same information OR each red section drills into the same information. I need a combined filter.

Below is my code that drills "CRDT Red" information for all red sections:

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

I have figured out the code, however it is not an eloquent solution...

The trick is instead of having a single data frame for the Level 1 information, there needs to be a separate data frame for each part of the stack. This way you can put an ID to it in order to be able to reference.

My code is hundreds of lines in order to splice out the data in the way it needs to be so if anyone has a better solution, please post it!! (my actually code includes 7 other groups besides "CRDT", so imagine "CRDT" lines below * 7!!!

FYI, I have changed some of my dashboard and variables, so they may not be the same as above...

    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")))