highcharter-向下钻取图表的选择性文本注释

时间:2019-11-20 15:27:01

标签: r highcharts r-highcharter

我想在向下钻取图中添加注释,但似乎无法弄清楚如何将其与向下钻取功能合并。

我希望它做什么:

  • 进入“过期”列时,在所有列的第二级追溯上具有文本注释

数据是动态的,可能并不总是有一个“过期”列(或者它处于第4位),所以这就是为什么我的代码包含if语句的原因。

代码:

library (highcharter)
library (dplyr)

dat <- data.frame(FirstLvl = c("Duein7", "Duein2", "DueToday","Overdue", "Duein7", "Duein2", "DueToday","Overdue", "Duein7", "Duein2", "DueToday"),
                        SecondLvl = c("Site 1", "Site 1", "Site 1", "Site 1", "Site 2", "Site 2", "Site 2", "Site 2", "Site 3", "Site 3", "Site 3"),
                        CountLvl = c(6,5,3,8,2,2,6,3,5,9,2),
                        stringAsFactors = FALSE
)

#LEVEL 1
datSum <- dat %>%
  group_by(FirstLvl) %>%
  summarize(Quantity = sum(CountLvl)) %>%
  arrange(match(FirstLvl, c("Duein7", "Duein2", "DueToday", "Overdue")))

Lvl1dfStatus <- tibble(name = datSum$FirstLvl, y = datSum$Quantity, drilldown = tolower(name))

#LEVEL 2
Level_2_Drilldowns <- lapply(unique(dat$FirstLvl), function(L1_level) {

  datSum2 <- dat[dat$FirstLvl == L1_level,]
  datSum2 <- datSum2 %>%
    group_by(SecondLvl) %>%
    summarize(Quantity = sum(CountLvl))
  datSum2 <- arrange(datSum2,desc(Quantity))
  Lvl2dfStatus <- tibble(name = datSum2$SecondLvl, y = datSum2$Quantity, drilldown = tolower(paste(L1_level, name, sep = "_")))
  list(id = tolower(L1_level), type = "column", data = list_parse(Lvl2dfStatus), name = paste0(tolower(L1_level)))
})

ClickFunction <- JS("function(event) {Shiny.onInputChange('Clicked', event.point.name);}")
#GRAPH
hc <- highchart() %>%
  hc_xAxis(type = "category") %>%
  hc_legend(enabled = FALSE) %>%
  hc_add_series(Lvl1dfStatus, "column", hcaes(x = name, y = y)) %>%
  hc_plotOptions(column = list(events = list(click = ClickFunction))) %>%
  hc_drilldown(allowPointDrilldown = TRUE, series = c(Level_2_Drilldowns))

if('Overdue' %in% Lvl1dfStatus$name){

  x_position <- which(Lvl1dfStatus$name == 'Overdue') - 1

  hc <- hc %>% hc_add_annotation( 
            labels = list(
              list(
                point = list(
                  xAxis = 0,
                  yAxis = 0,
                  x = x_position,
                  y = Lvl1dfStatus$y[x_position]
                ),
                text = "Is it OK?"
              )
            )
          )

} else{}

hc

0 个答案:

没有答案