我正在尝试使用Highcharter
创建一个多级细分,每个细分中都有多个系列(一个列和一个行标记)。我正在处理一个系列,但是不确定如何向其中添加另一个。我希望goal
数据集成为每个类别轴上的点标记(最好是一条线),并且当用户drilldowns
dat
数据集时,它会显示{{1 }}数据集。
即第一张图有3列(城市,农场和海洋),每列有一个标记,显示其目标。单击“城市”时,它会转到2列(公交车和汽车),并且每列都有一个标记,显示其目标。等等
下面是到目前为止的代码:
goal
EDIT
举例说明其外观。请参见下面的图片。
关键在于保持对 两者 library (tidyr)
library (data.table)
library (highcharter)
library (dplyr)
library (shinydashboard)
library (shiny)
rm(list=ls())
x <- c("Farm","Farm","Farm","Farm","City","City","City","Ocean","Ocean")
y <- c("Sheep","Sheep","Sheep","Cow","Car","Bus","Bus","Boat","Boat")
z <- c("Bill","Bill","Tracy","Sandy","Bob","Carl","Newt","Fig","Tony")
a <- c(20,20,30,10,20,10,50,40,20)
dat <- data.frame(x,y,z,a, stringsAsFactors = FALSE)
x <- c("Farm","Farm","Farm","City","City","City","Ocean","Ocean")
y <- c("Sheep","Sheep","Cow","Car","Bus","Bus","Boat","Boat")
z <- c("Bill","Tracy","Sandy","Bob","Carl","Newt","Fig","Tony")
a <- c(5,10,5,0,5,10,5,15)
goal <- data.frame(x,y,z,a, stringsAsFactors = FALSE)
header <- dashboardHeader()
body <- dashboardBody(
highchartOutput("Working")
)
sidebar <- dashboardSidebar()
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output, session) {
output$Working <- renderHighchart({
#First Tier Columns
datSum <- dat %>%
group_by(x) %>%
summarize(Quantity = sum(a)
)
datSum <- arrange(datSum,desc(Quantity))
Lvl1dfStatus <- tibble(name = datSum$x, y = datSum$Quantity, drilldown = tolower(name))
datGoal <- goal %>%
group_by(x) %>%
summarize(Quantity = sum(a)
)
datGoal <- arrange(datGoal,desc(Quantity))
Lvl1dfStatus2 <- tibble(name = datGoal$x, y = datGoal$Quantity, drilldown = tolower(datGoal$x))
#Second Tier Columns
Level_2_Drilldowns <- lapply(unique(dat$x), function(x_level) {
datSum2 <- dat[dat$x == x_level,]
datSum2 <- datSum2 %>%
group_by(y) %>%
summarize(Quantity = sum(a)
)
datSum2 <- arrange(datSum2,desc(Quantity)) ###CHECK
Lvl2dfStatus <- tibble(name = datSum2$y, y = datSum2$Quantity, drilldown = tolower(paste(x_level, name, sep = "_")))
list(id = tolower(x_level), type = "column", data = list_parse(Lvl2dfStatus))
})
Level_2_Drilldowns2 <- lapply(unique(goal$x), function(x_level) {
datGoal2 <- goal[goal$x == x_level,]
datGoal2 <- datGoal2 %>%
group_by(y) %>%
summarize(Quantity = sum(a)
)
datGoal2 <- arrange(datGoal2,desc(Quantity)) ###CHECK
Lvl2dfStatus2 <- tibble(name = datGoal2$y, y = datGoal2$Quantity, drilldown = tolower(paste(x_level, name, sep = "_")))
list(id = tolower(x_level), type = "scatter", data = list_parse(Lvl2dfStatus2))
})
#Third Tier Columns
Level_3_Drilldowns <- lapply(unique(dat$x), function(x_level) {
datSum2 <- dat[dat$x == x_level,]
lapply(unique(datSum2$y), function(y_level) {
datSum3 <- datSum2[datSum2$y == y_level,]
datSum3 <- datSum3 %>%
group_by(z) %>%
summarize(Quantity = sum(a)
)
datSum3 <- arrange(datSum3,desc(Quantity))
Lvl3dfStatus <- tibble(name = datSum3$z,y = datSum3$Quantity)
list(id = tolower(paste(x_level, y_level, sep = "_")), type = "column", data = list_parse2(Lvl3dfStatus))
})
}) %>% unlist(recursive = FALSE)
highchart() %>%
hc_xAxis(type = "category") %>%
hc_add_series(Lvl1dfStatus, "column", hcaes(x = name, y = y), color = "#E4551F") %>%
hc_add_series(Lvl1dfStatus2, "scatter", hcaes(x = name, y = y), color = "#00AB8E") %>%
hc_plotOptions(column = list(stacking = "normal")) %>%
hc_drilldown(
allowPointDrilldown = TRUE,
series = c(Level_2_Drilldowns2, Level_2_Drilldowns, Level_3_Drilldowns)
)
})
}
shinyApp(ui, server)
和dat
的深入研究。我可以进行goal
的多重深入研究,但是我不知道如何将dat
并入其中。我想我必须以某种方式对齐下钻名称,但不确定第一步。