饼图和条形图在同一图上对齐

Pie chart and Bar chart aligned on same plot

在 ggplot2 中看到经济学家的 this question on how to recreate this graph 后,我决定自己从头开始尝试(因为没有提供代码或数据),因为我觉得这很有趣。

这是我到目前为止所做的:

我能够相对轻松地做到这一点。但是,我正在努力放置饼图。因为 ggplot 使用笛卡尔坐标来制作饼图,所以我不能在同一张图上有条形图和饼图。所以我从 ggforce 中发现了 geom_arc_bar(),它确实允许笛卡尔坐标系上的馅饼。但是,问题出在 coord_fixed()。我可以让馅饼对齐,但如果没有 coord_fixed(),我就无法得到圆形。但是,对于 coord_fixed(),我无法让图表与经济学人图表的高度相匹配。没有 coord_fixed() 我可以,但馅饼是椭圆形而不是圆形。见下文:

coord_fixed():

没有coord_fixed():

我尝试过的另一个选择是分别制作一系列饼图,然后将这些图组合在一起。然而,我努力让情节与 gridExtra 和其他替代方案保持一致。我确实结合了油漆。显然这可行,但不是程序化的。我需要一个 100% 基于 R 的解决方案。

我在 Paint 中粘贴来自 R 的单独图像的解决方案:

有人能解决这个问题吗?我认为这是一个有趣的问题,我已经提供了一个起点。我愿意接受任何建议,也可以随意提出一种完全不同的方法,因为我承认我的方法不是最好的。谢谢!

代码:

# packages
library(data.table)
library(dplyr)
library(forcats)
library(ggplot2)
library(ggforce)
library(ggnewscale)
library(ggtext)
library(showtext)
library(stringr)


# data

