假设我有以下用
library(plotly)
制作的条形图(右侧的空格是故意的):
library(dplyr)
library(plotly)
library(tidyr)
d <- tibble(cat = LETTERS[1:3],
val = c(25, 10, 30),
total = 40)
(bars <- d %>%
mutate(remaining = total - val) %>%
pivot_longer(cols = c(val, remaining)) %>%
plot_ly(x = ~ value, y = ~ cat,
type = "bar",
orientation = 'h', color = ~ name,
colors = c("#440154FF", "#FDE725FF")) %>%
layout(xaxis = list(title = NA, range= c(0, 60)),
yaxis = list(title = NA),
showlegend = FALSE,
barmode = "stack"))
我现在想在
x == 50
和相应的 y 位置插入以下饼图:
pies <- d %>%
rowwise() %>%
group_map(~ plot_ly(.x) %>%
add_pie(values = ~ c(val, total - val),
marker = list(colors = c("#440154FF", "#FDE725FF"))))
预期结果如下所示(通过手动将饼图粘贴到条形图中完成):
理想情况下,xa 轴的跨度会一直到 40,并且饼图下方没有可见的轴。
P.S:我发现在这个 reprex 中,颜色也很混乱,我该如何调整饼图中的颜色,使它们与条形图中的颜色相匹配?
如果您准备使用一点数学知识,则可以在 tidyverse 中执行此操作,无需任何额外的软件包:
make_pie <- function(x, y, size, groups, n, rownum, aspect = 1) {
angles <- c(0, 2*pi * cumsum(n)/sum(n))
do.call("rbind", Map(function(a1, a2, g) {
xvals <- c(0, sin(seq(a1, a2, len = 30)) * size, 0) * aspect + x
yvals <- c(0, cos(seq(a1, a2, len = 30)) * size, 0) + y
data.frame(x = xvals, y = yvals, group = g, rownum = rownum)
}, head(angles, -1), tail(angles, -1), groups))
}
pies <- d %>%
mutate(r = row_number(), y = as.numeric(factor(cat))) %>%
rowwise() %>%
group_map(~ with(.x, make_pie(50, y, 0.4, aspect = 15,
c("val", "neg"), c(val, total - val), r))) %>%
bind_rows()
d %>%
mutate(neg = total - val) %>%
select(-total) %>%
pivot_longer(-1) %>%
ggplot(aes(value, cat, fill = name)) +
geom_col() +
geom_polygon(aes(x = x, y = y, fill = group), data = pies) +
scale_fill_manual(values = c("#FDE725FF", "#440154FF"), guide = 'none') +
theme_minimal()
我纠正了。好吧,实际上不可能在 x 轴 50 处显示饼图,但如果我们可以接受将它们放在一边,那么我们可以使用
domain
并尝试不同的值以获得正确的大小和位置对于subplot
。
library(dplyr)
library(plotly)
library(tidyr)
d <- tibble(cat = LETTERS[1:3], val = c(25, 10, 30), total = 40)
ydomain = list(c(0.70, 1.00), c(0.35, 0.65), c(0.00, 0.30))
d %>%
mutate(remaining = total - val) %>%
pivot_longer(cols = c(val, remaining)) %>%
plot_ly(x = ~ value, y = ~ cat,
type = "bar", orientation = 'h', color = ~ name,
colors = c("#440154FF", "#FDE725FF")) %>%
layout(xaxis = list(title = NA),
yaxis = list(title = NA),
showlegend = FALSE, barmode = "stack") -> bars
pies <- lapply(seq_len(nrow(d)), function(i) {
plot_ly(data = d[i,],
marker = list(colors = c("#440154FF", "#FDE725FF")),
values = ~ c(val, total - val), type = 'pie',
domain = list(x = c(0.5, 1),
y = ydomain[[i]]),
showlegend = F, hoverinfo = "none") %>%
layout(xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))})
subplot(bars, pies[[1]], pies[[2]], pies[[3]],
widths = c(0.85, 0.05, 0.05, 0.05),
margin = 0.15) %>%
layout(showlegend = F)