R Highcharter: многоуровневая развертка с несколькими сериями - PullRequest
Новая
       19

R Highcharter: многоуровневая развертка с несколькими сериями

0 голосов
/ 22 апреля 2019

Я пытаюсь создать многоуровневую развертку, используя Highcharter, которая имеет несколько рядов в каждой развертке (столбец и маркер строки).У меня работает одна серия, но я не знаю, как добавить к ней еще одну.Мне бы хотелось, чтобы набор данных goal был точечным маркером (предпочтительно линией) на каждой оси категорий, а когда пользователь drilldowns набор данных dat, он также отображает слои набора данных goal.

Т.е. первый график имеет 3 столбца (Город, Ферма и Океан) и маркер в каждом столбце, показывающий их цели.При нажатии на «Город», он переходит к 2 столбцам (Bus & Car) и маркеру в каждом столбце, показывающем их цели.И т.д.

Ниже приведен код: 

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)

РЕДАКТИРОВАТЬ

Чтобы привести пример того, что этодолжен выглядеть так.См. Рисунки ниже.

Первый: enter image description here Второй (после нажатия на ферму): enter image description here Третий (после нажатия на овцу): enter image description here

Ключ поддерживает развертку и dat и goal.У меня работает многоуровневая развертка dat, но я не знаю, как включить в нее goal.Я думаю, что мне нужно как-то выровнять имена детализации, но я не уверен в первых шагах.

...