how to create two independent drill down plot using Highcharter?

Here you go, both graphs operate independently of each other’s drilldowns.

I simplified your code as well as you had a lot of observes and reactives that were not needed (in this example at least).

cate<-c("Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","drinks","drinks","groceries","groceries","groceries","dairy","dairy","dairy","dairy","groceries","technology","technology","technology","technology","technology","technology","technology","technology","groceries","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","drinks","drinks","groceries","groceries","groceries","dairy","dairy","dairy","dairy","groceries","technology","technology","technology","technology","technology","technology","technology","technology","groceries","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","drinks","drinks","groceries","groceries","groceries","dairy","dairy","dairy","dairy","groceries","technology","technology","technology","technology","technology","technology","technology","technology","groceries","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","Furniture","drinks","drinks","groceries","groceries","groceries","dairy","dairy","dairy","dairy","groceries","technology","technology","technology","technology","technology","technology","technology","technology","groceries")
Sub_Product<-c("nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","nov","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","oct","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","sept","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug","aug")
Main_Product<-c("outdoor","indoor","outdoor","indoor","indoor","outdoor","indoor","indoor","indoor","indoor","outdoor","outdoor","n&o","n&o","indoor","indoor","indoor","indoor","outdoor","indoor","outdoor","outdoor","outdoor","indoor","outdoor","indoor","outdoor","outdoor","indoor","outdoor","n&o","outdoor","indoor","outdoor","indoor","indoor","outdoor","indoor","indoor","indoor","indoor","outdoor","outdoor","n&o","n&o","indoor","indoor","indoor","indoor","outdoor","indoor","outdoor","outdoor","outdoor","indoor","outdoor","indoor","outdoor","outdoor","indoor","outdoor","n&o","outdoor","indoor","outdoor","indoor","indoor","outdoor","indoor","indoor","indoor","indoor","outdoor","outdoor","n&o","n&o","indoor","indoor","indoor","indoor","outdoor","indoor","outdoor","outdoor","outdoor","indoor","outdoor","indoor","outdoor","outdoor","indoor","outdoor","n&o","outdoor","indoor","outdoor","indoor","indoor","outdoor","indoor","indoor","indoor","indoor","outdoor","outdoor","n&o","n&o","indoor","indoor","indoor","indoor","outdoor","indoor","outdoor","outdoor","outdoor","indoor","outdoor","indoor","outdoor","outdoor","indoor","outdoor","n&o")
Product<-c("abc","def","ghh","hig","lmn","opk","cba","dfw","ewr","csad","wer","casd","were","csad","rt","hgf","qeq","hgf","qer","qer2","erqerq","qdq","dwqer","qerqe","erqererq","e2342","ererq","qewrw","qrerqr","qreqw","qerqe","abc","def","ghh","hig","lmn","opk","cba","dfw","ewr","csad","wer","casd","were","csad","rt","hgf","qeq","hgf","qer","qer2","erqerq","qdq","dwqer","qerqe","erqererq","e2342","ererq","qewrw","qrerqr","qreqw","qerqe","abc","def","ghh","hig","lmn","opk","cba","dfw","ewr","csad","wer","casd","were","csad","rt","hgf","qeq","hgf","qer","qer2","erqerq","qdq","dwqer","qerqe","erqererq","e2342","ererq","qewrw","qrerqr","qreqw","qerqe","abc","def","ghh","hig","lmn","opk","cba","dfw","ewr","csad","wer","casd","were","csad","rt","hgf","qeq","hgf","qer","qer2","erqerq","qdq","dwqer","qerqe","erqererq","e2342","ererq","qewrw","qrerqr","qreqw","qerqe")
sum1<-c(43,90,135,125,87,4,23,120,4,127,70,68,129,63,131,90,67,110,90,119,81,68,15,29,49,11,76,82,65,83,25,43,90,135,125,87,4,23,120,4,127,70,68,129,63,131,90,67,110,90,119,81,68,15,29,49,11,76,82,65,83,25,43,90,135,125,87,4,23,120,4,127,70,68,129,63,131,90,67,110,90,119,81,68,15,29,49,11,76,82,65,83,25,43,90,135,125,87,4,23,120,4,127,70,68,129,63,131,90,67,110,90,119,81,68,15,29,49,11,76,82,65,83,25)
sum2<-c(14567,11111,3287,3563,9633,11162,3044,8437,4382,11250,3932,5587,4175,9708,4970,8388,10673,4301,12475,13494,12519,5632,3898,12472,4381,14085,10041,4276,12953,11143,12905,14567,11111,3287,3563,9633,11162,3044,8437,4382,11250,3932,5587,4175,9708,4970,8388,10673,4301,12475,13494,12519,5632,3898,12472,4381,14085,10041,4276,12953,11143,12905,14567,11111,3287,3563,9633,11162,3044,8437,4382,11250,3932,5587,4175,9708,4970,8388,10673,4301,12475,13494,12519,5632,3898,12472,4381,14085,10041,4276,12953,11143,12905,14567,11111,3287,3563,9633,11162,3044,8437,4382,11250,3932,5587,4175,9708,4970,8388,10673,4301,12475,13494,12519,5632,3898,12472,4381,14085,10041,4276,12953,11143,12905)
avg1<-c(48,132,115,83,84,77,111,102,113,96,136,97,89,97,66,18,123,29,37,118,66,87,52,11,97,25,144,21,40,6,36,48,132,115,83,84,77,111,102,113,96,136,97,89,97,66,18,123,29,37,118,66,87,52,11,97,25,144,21,40,6,36,48,132,115,83,84,77,111,102,113,96,136,97,89,97,66,18,123,29,37,118,66,87,52,11,97,25,144,21,40,6,36,48,132,115,83,84,77,111,102,113,96,136,97,89,97,66,18,123,29,37,118,66,87,52,11,97,25,144,21,40,6,36)
avg2<-c(6775,3142,3916,12828,9889,4025,11374,10594,4263,8871,11229,4787,7478,5316,5299,14068,3981,12993,12435,13845,4320,7472,14285,10221,11883,7783,13980,11426,13120,8632,14540,6775,3142,3916,12828,9889,4025,11374,10594,4263,8871,11229,4787,7478,5316,5299,14068,3981,12993,12435,13845,4320,7472,14285,10221,11883,7783,13980,11426,13120,8632,14540,6775,3142,3916,12828,9889,4025,11374,10594,4263,8871,11229,4787,7478,5316,5299,14068,3981,12993,12435,13845,4320,7472,14285,10221,11883,7783,13980,11426,13120,8632,14540,6775,3142,3916,12828,9889,4025,11374,10594,4263,8871,11229,4787,7478,5316,5299,14068,3981,12993,12435,13845,4320,7472,14285,10221,11883,7783,13980,11426,13120,8632,14540)