global <- fread("Sector,ROE,Share,Status
                 Technology,14.2,10,Local
                 Technology,19,90,Multinational
                 Other consumer,16.5,77,Multinational
                 Other consumer,20.5,23,Local
                 Industrial,13,70,Multinational
                 Industrial,18,30,Local
                 Cyclical consumer,12,77,Multinational
                 Cyclical consumer,21,23,Local
                 Utilities,6,88,Local
                 Utilities,11,12,Multinational
                 All sectors,10,50,Local
                 All sectors,10.2,50,Multinational
                 Financial,6,27,Multinational
                 Financial,10.5,73,Local
                 Diversified,4.9,21,Local
                 Diversified,5,79,Multinational
                 Basic materials,4,82,Multinational
                 Basic materials,9,18,Local
                 Media & communications,3,76,Multinational
                 Media & communications,14,24,Local
                 Energy,-1,40,Local
                 Energy,1,60,Multinational
                ")


equity <- global %>%
  group_by(Sector) %>% 
  mutate(xend = ifelse(min(ROE) > 0, 0, min(ROE)))



equity$Sector <- factor(equity$Sector, levels= rev(c("Technology", "Other consumer", 
                                                     "Industrial", "Cyclical consumer",
                                                     "Utilities", "All sectors", "Financial",
                                                     "Diversified", "Basic materials",
                                                     "Media & communications", "Energy")))

equity$Status <- factor(equity$Status, levels = c("Multinational", "Local"))

# fonts 

font_add_google("Montserrat", "Montserrat")
font_add_google("Roboto", "Roboto")

# scaling text for high res image

img_scale <- 5.5

# graph

showtext_auto() # for montserrat font to show

economist <- ggplot(equity)+
  geom_vline(aes(xintercept = -2.5, color = "+-"), show.legend = FALSE)+
  geom_vline(aes(xintercept = 2.5, color = "+-"), show.legend = FALSE)+
  geom_segment(aes(x = ROE, xend = xend, y = Sector, yend = Sector, color = "line"),
               show.legend = FALSE, size = 2)+
  geom_tile(aes(x = ROE, y = Sector, width = 1, height = 0.5, fill = Status), 
            size = 0.5)+
  geom_vline(aes(xintercept = 0, color = "x-axis"), show.legend = FALSE)+
  scale_fill_manual("", values = c("Local" = "#ea5f47", "Multinational" = "#0a5268"))+
  scale_color_manual(values = c("x-axis" = "red", "+-" = "#cddee6", "line" = "#a8adb3"))+
  scale_x_continuous(position = "top", limits = c(-5, 25), 
                     breaks = c(-5, -2.5, 0, 2.5, 5,10,15,20,25), 
                     labels = c(5, "-", 0, "+", 5,10,15,20,25),
                     minor_breaks = c(-2.5, 2.5)
  )+
  scale_y_discrete(labels = function(x) str_replace_all(x, "& c" , "&\nc"))+
  #width = 40))+
  labs(x = "", y = "", caption = c("Sources: Bloomberg;",
                                   "The Economist",   
                                   "<span style='font-size:80px;
                                   color:#292929;'><sup>*</sup></span>Top 500 global companies"))+
  ggtitle("The price of being global", 
          subtitle = "Return on equity<span style='font-size:80px;color:#292929;'>*</span>, latest 12 months, %")+
  theme(legend.position = "top",
        legend.direction = "vertical",
        legend.justification = -1.25,
        legend.key.size = unit(0.18, "cm"),
        legend.key.height = unit(0.1, "cm"),
        legend.background = element_rect("#cddee6"),
        legend.text = element_text("Montserrat", size = 9 * img_scale),
        plot.background = element_rect("#cddee6"),
        plot.margin = margin(t = 10, r = 10,  b = 20, l = 10),
        panel.background = element_rect("#cddee6"),
        panel.grid.major.y = element_blank(),
        panel.grid.minor.y = element_blank(),
        panel.grid.minor.x = element_blank(),
        axis.ticks = element_blank(),
        axis.text = element_text(family = "Montserrat", size = 9 * img_scale, 
                                 colour = "black"),
        axis.text.y = element_text(hjust = 0, lineheight = 0.15,
                                   face = c(rep("plain",5), "bold.italic", rep("plain",5))
                                   ),
        #axis.text.x = element_text(family = "Montserrat", size = 9*img_scale,)
        plot.title = element_text(family = "Montserrat", size = 12 * img_scale,
                                  face = "bold",
                                  hjust = -34.12),
        text = element_text(family = "Montserrat"),
        plot.subtitle = element_markdown(family = "Montserrat", size = 9 * img_scale,
                                         hjust = 7.5),
        plot.caption = element_markdown(size = 9*img_scale,
                                        face = c("plain", "italic", "plain"),
                                        hjust = c(-1.35, -1.85, -2.05), 
                                        vjust = c(0,0.75,0)))

# only way to get google fonts on plot (R device does not show them)

png("bar.png", height = 480*8, width = 250*8, res = 72*8) # increased resolution (dpi)
economist
dev.off()

# piechart



pies <- equity %>% 
  mutate(Sector = fct_rev(Sector)) %>%  
  ggplot(aes(x = "", y = Share, fill = Status, width = 0.15)) + 
  geom_bar(stat = "identity", position = position_fill(), show.legend = FALSE, size = 0.1) +
  #  geom_text(aes(label = Cnt), position = position_fill(vjust = 0.5)) +
  coord_polar(theta = "y", direction = -1) +
  facet_wrap(~ Sector, dir = "v", ncol = 1)  +
  scale_fill_manual("", values = c("Local" = "#93b7c7", "Multinational" = "#08526b"))+
  #theme_void()+
  theme(panel.spacing = unit(-0.35, "lines"),
        plot.background = element_rect("#cddee6"),
        panel.background = element_rect("transparent"),
        strip.text = element_blank(),
        axis.title.x = element_blank(),
        axis.title.y = element_blank(),
        legend.position='none', 
        axis.ticks = element_blank(),
        axis.text = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank())
#  guides(fill=guide_legend(nrow=2, byrow=TRUE))

png("pie_chart.png", height = 350*8, width = 51*8, res = 72*8)
pies
dev.off()

# geom_bar_arc (ggforce) with coord_fixed - cannot match height but pies are circular

eco_circle_pies <- ggplot(equity)+
  geom_vline(aes(xintercept = -2.5, color = "+-"), show.legend = FALSE)+
  geom_vline(aes(xintercept = 2.5, color = "+-"), show.legend = FALSE)+
  geom_segment(aes(x = ROE, xend = xend, y = Sector, yend = Sector, color = "line"),
               show.legend = FALSE, size = 1)+
  scale_fill_manual("", values = c("Local" = "#ea5f47", "Multinational" = "#0a5268"))+
  geom_tile(aes(x = ROE, y = Sector, width = 1, height = 0.5, fill = Status),
            size = 0.5, show.legend = TRUE)+
  geom_vline(aes(xintercept = 0, color = "x-axis"), show.legend = FALSE)+
  new_scale_fill()+
  geom_arc_bar(aes(x0 = 27, y0 = as.numeric(equity$Sector), r0 = 0, r = 0.45,
                   amount = Share,
                   fill = Status),
               stat = 'pie',
               color = "transparent",
               show.legend = FALSE)+
  coord_fixed()+
  scale_fill_manual("", values = c("Local" = "#93b7c7", "Multinational" = "#08526b"))+
  scale_color_manual(values = c("x-axis" = "red", "+-" = "#cddee6", "line" = "#a8adb3"))+
  scale_x_continuous(position = "top", limits = c(-5, 30), 
                     breaks = c(-5, -2.5, 0, 2.5, 5,10,15,20,25), 
                     labels = c(5, "-", 0, "+", 5,10,15,20,25),
                     minor_breaks = c(-2.5, 2.5)
  )+
  scale_y_discrete(labels = function(x) str_replace_all(x, "& c" , "&\nc"))+
  # below is to get * superscript
  labs(x = "", y = "", caption = c("Sources: Bloomberg;",
                                   "<span style='font-style:italic;font-color:#292929'>The Economist</span>",   
                                   "<span style='font-size:80px;
                                   color:#292929;'><sup>*</sup></span>Top 500 global companies"))+ # this is to get 
  ggtitle("The price of being global", 
          subtitle = "Return on equity<span style='font-size:80px;color:#292929;'>*</span>, latest 12 months, %")+
  guides(color = FALSE)+
  theme(legend.position = "top",
        legend.direction = "vertical",
        #       legend.justification = -0.9,
        legend.key.size = unit(0.18, "cm"),
        legend.key.height = unit(0.1, "cm"),
        legend.background = element_rect("#cddee6"),
        legend.text = element_text("Montserrat", size = 9 * img_scale),
        plot.background = element_rect("#cddee6"),
        #        plot.margin = margin(t = -80, r = 10,  b = -20, l = 10),
        panel.background = element_rect("#cddee6"),
        panel.grid.major.y = element_blank(),
        panel.grid.minor.y = element_blank(),
        panel.grid.minor.x = element_blank(),
        axis.ticks = element_blank(),
        axis.text = element_text(family = "Montserrat", size = 9 * img_scale, 
                                 colour = "black"),
        axis.text.y = element_text(hjust = 0, lineheight = 0.15),
        #axis.text.x = element_text(family = "Montserrat", size = 9*img_scale,)
        plot.title = element_text(family = "Montserrat", size = 12 * img_scale,
                                  hjust = -2.12),
        plot.subtitle = element_markdown(family = "Montserrat", size = 9 * img_scale,
                                         hjust = -5.75),
        plot.caption = element_markdown(size = 9*img_scale,
                                        face = c("plain", "italic", "plain"),
                                        #hjust = c(-.9, -1.22, -1.95), 
                                        #vjust = c(0,0.75,0)))
))

png("eco_circle_pies.png", height = 220*8, width = 420*8, res = 72*8)
eco_circle_pies
dev.off()


# geom_bar_arc (ggforce) without coord_fixed - matches height, but pies are oval

eco_oval_pie <- ggplot(equity)+
  geom_vline(aes(xintercept = -2.5, color = "+-"), show.legend = FALSE)+
  geom_vline(aes(xintercept = 2.5, color = "+-"), show.legend = FALSE)+
  geom_segment(aes(x = ROE, xend = xend, y = Sector, yend = Sector, color = "line"),
               show.legend = FALSE, size = 1)+
  scale_fill_manual("", values = c("Local" = "#ea5f47", "Multinational" = "#0a5268"))+
  geom_tile(aes(x = ROE, y = Sector, width = 1, height = 0.5, fill = Status),
            size = 0.5, show.legend = TRUE)+
  geom_vline(aes(xintercept = 0, color = "x-axis"), show.legend = FALSE)+
  new_scale_fill()+
  geom_arc_bar(aes(x0 = 27, y0 = as.numeric(equity$Sector), r0 = 0, r = 0.45,
                   amount = Share,
                   fill = Status),
               stat = 'pie',
               color = "transparent",
               show.legend = FALSE)+
#  coord_fixed()+
  scale_fill_manual("", values = c("Local" = "#93b7c7", "Multinational" = "#08526b"))+
  scale_color_manual(values = c("x-axis" = "red", "+-" = "#cddee6", "line" = "#a8adb3"))+
  scale_x_continuous(position = "top", limits = c(-5, 30), 
                     breaks = c(-5, -2.5, 0, 2.5, 5,10,15,20,25), 
                     labels = c(5, "-", 0, "+", 5,10,15,20,25),
                     minor_breaks = c(-2.5, 2.5)
  )+
  scale_y_discrete(labels = function(x) str_replace_all(x, "& c" , "&\nc"))+
  #width = 40))+
  labs(x = "", y = "", caption = c("Sources: Bloomberg;",
                                   "<span style='font-style:italic;font-color:#292929'>The Economist</span>",   
                                   "<span style='font-size:80px;
                                   color:#292929;'><sup>*</sup></span>Top 500 global companies"))+
  ggtitle("The price of being global", 
          subtitle = "Return on equity<span style='font-size:80px;color:#292929;'>*</span>, latest 12 months, %")+
  guides(color = FALSE)+
  theme(legend.position = "top",
        legend.direction = "vertical",
        legend.justification = -1.1,
        legend.key.size = unit(0.18, "cm"),
        legend.key.height = unit(0.1, "cm"),
        legend.background = element_rect("#cddee6"),
        legend.text = element_text("Montserrat", size = 9 * img_scale),
        plot.background = element_rect("#cddee6"),
        #        plot.margin = margin(t = -80, r = 10,  b = -20, l = 10),
        panel.background = element_rect("#cddee6"),
        panel.grid.major.y = element_blank(),
        panel.grid.minor.y = element_blank(),
        panel.grid.minor.x = element_blank(),
        axis.ticks = element_blank(),
        axis.text = element_text(family = "Montserrat", size = 9 * img_scale, 
                                 colour = "black"),
        axis.text.y = element_text(hjust = 0, lineheight = 0.15),
        text = element_text(family = "Montserrat"),
        plot.title = element_text(family = "Montserrat", size = 12 * img_scale,
                                  face = "bold",
                                  hjust = -7.05),
        plot.subtitle = element_markdown(family = "Montserrat", size = 9 * img_scale,
                                         hjust = 53.75),
        plot.caption = element_markdown(size = 9*img_scale,
                                        face = c("plain", "italic", "plain"),
                                        hjust = c(-1.15, -1.58, -1.95), 
                                        vjust = c(0.5,1.15,0.5)))

png("eco_oval_pies.png", height = 480*8, width = 250*8, res = 72*8)
eco_oval_pie
dev.off()

确实是个有趣的问题。在我看来,获得所需结果的最简单方法是创建两个单独的图并使用精彩的 patchwork 包将它们粘合在一起:

注意:为了专注于主要问题并使代码更精简,我放弃了所有或大部分主题调整、ggtext 样式、自定义字体等。相反,我依靠 ggthemes::theme_economist 来接近经济学家的样子。

# packages
library(data.table)
library(dplyr)
library(stringr)
library(forcats)
library(ggplot2)
library(patchwork)
library(ggthemes)


bars <-ggplot(equity)+
  geom_vline(aes(xintercept = -2.5, color = "+-"), show.legend = FALSE)+
  geom_vline(aes(xintercept = 2.5, color = "+-"), show.legend = FALSE)+
  geom_segment(aes(x = ROE, xend = xend, y = Sector, yend = Sector, color = "line"),
               show.legend = FALSE, size = 2)+
  geom_tile(aes(x = ROE, y = Sector, width = 1, height = 0.5, fill = Status), 
            size = 0.5)+
  geom_vline(aes(xintercept = 0, color = "x-axis"), show.legend = FALSE)+
  scale_fill_manual("", values = c("Local" = "#ea5f47", "Multinational" = "#0a5268"))+
  scale_color_manual(values = c("x-axis" = "red", "+-" = "#cddee6", "line" = "#a8adb3"))+
  scale_x_continuous(position = "top", limits = c(-5, 25), 
                     breaks = c(-5, -2.5, 0, 2.5, 5,10,15,20,25), 
                     labels = c(5, "-", 0, "+", 5,10,15,20,25),
                     minor_breaks = c(-2.5, 2.5)
  )+
  scale_y_discrete(labels = function(x) str_replace_all(x, "& c" , "&\nc"))+
  labs(x = "", y = "") +
  ggthemes::theme_economist() + 
  theme(legend.position = "top", legend.justification = "left")

pies <- equity %>% 
  mutate(Sector = fct_rev(Sector)) %>%  
  ggplot(aes(x = "", y = Share, fill = Status, width = 0.15)) + 
  geom_bar(stat = "identity", position = position_fill(), show.legend = FALSE, size = 0.1) +
  coord_polar(theta = "y", direction = -1) +
  facet_wrap(~ Sector, dir = "v", ncol = 1)  +
  scale_fill_manual("", values = c("Local" = "#93b7c7", "Multinational" = "#08526b")) +
  labs(x = NULL, y = NULL) +
  ggthemes::theme_economist() +
  theme(strip.text = element_blank(), panel.spacing.y = unit(0, "pt"),
        axis.text = element_blank(), , axis.ticks = element_blank(), axis.line = element_blank(),
        panel.grid.major = element_blank()) 

bars + pies +
  plot_layout(widths= c(5, 1)) +
  plot_annotation(caption = c("Sources: Bloomberg;",
                              "The Economist", "Top 500 global companies"),
                  title = "The price of being global",
                  subtitle = "Return on equity, latest 12 months, %",
                  theme = theme_economist())

这是一个基数

global <- read.csv(strip.white = TRUE, text = "Sector,ROE,Share,Status
                 Technology,14.2,10,Local
                 Technology,19,90,Multinational
                 Other consumer,16.5,77,Multinational
                 Other consumer,20.5,23,Local
                 Industrial,13,70,Multinational
                 Industrial,18,30,Local
                 Cyclical consumer,12,77,Multinational
                 Cyclical consumer,21,23,Local
                 Utilities,6,88,Local
                 Utilities,11,12,Multinational
                 All sectors,10,50,Local
                 All sectors,10.2,50,Multinational
                 Financial,6,27,Multinational
                 Financial,10.5,73,Local
                 Diversified,4.9,21,Local
                 Diversified,5,79,Multinational
                 Basic materials,4,82,Multinational
                 Basic materials,9,18,Local
                 Media & communications,3,76,Multinational
                 Media & communications,14,24,Local
                 Energy,-1,40,Local
                 Energy,1,60,Multinational")
global <- within(global, {
  Sector <- factor(Sector, unique(Sector))
  Status <- factor(Status, unique(Status))
})
global <- global[order(global$Sector, global$Status), ]

f <- function(x, y, z, col, lbl, xat) {
  all <- grepl('All', lbl)
  par(mar = c(0, 0, 0, 0))
  pie(rev(z), labels = '', clockwise = TRUE, border = NA, col = rev(col))
  par(mar = c(0, 10, 0, 0))
  plot.new()
  plot.window(range(xat), c(-1, 1))
  abline(v = xat, col = 'white', lwd = 3)
  abline(v = 0, col = 'tomato3', lwd = 3)
  segments(min(c(x, 0)), 0, max(x), 0, ifelse(all, 'grey50', 'grey75'), lwd = 7, lend = 1)
  text(grconvertX(0.05, 'ndc'), 0, paste(strwrap(lbl, 15), collapse = '\n'),
       xpd = NA, adj = 0, cex = 2, font = 1 + all * 3)
  for (ii in 1:2)
    segments(x[ii], -y / 2, x[ii], y / 2, col = col[ii], lwd = 7, lend = 1)
}

pdf('~/desktop/fig.pdf', height = 10, width = 7)
layout(
  matrix(rev(sequence(nlevels(global$Sector) * 2)), ncol = 2, byrow = TRUE),
  widths = c(5, 1)
)
cols <- c(Local = '#ea5f47', Multinational = '#08526b')
op <- par(bg = '#cddee6', oma = c(5, 6, 15, 0))
sp <- rev(split(global, global$Sector))
for (x in sp)
  f(x$ROE, 1, x$Share, cols, x$Sector[1], -1:5 * 5)
axis(3, lwd = 0, cex.axis = 2)
cols <- rev(cols)
legend(
  grconvertX(0.05, 'ndc'), grconvertY(0.91, 'ndc'), paste(names(cols), 'firms'),
  border = NA, fill = cols, bty = 'n', xpd = NA, cex = 2
)
text(
  grconvertX(0.05, 'ndc'), grconvertY(c(0.96, 0.925), 'ndc'),
  c('The price of being global', 'Return on equity*, latest 12 months, %'),
  font = c(2, 1), adj = 0, cex = c(3, 2), xpd = NA
)
text(
  grconvertX(0.05, 'ndc'), grconvertY(0.03, 'ndc'),
  'Sources: Bloomberg;\nThe Economist', xpd = NA, adj = 0, cex = 1.5
)
text(
  grconvertX(0.95, 'ndc'), grconvertY(0.03, 'ndc'),
  '*Top 500 global companies', xpd = NA, adj = 1, cex = 1.5
)
box('outer')
par(op)
dev.off()