如何在R highcharter（可能的其他包）中制作3级钻取图

问题描述 投票：0回答：2

今天我用highcharter包开始冒险。我对钻井图感兴趣。

（快速检查我想要创建的没有r）

http://jsfiddle.net/gh/get/jquery/1.7.2/highslide-software/highcharts.com/tree/master/samples/highcharts/drilldown/basic/

R代码与2个级别的钻取图的工作示例。

library("dplyr")
library("purrr")
library("highcharter")

df <- data_frame(
  name = c("Animals", "Fruits", "Cars"),
  y = c(5, 2, 4),
  drilldown = tolower(name)
)
df


ds <- list.parse3(df)
names(ds) <- NULL
str(ds)
hc <- highchart() %>%
  hc_chart(type = "column") %>%
  hc_title(text = "Basic drilldown") %>%
  hc_xAxis(type = "category") %>%
  hc_legend(enabled = FALSE) %>%
  hc_plotOptions(
    series = list(
      boderWidth = 0,
      dataLabels = list(enabled = TRUE)
    )
  ) %>%
  hc_add_series(
    name = "Things",
    colorByPoint = TRUE,
    data = ds
  )


dfan <- data_frame(
  name = c("Cats", "Dogs", "Cows", "Sheep", "Pigs"),
  value = c(4, 3, 1, 2, 1)
)
dffru <- data_frame(
  name = c("Apple", "Organes"),
  value = c(4, 2)
)
dfcar <- data_frame(
  name = c("Toyota", "Opel", "Volkswage"),
  value = c(4, 2, 2)
)
second_el_to_numeric <- function(ls){
  map(ls, function(x){
    x[[2]] <- as.numeric(x[[2]])
    x
  })
}
dsan <- second_el_to_numeric(list.parse2(dfan))
dsfru <- second_el_to_numeric(list.parse2(dffru))
dscar <- second_el_to_numeric(list.parse2(dfcar))
hc <- hc %>%
  hc_drilldown(
    allowPointDrilldown = TRUE,
    series = list(
      list(
        id = "animals",
        data = dsan
      ),
      list(
        id = "fruits",
        data = dsfru
      ),
      list(
        id = "cars",

        data = dscar
      )
    )
  )
hc

我的目标是创建超过2个级别的钻取图。我知道这是可能的（在javascrip Highchart页面上有3级示例但是用js编写）。

library("dplyr")
library("purrr")
library("highcharter")


df <- data_frame(
  name = c("Animals", "Fruits", "Cars"),
  y = c(5, 2, 4),
  drilldown = tolower(name)
)
df


ds <- list.parse3(df)
names(ds) <- NULL
str(ds)


hc <- highchart() %>%
  hc_chart(type = "column") %>%
  hc_title(text = "Basic drilldown") %>%
  hc_xAxis(type = "category") %>%
  hc_legend(enabled = FALSE) %>%
  hc_plotOptions(
    series = list(
      boderWidth = 0,
      dataLabels = list(enabled = TRUE)
      )
  ) %>%
  hc_add_series(
    name = "Things",
    colorByPoint = TRUE,
    data = ds
  )


dfan <- data_frame(
  name = c("Cats", "Dogs", "Cows", "Sheep", "Pigs"),
  value = c(4, 3, 1, 2, 1)

)
dffru <- data_frame(
  name = c("Apple", "Oranges"),
  value = c(4, 2)
)
dfcar <- data_frame(
  name = c("Toyota", "Opel", "Volkswage"),
  value = c(4, 2, 2),
  drilldown = tolower(name)
)


dfOpel <- data_frame(
  name = c("Insygnia", "Corsa"),
  value = c(1,2)
)


second_el_to_numeric <- function(ls){
  map(ls, function(x){
    x[[2]] <- as.numeric(x[[2]])
    x
  })
}
dsan <- second_el_to_numeric(list.parse2(dfan))
dsfru <- second_el_to_numeric(list.parse2(dffru))
dscar <- second_el_to_numeric(list.parse3(dfcar))
names(dscar) <- NULL