dat<-data.frame(cate,Sub_Product,Main_Product,Product,sum1,sum2,avg1,avg2, stringsAsFactors = FALSE)

ACClist<-c("sum1","sum2")
AVGlist<-c("avg1","avg2")

library (shinyjs)
library (tidyr)
library (data.table)
library (highcharter)
library (dplyr)
library (shinydashboard)
library (shiny)
library (shinyWidgets)

header <-dashboardHeader()
body <- dashboardBody(fluidRow(
  column(width = 12,
         radioGroupButtons(
           inputId = "l1PAD", label = NULL,size = "lg",
           choices = unique(dat$cate), justified = TRUE,
           individual = TRUE)
  )),
  fluidRow(
    box(
      title = "Summation of dataset", highchartOutput("accuPA",height = "300px")
    ),
    box(
      title = "Mean of dataset", highchartOutput("avgPA",height = "300px")
    )
  ))
sidebar <- dashboardSidebar(collapsed = T,
                            radioGroupButtons(
                              "accuselectPA","sum",choices=ACClist,
                              direction = "vertical",width = "100%",justified = TRUE
                            ),
                            br(),
                            radioGroupButtons(
                              "avgselectPA","Average ",choices=AVGlist,
                              direction = "vertical",width = "100%",justified = TRUE
                            ))
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output, session) {

    #data set
    dat_filtered <- reactive({

      dat[dat$cate == input$l1PAD,]

    })

    #Acc/sum graph
    output$accuPA<-renderHighchart({

      #LEVEL 1
      datSum <- dat_filtered() %>%
        group_by(Main_Product) %>%
        summarize(Quantity = mean(get(input$accuselectPA)))

      datSum <- arrange(datSum,desc(Quantity))
      Lvl1dfStatus <- tibble(name = datSum$Main_Product, y = datSum$Quantity, drilldown = tolower(name))

      #LEVEL 2
      Level_2_Drilldowns <- lapply(unique(dat_filtered()$Main_Product), function(x_level) {

        datSum2 <- dat_filtered()[dat_filtered()$Main_Product == x_level,]

        datSum2 <- datSum2 %>%
          group_by(Product) %>%
          summarize(Quantity = mean(get(input$accuselectPA)))
        datSum2 <- arrange(datSum2,desc(Quantity))

        Lvl2dfStatus <- tibble(name = datSum2$Product,y = datSum2$Quantity, drilldown = tolower(paste(x_level, name, sep = "_")))
        list(id = tolower(x_level), type = "column", data = list_parse(Lvl2dfStatus))
      })

      #LEVEL 3
      Level_3_Drilldowns <- lapply(unique(dat_filtered()$Main_Product), function(x_level) {

        datSum2 <- dat_filtered()[dat_filtered()$Main_Product == x_level,]

        lapply(unique(datSum2$Product), function(y_level) {

          datSum3 <- datSum2[datSum2$Product == y_level,]

          datSum3 <- datSum3 %>%
            group_by(Sub_Product) %>%
            summarize(Quantity = mean(get(input$accuselectPA)))
          datSum3 <- arrange(datSum3,desc(Quantity))

          Lvl3dfStatus <- tibble(name = datSum3$Sub_Product,y = datSum3$Quantity)
          list(id = tolower(paste(x_level, y_level, sep = "_")), type = "column", data = list_parse2(Lvl3dfStatus))
        })
      }) %>% unlist(recursive = FALSE)

      highchart() %>%
        hc_xAxis(type = "category") %>%
        hc_add_series(Lvl1dfStatus, "column", hcaes(x = name, y = y), color = "#E4551F") %>%
        hc_plotOptions(column = list(stacking = "normal")) %>%
        hc_drilldown(
          allowPointDrilldown = TRUE,
          series = c(Level_2_Drilldowns, Level_3_Drilldowns)
        )
    })

    #Avg/Avg graph
    output$avgPA<-renderHighchart({

      #LEVEL 1
      datSum <- dat_filtered() %>%
        group_by(Main_Product) %>%
        summarize(Quantity = mean(get(input$avgselectPA)))

      datSum <- arrange(datSum,desc(Quantity))
      Lvl1dfStatus <- tibble(name = datSum$Main_Product, y = datSum$Quantity, drilldown = tolower(name))

      #LEVEL 2
      Level_2_Drilldowns <- lapply(unique(dat_filtered()$Main_Product), function(x_level) {

        datSum2 <- dat_filtered()[dat_filtered()$Main_Product == x_level,]

        datSum2 <- datSum2 %>%
          group_by(Product) %>%
          summarize(Quantity = mean(get(input$avgselectPA)))
        datSum2 <- arrange(datSum2,desc(Quantity))

        Lvl2dfStatus <- tibble(name = datSum2$Product,y = datSum2$Quantity, drilldown = tolower(paste(x_level, name, sep = "_")))
        list(id = tolower(x_level), type = "column", data = list_parse(Lvl2dfStatus))
      })

      #LEVEL 3
      Level_3_Drilldowns <- lapply(unique(dat_filtered()$Main_Product), function(x_level) {

        datSum2 <- dat_filtered()[dat_filtered()$Main_Product == x_level,]

        lapply(unique(datSum2$Product), function(y_level) {

          datSum3 <- datSum2[datSum2$Product == y_level,]

          datSum3 <- datSum3 %>%
            group_by(Sub_Product) %>%
            summarize(Quantity = mean(get(input$avgselectPA)))
          datSum3 <- arrange(datSum3,desc(Quantity))

          Lvl3dfStatus <- tibble(name = datSum3$Sub_Product,y = datSum3$Quantity)
          list(id = tolower(paste(x_level, y_level, sep = "_")), type = "column", data = list_parse2(Lvl3dfStatus))
        })
      }) %>% unlist(recursive = FALSE)

      highchart() %>%
        hc_xAxis(type = "category") %>%
        hc_add_series(Lvl1dfStatus, "column", hcaes(x = name, y = y), color = "#E4551F") %>%
        hc_plotOptions(column = list(stacking = "normal")) %>%
        hc_drilldown(
          allowPointDrilldown = TRUE,
          series = c(Level_2_Drilldowns, Level_3_Drilldowns)
        )
    })

  }
shinyApp(ui, server)

Leave a Comment