如何使用R中的higherchart包深入到第三层次？

问题描述

我想创建一个向下钻取图表。为此，我创建了一个层次结构。我可以深入到第二级，但不幸的是，我无法深入到第三级。以下是两级向下钻取的工作代码。

library(rio)
library(dplyr)
library(purrr)
library(highcharter)
library(scales)
library(stringr)

    #My Raw data
    Test <- data.frame(Group = c("A","A","B","B"),Group_Two = c("AA","AAA","AA","BB","BBB","BBB"),Group_Three = c("AJX","ABX","AJX","APX","ANX","BJX","BBX","BPX","BNX","BNX"),Group_Four = c("TH","TH","SW","GC","PB","JB","NX","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,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),list_parse)
  )

###################Chart##################
mygraph <- hchart(
  latest_First_Hierarchy,"column",hcaes(x = Group,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

上面的代码让我可以深入到第二级。不幸的是，使用以下代码，图表不会深入到第三层：

Test <- data.frame(Group = c("A","price")

latest_First_Hierarchy <- First_test_df %>%
      select(c(Group = Hierarchy_One,Value = price)) %>%
      arrange(desc(Value))

######################Second Hierarchy##########################
Second_Test <- Test[,"price")

latest_Second_Hierarchy <- Second_test_df %>%
      select(c(Group = Hierarchy_One,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[,"Group_Three","Value")]

Third_test_df <- aggregate(Third_Test$Value~ Third_Test$Group + Third_Test$Group_Two + Third_Test$Group_Three,FUN = sum)
colnames(Third_test_df) <- c("Hierarchy_One","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,list_parse)
  )

Test_drilldown_Two <-latest_Third_Hierarchy %>%
  group_nest(Group_Two)%>%
  mutate(
    id = Group_Two,name = Group_Three,drilldown = Group_Three),list_parse)
  )

mygraph <- hchart(
  latest_First_Hierarchy,colorByPoint = TRUE
)

mygraph <- mygraph %>% 
  hc_drilldown(
    allowPointDrilldown = TRUE,series = list(list_parse(Test_drilldown),list_parse(Test_drilldown_Two))
  )

mygraph

我发现之前有人问过类似的问题（链接：How to make 3 levels drilldown plot in R highcharter (possible other packages)），但我不想在 hc_drilldown 函数中输入很长的系列列表。

解决方法

在过去几天我的头撞墙之后，我能够调试并得到答案。请找到附加的代码。我要为此感谢凯文（来源：R Highcharter: Multi-level drilldown with multiple series）

Test <- data.frame(Group = c("A","A","B","B"),Group_Two = c("AA","AAA","AA","BB","BBB","BBB"),Group_Three = c("AJX","ABX","AJX","APX","ANX","BJX","BBX","BPX","BNX","BNX"),Group_Four = c("TH","TH","SW","GC","PB","JB","NX","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),]
  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,y_level,sep = "_")))
    list(id = tolower(paste(x_level,sep = "_")),data = list_parse(Lvl3dfStatus))
  })
})%>% unlist(recursive = FALSE)

Level_4_Drilldowns <- lapply(unique(Test$Group),]
    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,z_level,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)
  )