如何为highchart添加数据标签?

问题描述

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

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

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[,"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[,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),]
  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[,2)
    TestSum3$Proportion<-paste(TestSum3$Proportion,"%")
    Lvl3dfStatus <- tibble(name = TestSum3$Group_Three,y = TestSum3$Quantity,z = TestSum3$Proportion,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))
      TestSum4[,"Proportion"] <- round(prop.table(TestSum4[,2)
      TestSum4$Proportion<-paste(TestSum4$Proportion,"%")
      Lvl4dfStatus <- tibble(name = TestSum4$Group_Four,y = TestSum4$Quantity,z = TestSum4$Proportion)
      list(id = tolower(paste(x_level,z_level,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),format='{point.z}')
  ) 

mygraph

对此的任何帮助将不胜感激。谢谢

解决方法

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

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

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[,"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[,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),]
  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[,2)
    TestSum3$Proportion<-paste(TestSum3$Proportion,"%")
    Lvl3dfStatus <- tibble(name = TestSum3$Group_Three,y = TestSum3$Quantity,z = TestSum3$Proportion,y_level,sep = "_")))
    list(id = tolower(paste(x_level,sep = "_")),data = list_parse(Lvl3dfStatus),format='{point.z}'))
  })
})%>% unlist(recursive = FALSE)

#Fourth level drill down
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))
      TestSum4[,"Proportion"] <- round(prop.table(TestSum4[,2)
      TestSum4$Proportion<-paste(TestSum4$Proportion,"%")
      Lvl4dfStatus <- tibble(name = TestSum4$Group_Four,y = TestSum4$Quantity,z = TestSum4$Proportion)
      list(id = tolower(paste(x_level,z_level,data = list_parse(Lvl4dfStatus),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,format='{point.z}')
)

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

mygraph