I want to create a drill down chart. For that, I created a hierarchy. I can drill down to the second level but unfortunately, I cannot drill down to the third level. Following is the working code for the two level drill down.
library(rio)
library(dplyr)
library(purrr)
library(highcharter)
library(scales)
library(stringr)
#My Raw data
Test <- data.frame(Group = c("A", "A", "A", "A", "A", "A", "A", "A",
"B", "B", "B", "B", "B", "B", "B", "B"),
Group_Two = c("AA", "AAA", "AA", "AAA", "AAA", "AA",
"AA", "AAA", "BB", "BBB", "BB", "BBB",
"BB", "BBB", "BB", "BBB"),
Group_Three = c("AJX", "ABX", "AJX", "ABX", "APX", "ANX",
"ANX", "APX", "BJX", "BBX", "BJX", "BBX",
"BPX", "BNX", "BPX", "BNX"),
Group_Four = c("TH", "TH", "SW", "SW", "GC", "PB", "JB",
"NX", "TH", "TH", "SW", "SW", "GC", "PB",
"JB", "NX"),
Value = c(5293, 78225, 33235, 56022, 13056, 6160, 44067, 75529,
95679, 98172, 27159, 77475, 37838, 25897, 88400, 28484))
######################First Hierarchy##########################
First_test_df <- aggregate(Test$Value~Test$Group, Test, FUN = sum)
colnames(First_test_df) <- c("Hierarchy_One", "price")
latest_First_Hierarchy <- First_test_df %>%
select(c(Group = Hierarchy_One, Value = price)) %>%
arrange(desc(Value))
######################Second Hierarchy##########################
Second_Test <- Test[,c("Group", "Group_Two", "Value")]
Second_test_df <- aggregate(Second_Test$Value~ Second_Test$Group + Second_Test$Group_Two, Test, FUN = sum)
colnames(Second_test_df) <- c("Hierarchy_One", "Hierarchy_Two", "price")
latest_Second_Hierarchy <- Second_test_df %>%
select(c(Group = Hierarchy_One, Group_Two = Hierarchy_Two, Value = price)) %>%
filter(Group %in% latest_First_Hierarchy$Group) %>%
arrange(Group, desc(Value)) %>%
group_by(Group) %>%
ungroup() %>%
arrange(Group, desc(Value))
############Drill down to the second level#############
Test_drilldown <-latest_Second_Hierarchy %>%
group_nest(Group)%>%
mutate(
id = Group,
type = "column",
data = map(data, mutate, name = Group_Two, y = Value, drilldown = Group_Two),
data = map(data, list_parse)
)
###################Chart##################
mygraph <- hchart(
latest_First_Hierarchy,
"column",
hcaes(x = Group, y = Value, name = Group, drilldown = Group),
name = "Median Home Values",
colorByPoint = TRUE
)
###############Chart with the first drill down#############
mygraph <- mygraph %>%
hc_drilldown(
allowPointDrilldown = TRUE,
series = list_parse(Test_drilldown)
)
mygraph
The above code allows me to drill down to the second level. Unfortunately, with the following code the chart does not drill down to the third level:
Test <- data.frame(Group = c("A", "A", "A", "A", "A", "A", "A", "A",
"B", "B", "B", "B", "B", "B", "B", "B"),
Group_Two = c("AA", "AAA", "AA", "AAA", "AAA", "AA",
"AA", "AAA", "BB", "BBB", "BB", "BBB",
"BB", "BBB", "BB", "BBB"),
Group_Three = c("AJX", "ABX", "AJX", "ABX", "APX", "ANX",
"ANX", "APX", "BJX", "BBX", "BJX", "BBX",
"BPX", "BNX", "BPX", "BNX"),
Group_Four = c("TH", "TH", "SW", "SW", "GC", "PB", "JB",
"NX", "TH", "TH", "SW", "SW", "GC", "PB",
"JB", "NX"),
Value = c(5293, 78225, 33235, 56022, 13056, 6160, 44067, 75529,
95679, 98172, 27159, 77475, 37838, 25897, 88400, 28484))
######################First Hierarchy##########################
First_test_df <- aggregate(Test$Value~Test$Group, Test, FUN = sum)
colnames(First_test_df) <- c("Hierarchy_One", "price")
latest_First_Hierarchy <- First_test_df %>%
select(c(Group = Hierarchy_One, Value = price)) %>%
arrange(desc(Value))
######################Second Hierarchy##########################
Second_Test <- Test[,c("Group", "Group_Two", "Value")]
Second_test_df <- aggregate(Second_Test$Value~ Second_Test$Group + Second_Test$Group_Two, Test, FUN = sum)
colnames(Second_test_df) <- c("Hierarchy_One", "Hierarchy_Two", "price")
latest_Second_Hierarchy <- Second_test_df %>%
select(c(Group = Hierarchy_One, Group_Two = Hierarchy_Two, Value = price)) %>%
filter(Group %in% latest_First_Hierarchy$Group) %>%
arrange(Group, desc(Value)) %>%
group_by(Group) %>%
ungroup() %>%
arrange(Group, desc(Value))
####################Third Hierarchy###############################
Third_Test <- Test[,c("Group", "Group_Two", "Group_Three", "Value")]
Third_test_df <- aggregate(Third_Test$Value~ Third_Test$Group + Third_Test$Group_Two + Third_Test$Group_Three, Test, FUN = sum)
colnames(Third_test_df) <- c("Hierarchy_One", "Hierarchy_Two", "Hierarchy_Three", "price")
latest_Third_Hierarchy <- Third_test_df %>%
select(c(Group_Two = Hierarchy_Two, Group_Three = Hierarchy_Three, Value = price)) %>%
filter(Group_Two %in% latest_Second_Hierarchy$Group_Two) %>%
arrange(Group_Two, desc(Value)) %>%
group_by(Group_Two) %>%
ungroup() %>%
arrange(Group_Two, desc(Value))
Test_drilldown <-latest_Second_Hierarchy %>%
group_nest(Group)%>%
mutate(
id = Group,
type = "column",
data = map(data, mutate, name = Group_Two, y = Value, drilldown = Group_Two),
data = map(data, list_parse)
)
Test_drilldown_Two <-latest_Third_Hierarchy %>%
group_nest(Group_Two)%>%
mutate(
id = Group_Two,
type = "column",
data = map(data, mutate, name = Group_Three, y = Value, drilldown = Group_Three),
data = map(data, list_parse)
)
mygraph <- hchart(
latest_First_Hierarchy,
"column",
hcaes(x = Group, y = Value, name = Group, drilldown = Group),
name = "Median Home Values",
colorByPoint = TRUE
)
mygraph <- mygraph %>%
hc_drilldown(
allowPointDrilldown = TRUE,
series = list(list_parse(Test_drilldown), list_parse(Test_drilldown_Two))
)
mygraph
I found that the question similar to this has been asked before (link: How to make 3 levels drilldown plot in R highcharter (possible other packages)) but I do not want to type long list of series in hc_drilldown function.
After banging my head against the wall for last couple of days, I was able to debug and get the answer. Please find attached code. I would like to thank Kevin for this (source: R Highcharter: Multi-level drilldown with multiple series)
Test <- data.frame(Group = c("A", "A", "A", "A", "A", "A", "A", "A",
"B", "B", "B", "B", "B", "B", "B", "B"),
Group_Two = c("AA", "AAA", "AA", "AAA", "AAA", "AA",
"AA", "AAA", "BB", "BBB", "BB", "BBB",
"BB", "BBB", "BB", "BBB"),
Group_Three = c("AJX", "ABX", "AJX", "ABX", "APX", "ANX",
"ANX", "APX", "BJX", "BBX", "BJX", "BBX",
"BPX", "BNX", "BPX", "BNX"),
Group_Four = c("TH", "TH", "SW", "SW", "GC", "PB", "JB",
"NX", "TH", "TH", "SW", "SW", "GC", "PB",
"JB", "NX"),
Value = c(5293, 78225, 33235, 56022, 13056, 6160, 44067, 75529,
95679, 98172, 27159, 77475, 37838, 25897, 88400, 28484))
TestSum <- Test %>%
group_by(Group) %>%
summarize(Quantity = sum(Value)
)
TestSum <- arrange(TestSum,desc(Quantity))
Lvl1dfStatus <- tibble(name = TestSum$Group, y = TestSum$Quantity, drilldown = tolower(name))
Level_2_Drilldowns_Test <- lapply(unique(Test$Group), function(x_level) {
TestSum2 <- subset(Test, Test$Group %in% x_level)
#TestSum2 <- Test[Test$Group == x_level,]
TestSum2 <- TestSum2 %>%
group_by(Group_Two) %>%
summarize(Quantity = sum(Value)
)
TestSum2 <- arrange(TestSum2,desc(Quantity)) ###CHECK
Lvl2dfStatus <- tibble(name = TestSum2$Group_Two, y = TestSum2$Quantity, drilldown = tolower(paste(x_level, name, sep = "_")))
list(id = tolower(x_level), type = "column", data = list_parse(Lvl2dfStatus))
})
Level_3_Drilldowns_Test <- lapply(unique(Test$Group), function(x_level) {
TestSum2 <- subset(Test, Test$Group %in% x_level)
#TestSum2 <- Test[Test$Group == x_level,]
lapply(unique(TestSum2$Group_Two), function(y_level) {
TestSum3 <- subset(TestSum2, TestSum2$Group_Two %in% y_level)
#TestSum3 <- TestSum2[TestSum2$Group_Two == y_level,]
TestSum3 <- TestSum3 %>%
group_by(Group_Three) %>%
summarize(Quantity = sum(Value)
)
TestSum3 <- arrange(TestSum3,desc(Quantity))
Lvl3dfStatus <- tibble(name = TestSum3$Group_Three,y = TestSum3$Quantity, drilldown = tolower(paste(x_level, y_level, name, sep = "_")))
list(id = tolower(paste(x_level, y_level, sep = "_")), type = "column", data = list_parse(Lvl3dfStatus))
})
})%>% unlist(recursive = FALSE)
Level_4_Drilldowns <- lapply(unique(Test$Group), function(x_level) {
TestSum2 <- subset(Test, Test$Group %in% x_level)
#TestSum2 <- Test[Test$Group == x_level,]
lapply(unique(TestSum2$Group_Two), function(y_level) {
TestSum3 <- subset(TestSum2, TestSum2$Group_Two %in% y_level)
#TestSum3 <- TestSum2[TestSum2$Group_Two == y_level,]
lapply(unique(TestSum3$Group_Three), function(z_level) {
TestSum4 <- subset(TestSum3, TestSum3$Group_Three %in% z_level)
#TestSum4 <- TestSum3[TestSum3$Group_Three == z_level,]
TestSum4 <- TestSum4 %>%
group_by(Group_Four) %>%
summarize(Quantity = sum(Value)
)
TestSum4 <- arrange(TestSum4,desc(Quantity))
Lvl4dfStatus <- tibble(name = TestSum4$Group_Four,y = TestSum4$Quantity)
list(id = tolower(paste(x_level, y_level, z_level, sep = "_")), type = "column", data = list_parse2(Lvl4dfStatus))
})
})%>% unlist(recursive = FALSE)
}) %>% 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_Test, Level_3_Drilldowns_Test, Level_4_Drilldowns)
)