dsOpel <- second_el_to_numeric(list.parse3(dfOpel))
names(dsOpel)

hc <- hc %>%
  hc_drilldown(
    allowPointDrilldown = TRUE,
    series = list(
      list(
        id = "animals",
        data = dsan
      ),
      list(
        id = "fruits",
        data = dsfru
      ),
      list(
        id = "cars",
        data = dscar
      )
    ),
#My idea of change.
    series2 = list(
      list(id = "toyota", data = dsOpel),
      list(id = "opel", data = dsOpel),
      list(id = "volkswage", data = dsOpel)
    )
  )


hc

在高级参考手册中，只有2个级别的示例（https://cran.r-project.org/web/packages/highcharter/highcharter.pdf）

javascript r highcharts drilldown
2个回答
7
投票

如果您想要多级钻取，则必须将钻取的ID设置为数据点，就像在纯js highcharts中一样。

示例：http://jsfiddle.net/6LXVQ/2/和最重要的部分：

drilldown: {
        series: [{
            id: 'animals',
            name: 'Animals',
            data: [{
                name: 'Cats',
                y: 4,
                drilldown: 'cats'
            }, ['Dogs', 2],
                ['Cows', 1],
                ['Sheep', 2],
                ['Pigs', 1]
            ]
        }, {

            id: 'cats',
            data: [1, 2, 3]
        }]
    }

您可以在此处看到，您的数据点不仅仅是数字，还包含链接到下钻系列的对象。

使用Highcharter的一个例子 - 简化但你应该明白：

hc <- highchart() %>%
    hc_chart(type="column") %>%
    hc_xAxis(type="category") %>%
    hc_add_series(
        name = "Things",
        data = list(
            list(
                name = "Animals",
                y = 10,
                drilldown = "animals"
            )
        )
    ) %>%

    hc_drilldown(
        series = list(
            list(
                name = "Animals",
                id = "animals",
                data = list(
                    list(
                        name = "Cats",
                        y = 2,
                        drilldown = "cats"
                    )
                )
             ),
             list(
                 name = "Cats",
                 id = "cats",
                 data = list(list(name = "white cats", y = 2), list(name = "black cats", y = 3), list(name = "red cats",y = 4))
             )
         )
     )
hc
1
投票

这些下钻的重要方面是关键。深入分析的关键是[名称，价值，钻取]或[名称，y，钻取]（因为它们主要是列钻取。

df = data_frame(name = dataframe$NAMES,
               y = dataframe$VALUES,
               drilldown = tolower(name))

引用的所有数据应具有相同的布局（除非最后一个未打开到新的数据集中）。这个布局应该是键 - 名称，值和向下钻取ID的模式。向下钻取ID用作下一步钻取的参考键。

初始数据形成第一组列，并具有下一组的ID。下一组是第二层，并且在其数据中具有第三组的ID。第三组形成第三层。

示例：在宠物，鸟类和两栖动物的数据集中：下一层宠物是猫，狗，仓鼠，鱼。宠物的每个名字都附有一个ID。猫将通过该ID吸入虎斑猫，棕色，黑色，汤姆。狗将从其ID中拉入斗牛犬，哈巴狗，实验室柯基犬，并与仓鼠一样。

#LAYER ONE OF DRILLDOWN
animalsdf = data_frame(name = animals$NAMES,
               y = animals$VALUES,
               drilldown = tolower(paste(name,'id')))

#Example of drilldown ID's here: 'pets id', 'birds id', 'amphibians id'

animalsds = list_parse(animalsdf)

names(animalsds) = NULL

#LAYER TWO OF DRILLDOWN
petsdf = data_frame(name = typeofpets$NAMES,
               y = typeofpets$VALUES,
               drilldown = tolower(paste(name,'id')))

