具有可变宽度元素的堆积条形图？
Stacked bar graph with variable width elements?
在 Tableau 中，我习惯制作如下图所示的图表。对于每一天（或其他一些离散变量），它都有一个不同颜色、高度和宽度的堆叠条。
你可以想象这些类别是我向人们展示的不同广告。高度对应于我向其展示广告的人数百分比，宽度对应于接受率。
它让我可以很容易地看到哪些广告我应该更频繁地展示（短而宽的条，比如 9 月 13 日和 14 日的 'C' 类别）以及我应该更少展示的广告（高，窄条，例如 9 月 16 日的 'H' 类别）。
关于如何在 R 或 Python 中创建这样的图表有什么想法吗？
不幸的是，用 ggplot2（我认为）实现这并不是那么简单，因为 geom_bar 并不真正支持改变相同 x 位置的宽度。但是稍加努力，我们可以得到相同的结果：
创建一些假数据
set.seed(1234)
d <- as.data.frame(expand.grid(adv = LETTERS[1:7], day = 1:5))
d$height <- runif(7*5, 1, 3)
d$width <- runif(7*5, 0.1, 0.3)
我的数据加起来不是100%，因为我很懒。
head(d, 10)
# adv day height width
# 1 A 1 1.227407 0.2519341
# 2 B 1 2.244599 0.1402496
# 3 C 1 2.218549 0.1517620
# 4 D 1 2.246759 0.2984301
# 5 E 1 2.721831 0.2614705
# 6 F 1 2.280621 0.2106667
# 7 G 1 1.018992 0.2292812
# 8 A 2 1.465101 0.1623649
# 9 B 2 2.332168 0.2243638
# 10 C 2 2.028502 0.1659540
为堆叠创建一个新变量
我认为我们不能轻易使用 position_stack，所以我们将自己完成那部分。基本上，我们需要计算每个柱的累积高度，按天分组。使用 dplyr 我们可以很容易地做到这一点。
library(dplyr)
d2 <- d %>% group_by(day) %>% mutate(cum_height = cumsum(height))
制作情节
最后，我们创建情节。请注意 x 和 y 指的是方块的 中间 。
library(ggplot2)
ggplot(d2, aes(x = day, y = cum_height - 0.5 * height, fill = adv)) +
geom_tile(aes(width = width, height = height), show.legend = FALSE) +
geom_text(aes(label = adv)) +
scale_fill_brewer(type = 'qual', palette = 2) +
labs(title = "Views and other stuff", y = "% of views")
如果您不想尝试正确缩放宽度（小于 1），您可以改用分面：
ggplot(d2, aes(x = 1, y = cum_height - 0.5 * height, fill = adv)) +
geom_tile(aes(width = width, height = height), show.legend = FALSE) +
geom_text(aes(label = adv)) +
facet_grid(~day) +
scale_fill_brewer(type = 'qual', palette = 2) +
labs(title = "Views and other stuff", y = "% of views", x = "")
结果
set.seed(1)
days <- 5
cats <- 8
dat <- prop.table(matrix(rpois(days * cats, days), cats), 2)
bp1 <- barplot(dat, col = seq(cats))
## some width for rect
rate <- matrix(runif(days * cats, .1, .5), cats)
## calculate xbottom, xtop, ybottom, ytop
bp <- rep(bp1, each = cats)
ybot <- apply(rbind(0, dat), 2, cumsum)[-(cats + 1), ]
ytop <- apply(dat, 2, cumsum)
plot(extendrange(bp1), c(0,1), type = 'n', axes = FALSE, ann = FALSE)
rect(bp - rate, ybot, bp + rate, ytop, col = seq(cats))
text(bp, (ytop + ybot) / 2, LETTERS[seq(cats)])
axis(1, bp1, labels = format(Sys.Date() + seq(days), '%d %b %Y'), lwd = 0)
axis(2)
可能不是很有用，但你可以反转你正在绘制的颜色，这样你就可以真正看到标签：
inv_col <- function(color) {
paste0('#', apply(apply(rbind(abs(255 - col2rgb(color))), 2, function(x)
format(as.hexmode(x), 2)), 2, paste, collapse = ''))
}
inv_col(palette())
# [1] "#ffffff" "#00ffff" "#ff32ff" "#ffff00" "#ff0000" "#00ff00" "#0000ff" "#414141"
plot(extendrange(bp1), c(0,1), type = 'n', axes = FALSE, ann = FALSE)
rect(bp - rate, ybot, bp + rate, ytop, col = seq(cats), xpd = NA, border = NA)
text(bp, (ytop + ybot) / 2, LETTERS[seq(cats)], col = inv_col(seq(cats)))
axis(1, bp1, labels = format(Sys.Date() + seq(days), '%d %B\n%Y'), lwd = 0)
axis(2)
在 Tableau 中，我习惯制作如下图所示的图表。对于每一天（或其他一些离散变量），它都有一个不同颜色、高度和宽度的堆叠条。
你可以想象这些类别是我向人们展示的不同广告。高度对应于我向其展示广告的人数百分比，宽度对应于接受率。
它让我可以很容易地看到哪些广告我应该更频繁地展示（短而宽的条，比如 9 月 13 日和 14 日的 'C' 类别）以及我应该更少展示的广告（高，窄条，例如 9 月 16 日的 'H' 类别）。
关于如何在 R 或 Python 中创建这样的图表有什么想法吗？
不幸的是，用 ggplot2（我认为）实现这并不是那么简单，因为 geom_bar 并不真正支持改变相同 x 位置的宽度。但是稍加努力，我们可以得到相同的结果：
创建一些假数据
set.seed(1234)
d <- as.data.frame(expand.grid(adv = LETTERS[1:7], day = 1:5))
d$height <- runif(7*5, 1, 3)
d$width <- runif(7*5, 0.1, 0.3)
我的数据加起来不是100%，因为我很懒。
head(d, 10)
# adv day height width
# 1 A 1 1.227407 0.2519341
# 2 B 1 2.244599 0.1402496
# 3 C 1 2.218549 0.1517620
# 4 D 1 2.246759 0.2984301
# 5 E 1 2.721831 0.2614705
# 6 F 1 2.280621 0.2106667
# 7 G 1 1.018992 0.2292812
# 8 A 2 1.465101 0.1623649
# 9 B 2 2.332168 0.2243638
# 10 C 2 2.028502 0.1659540
为堆叠创建一个新变量
我认为我们不能轻易使用 position_stack，所以我们将自己完成那部分。基本上，我们需要计算每个柱的累积高度，按天分组。使用 dplyr 我们可以很容易地做到这一点。
library(dplyr)
d2 <- d %>% group_by(day) %>% mutate(cum_height = cumsum(height))
制作情节
最后，我们创建情节。请注意 x 和 y 指的是方块的 中间 。
library(ggplot2)
ggplot(d2, aes(x = day, y = cum_height - 0.5 * height, fill = adv)) +
geom_tile(aes(width = width, height = height), show.legend = FALSE) +
geom_text(aes(label = adv)) +
scale_fill_brewer(type = 'qual', palette = 2) +
labs(title = "Views and other stuff", y = "% of views")
如果您不想尝试正确缩放宽度（小于 1），您可以改用分面：
ggplot(d2, aes(x = 1, y = cum_height - 0.5 * height, fill = adv)) +
geom_tile(aes(width = width, height = height), show.legend = FALSE) +
geom_text(aes(label = adv)) +
facet_grid(~day) +
scale_fill_brewer(type = 'qual', palette = 2) +
labs(title = "Views and other stuff", y = "% of views", x = "")
结果
set.seed(1)
days <- 5
cats <- 8
dat <- prop.table(matrix(rpois(days * cats, days), cats), 2)
bp1 <- barplot(dat, col = seq(cats))
## some width for rect
rate <- matrix(runif(days * cats, .1, .5), cats)
## calculate xbottom, xtop, ybottom, ytop
bp <- rep(bp1, each = cats)
ybot <- apply(rbind(0, dat), 2, cumsum)[-(cats + 1), ]
ytop <- apply(dat, 2, cumsum)
plot(extendrange(bp1), c(0,1), type = 'n', axes = FALSE, ann = FALSE)
rect(bp - rate, ybot, bp + rate, ytop, col = seq(cats))
text(bp, (ytop + ybot) / 2, LETTERS[seq(cats)])
axis(1, bp1, labels = format(Sys.Date() + seq(days), '%d %b %Y'), lwd = 0)
axis(2)
可能不是很有用，但你可以反转你正在绘制的颜色，这样你就可以真正看到标签：
inv_col <- function(color) {
paste0('#', apply(apply(rbind(abs(255 - col2rgb(color))), 2, function(x)
format(as.hexmode(x), 2)), 2, paste, collapse = ''))
}
inv_col(palette())
# [1] "#ffffff" "#00ffff" "#ff32ff" "#ffff00" "#ff0000" "#00ff00" "#0000ff" "#414141"
plot(extendrange(bp1), c(0,1), type = 'n', axes = FALSE, ann = FALSE)
rect(bp - rate, ybot, bp + rate, ytop, col = seq(cats), xpd = NA, border = NA)
text(bp, (ytop + ybot) / 2, LETTERS[seq(cats)], col = inv_col(seq(cats)))
axis(1, bp1, labels = format(Sys.Date() + seq(days), '%d %B\n%Y'), lwd = 0)
axis(2)