我想在向下钻取图中添加注释,但似乎无法弄清楚如何将其与向下钻取功能合并。
我希望它做什么:
数据是动态的,可能并不总是有一个“过期”列(或者它处于第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