具有双轴和堆叠的高图 - R

Question

我正在尝试在R中获得带有双轴的高图堆叠条形图。到目前为止，我已经掌握了所有内容，除了堆叠。

数据：我有4周内4个城市的房源和联系人数据。

 Week <- c('22', '22', '22', '22', '23', '23', '23', '23', '24', '24', '24', '24', '25', '25', '25', '25', '26', '26', '26', '26')
City <- c("B", "C", "M", "P", "B", "C", "M", "P","B", "C", "M", "P","B", "C", "M", "P","B", "C", "M", "P")
Listings <- c (1213, 442, 400, 395, 1399, 720, 521, 516, 1483, 1062, 608, 582, 1365, 906, 540, 653, 318, 156, 117, 144)
Contacts <- c(12428, 2011, 12923, 4009, 14766, 2589, 12571, 4624, 14793, 3195, 13266, 5554, 14226, 3249, 13273, 6501, 1864, 461, 1773, 975)
lc <- data.frame(Week=Week, City=City, Listings=Listings, Contacts=Contacts)

我所拥有的代码产生了所需的输出（堆叠除外）如下：

h <- Highcharts$new()
h$xAxis(categories = lc$Week)
h$yAxis(list(list(title = list(text = 'Listings')),
             list(title = list(text = 'Contacts'), opposite = TRUE)))
h$series(name = 'Listings', type = 'column', group = 'City', color = '#4572A7',
        data = lc$Listings)
h$series(name = 'Contacts', type = 'column', group = 'City', color = '#89A54E',
        data = lc$Contacts, yAxis = 1)
h

此处的输出每周有4个列表栏（蓝色） - ＆gt;每个城市1个。我想把这4个堆叠起来。同样，我也希望堆叠4个触点条。

感谢您的帮助！

Answer 1

我认为您需要为每个城市和数据类型定义一个系列。您可以使用循环来执行此操作。在系列选项中，您可以将堆栈参数设置为Listings或Contact以堆叠它们。

以下是一个例子：

h <- Highcharts$new()
h$chart(type = "column")
h$plotOptions(column = list(stacking = "normal"),bar = list(colorByPoint = 'true'))
h$xAxis(categories = unique(lc$Week))

h$yAxis(list(list(title = list(text = 'Listings')),
             list(title = list(text = 'Contacts'), opposite = TRUE)))


#add colors manually to each series, so that the listings and contacts
#series have the same color for each city
colors <- list('#058DC7', '#50B432', '#ED561B', '#DDDF00')
names(colors) <- unique(lc$City)

#this loop adds the Listings bars for each city
sapply(unique(lc$City), function(city){
        h$series(id=paste0(city,"listings"),name = city, data = lc[lc$City==city,"Listings"],stack='listing',color=colors[[city]])
})

#this loop adds the Contact bars for each city, the linkedTo parameter is
#set to avoid having  two times the same legend
sapply(unique(lc$City), function(city){
        h$series(name = city,data = lc[lc$City==city,"Contacts"],stack='contacts',yAxis = 1,color=colors[[city]],linkedTo=paste0(city,"listings"))
})
h