代码之家 › 专栏 › 技术社区 › Kevin

R Highcharter:多系列多级钻取

r-highcharter highcharts r

Kevin · 技术社区 · 7 年前

Highcharter 在每个向下钻取中有多个序列(一列和一行标记)。我有一个系列的工作,但不确定如何添加另一个到它。我想要 goal 数据集是每个分类轴上的点标记(最好是一条线),当用户 drilldowns 这个 dat 数据集,它显示数据集也是。

一、第一个图表有3列(城市、农场和海洋),每列有一个标记,显示他们的目标。当点击“城市”时,它会转到2列(公共汽车和汽车)和每列显示目标的标记。等。

以下是目前为止的代码:

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)

举一个它应该是什么样子的例子。请看下面的图片。

第一: 第二个(单击农场之后):

关键是保持 二者都 数据 目标 数据 工作,但我不知道如何融入 目标 投入其中。我在想我必须以某种方式排列向下钻取的名称,但不确定第一步。

0 回复 | 直到 7 年前