如何为highchart添加数据标签？

Question

使用 highcharter，我有一个 R 代码可以深入到图表中的四个级别。我想将数据标签添加到向下钻取级别中的每个栏。数据标签似乎只出现在第一层，而不会出现在其余层。请看下面的代码：

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

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[,"Proportion"] <- round(prop.table(TestSum[,"Quantity"])*100,2)
TestSum$Proportion<-paste(TestSum$Proportion, "%")
TestSum <- arrange(TestSum,desc(Quantity))

Lvl1dfStatus <- tibble(name = TestSum$Group, y = TestSum$Quantity, z = TestSum$Proportion, drilldown = tolower(name))
 

Level_2_Drilldowns <- 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))
  TestSum2[,"Proportion"] <- round(prop.table(TestSum2[,"Quantity"])*100,2)
  TestSum2$Proportion<-paste(TestSum2$Proportion, "%")
  Lvl2dfStatus <- tibble(name = TestSum2$Group_Two, y = TestSum2$Quantity, z= TestSum2$Proportion, drilldown = tolower(paste(x_level, name, sep = "_")))
  list(id = tolower(x_level), type = "column", data = list_parse(Lvl2dfStatus))
})

Level_3_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,]
    TestSum3 <- TestSum3 %>%
      group_by(Group_Three) %>%
      summarize(Quantity = sum(Value)
      )
    TestSum3 <- arrange(TestSum3,desc(Quantity))
    TestSum3[,"Proportion"] <- round(prop.table(TestSum3[,"Quantity"])*100,2)
    TestSum3$Proportion<-paste(TestSum3$Proportion, "%")
    Lvl3dfStatus <- tibble(name = TestSum3$Group_Three,y = TestSum3$Quantity, z = TestSum3$Proportion , 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))
      TestSum4[,"Proportion"] <- round(prop.table(TestSum4[,"Quantity"])*100,2)
      TestSum4$Proportion<-paste(TestSum4$Proportion, "%")
      Lvl4dfStatus <- tibble(name = TestSum4$Group_Four,y = TestSum4$Quantity, z = TestSum4$Proportion)
      list(id = tolower(paste(x_level, y_level, z_level, sep = "_")), type = "column", data = list_parse2(Lvl4dfStatus))
    })
  })%>% unlist(recursive = FALSE)
}) %>% unlist(recursive = FALSE)


mygraph <- hchart(
  Lvl1dfStatus,
  "column",
  hcaes(x = name, y = y, name = name, drilldown = drilldown),
  name = "Median Home Values",
  colorByPoint = TRUE,
  dataLabels = list(enabled = TRUE, format='{point.z}')
)

mygraph <- mygraph %>% 
  hc_drilldown(
    allowPointDrilldown = TRUE,
    series = c(Level_2_Drilldowns, Level_3_Drilldowns, Level_4_Drilldowns),
    dataLabels = list(enabled = TRUE, format='{point.z}')
  ) 

mygraph

如能提供任何帮助，我们将不胜感激。谢谢

Answer 1

经过一段时间的研究，我找到了答案。所以，请找到附件中的代码。

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

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[,"Proportion"] <- round(prop.table(TestSum[,"Quantity"])*100,2)
TestSum$Proportion<-paste(TestSum$Proportion, "%")
TestSum <- arrange(TestSum,desc(Quantity))

#First level drill down
Lvl1dfStatus <- tibble(name = TestSum$Group, y = TestSum$Quantity, z = TestSum$Proportion, drilldown = tolower(name))
 
#Second level drill down
Level_2_Drilldowns <- 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
  TestSum2[,"Proportion"] <- round(prop.table(TestSum2[,"Quantity"])*100,2)
  TestSum2$Proportion<-paste(TestSum2$Proportion, "%")
  Lvl2dfStatus <- tibble(name = TestSum2$Group_Two, y = TestSum2$Quantity, z= TestSum2$Proportion, drilldown = tolower(paste(x_level, name, sep = "_")))
  list(id = tolower(x_level), type = "column", data = list_parse(Lvl2dfStatus), dataLabels = list(enabled = TRUE, format='{point.z}'))
})

#Third level drill down
Level_3_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,]
    TestSum3 <- TestSum3 %>%
      group_by(Group_Three) %>%
      summarize(Quantity = sum(Value)
      )
    TestSum3 <- arrange(TestSum3,desc(Quantity))
    TestSum3[,"Proportion"] <- round(prop.table(TestSum3[,"Quantity"])*100,2)
    TestSum3$Proportion<-paste(TestSum3$Proportion, "%")
    Lvl3dfStatus <- tibble(name = TestSum3$Group_Three,y = TestSum3$Quantity, z = TestSum3$Proportion , drilldown = tolower(paste(x_level, y_level, name, sep = "_")))
    list(id = tolower(paste(x_level, y_level, sep = "_")), type = "column", data = list_parse(Lvl3dfStatus), dataLabels = list(enabled = TRUE, format='{point.z}'))
  })
})%>% unlist(recursive = FALSE)

#Fourth level drill down
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))
      TestSum4[,"Proportion"] <- round(prop.table(TestSum4[,"Quantity"])*100,2)
      TestSum4$Proportion<-paste(TestSum4$Proportion, "%")
      Lvl4dfStatus <- tibble(name = TestSum4$Group_Four,y = TestSum4$Quantity, z = TestSum4$Proportion)
      list(id = tolower(paste(x_level, y_level, z_level, sep = "_")), type = "column", data = list_parse(Lvl4dfStatus), dataLabels = list(enabled = TRUE, format='{point.z}'))
    })
  })%>% unlist(recursive = FALSE)
}) %>% unlist(recursive = FALSE)


mygraph <- hchart(
  Lvl1dfStatus,
  "column",
  hcaes(x = name, y = y, name = name, drilldown = drilldown),
  name = "Median Home Values",
  colorByPoint = TRUE,
  dataLabels = list(enabled = TRUE, format='{point.z}')
)

mygraph <- mygraph %>% 
  hc_drilldown(
    allowPointDrilldown = TRUE,
    series = c(Level_2_Drilldowns, Level_3_Drilldowns, Level_4_Drilldowns)
  ) 

mygraph

如何为highchart添加数据标签？

How to add data labels for highchart?

charts

plot

bar-chart

highcharts

r-highcharter