birdsdf = data_frame(name = typeofbirds$NAMES,
               y = typeofbirds$VALUES,
               drilldown = tolower(paste(name,'id')))

amphibiansdf = data_frame(name = typeofamphibians$NAMES,
               y = typeofamphibians$VALUES,
               drilldown = tolower(paste(name,'id')))

petsds <- second_el_to_numeric(list_parse2(petsdf))
birdsds <- second_el_to_numeric(list_parse2(birdsdf))
amphibiansds <- second_el_to_numeric(list_parse2(amphibiansdf))

#LAYER THREE OF DRILLDOWN

#FOR PETS

catsdf = data_frame(name = typeofcats$NAMES,
               y = typeofcats$VALUES,
               drilldown = tolower(paste(name,'id')))

dogsdf= data_frame(name = typeofdogs$NAMES,
               y = typeofdogs$VALUES,
               drilldown = tolower(paste(name,'id')))

hamstersdf = data_frame(name = typeofhamsters$NAMES,
               y = typeofhamsters$VALUES,
               drilldown = tolower(paste(name,'id')))


catsds <- second_el_to_numeric(list_parse2(catsdf))
dogsds <- second_el_to_numeric(list_parse2(dogsdf))
hamstersds <- second_el_to_numeric(list_parse2(hamstersdf))

#FOR BIRDS
flightlessbirdsdf = data_frame(name = flightlessbirds$NAMES,
               y = flightlessbirds$VALUES,
               drilldown = tolower(paste(name,'id')))

flyingbirdsdf = data_frame(name = flyingbirds$NAMES,
               y = flyingbirds$VALUES,
               drilldown = tolower(paste(name,'id')))

flightlessbirdsds <- second_el_to_numeric(list_parse2(flightlessbirdsdf))
flyingbirdsds <- second_el_to_numeric(list_parse2(flyingbirdsdf))

#FOR AMPHIBIANS

largeamphibiansdf = data_frame(name = largeamphibians$NAMES,
               y = flyingbirds$VALUES,
               drilldown = tolower(paste(name,'id')))

smallamphibiansdf = data_frame(name = smallamphibians$NAMES,
               y = smallamphibians$VALUES,
               drilldown = tolower(paste(name,'id')))

largeamphibiansds <- second_el_to_numeric(list_parse2(largeamphibiansdf))
smallamphibiansds <- second_el_to_numeric(list_parse2(smallamphibiansdf))

#HIGHCHART STARTS

hc <- highchart() %>%
hc_chart(type = "column") %>% 
hc_title(text = "Drilldown") %>%
hc_subtitle(text = "XYZ") %>%
hc_xAxis(type = "category") %>%
hc_legend(enabled = FALSE) %>%
hc_plotOptions(
  series = list(
    boderWidth = 0,
    dataLabels = list(enabled = TRUE)
  )
) %>%
hc_add_series(
  name = "Category",
  colorByPoint = TRUE,
  data = animalsds
)  %>%
hc_drilldown(
  allowPointDrilldown = TRUE,
  series = list(
    list(
      id = "pets id",
      data = petsds,
      keys = list('name','y','drilldown')
    ),
    list(
      id = "birds id",
      data = birdsds,
      keys = list('name','y','drilldown')
    ),
    list(
      id = "amphibians id",
      data = amphibiansds,
      keys = list('name','y','drilldown')
    ),
    list(
      id = "cats id",
      data = catsds,
    ),
    list(
      id = "dogs id",
      data = dogsds
    ),
    list(
      id = "hamsters id",
      data = hamstersds
    ),
    list(
      id = "flightless birds id",
      data = flightlessbirdsds
    ),
    list(
      id = "flying birds id",
      data = flyingbirdsid
    ),
    list(
      id = "large amphibians id",
      data = largeamphibiansds
    ),
    list(
      id = "small amphibians id",
      data = smallamphibiansds
    )
)) %>% hc_tooltip(valueDecimals = 2)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.