如何在R (ggplot2)中重新创建此excel条形图+数据表？

Question

我有一个使用mtcar数据集在excel中创建的条形图，但是我需要在R中创建它，我知道如何制作一个堆叠的图表，但是可以添加像下面这样的数据表/与图形集成吗？

​

​

谢谢,

Answer 1

另一种办法是：

library(ggplot2)
library(dplyr)
library(tidyr)
library(patchwork)
library(gridExtra)
#Data
data("mtcars")
#Code for data process
df <- mtcars %>% mutate(gear=factor(paste(gear,'gears'),
                                    levels=c('5 gears','4 gears','3 gears'),
                                    ordered = T),
                  cyl=paste(cyl,'Cyl')) %>%
  group_by(cyl,gear) %>% summarise(N=n())
#Plot
G1 <- ggplot(df,aes(x=cyl,y=N,fill=gear))+
  geom_bar(stat = 'identity')+
  theme_bw()+scale_fill_manual(values=c('orange','aquamarine3','cyan3'))+
  ggtitle('Gears and cylinders')+
  theme(plot.title = element_text(hjust=0.5),
        legend.position = 'none')
#Table
T1 <- df %>% pivot_wider(names_from = cyl,values_from=N) %>% replace(is.na(.),0)
#Format
#Theme
my_table_theme <- ttheme_default(core=list(bg_params = list(fill = c('orange','aquamarine3','cyan3'), col=NA)))
#Design
g1 <- gridExtra::tableGrob(T1["gear"], theme=my_table_theme, rows = NULL)
g2 <- gridExtra::tableGrob(T1[,-1], rows = NULL)
g2$widths <- unit(rep(0.25, 3), "npc")
haligned <- gtable_combine(g1,g2, along=1)
Fplot <- G1/haligned

输出：

​

​

Answer 2

patchwork可用于组合这两个图，ggtext可用于图例。

library(tidyverse)
library(patchwork)
library(ggtext)

转换数据。使用ggtext，我们可以在gear列中使用标记。我们将使用■符号并对其着色。

df <-
  mtcars %>%
  mutate(
    color = case_when(
      gear == 5 ~ "#F8766D",
      gear == 4 ~ "#00BA38",
      gear == 3 ~ "#619CFF",
    ),
    gear = fct_reorder(as_factor(glue::glue("<b style='color:{color}'>■</b> {gear} Gears")), gear),
    cyl = paste0(cyl, " Cyl")
  ) %>%
  count(gear, cyl) 

p1 <-
  ggplot(df, aes(cyl, n, fill = gear)) +
  geom_col() +
  scale_y_continuous(breaks = seq(from = 0, to = 16, by = 2), lim = c(0, 16)) +
  theme_minimal() +
  theme(
    legend.position = "none",
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    panel.grid.minor.x = element_blank(),
    panel.grid.major.x = element_blank(),
    panel.grid.minor.y = element_blank(),
    panel.grid.major.y = element_line(colour = "grey")
  ) +
  labs(
    title = "Gears and Cylinders - mtcars.csv"
  )

p2 <-
  df %>%
  ggplot(aes(cyl, gear, label = n)) +
  geom_text() +
  geom_hline(yintercept = c(0.5, 1.5, 2.5), colour='grey') +
  theme_void() +
  theme(
    axis.text.y = element_markdown(),
    plot.title = element_blank()
  )

使用patchwork将其组合在一起。

p1 + p2 + plot_layout(ncol = 1, heights = c(7, 2))

​

​

Answer 3

我想你可以这样做：

df <- as.data.frame(table(mtcars$cyl, mtcars$gear))
names(df) <- c("cyl", "gear", "n")
df$ypos <- -2 * as.numeric(df$gear) - 1
df$gear <- factor(df$gear, levels = c(5, 4, 3))

ggplot(df, aes(x = cyl, y = n, fill = gear)) +
  geom_col(position = position_stack(), width = 0.5) + 
  geom_hline(yintercept = c(-4, -6)) +
  geom_text(aes(label = n, y = ypos)) +
  geom_text(data = data.frame(label = c("4 cyl", "6 cyl", "8 cyl"),
                              cyl = c("4", "6", "8"), n = -1),
            aes(x = cyl, y = n, label = label), inherit.aes = FALSE) +
  scale_y_continuous(limits = c(-10, 16), breaks = 0:8 * 2) +
  scale_fill_manual(values = c("#ff8021","#5dceb0", "#5fccf3")) +
  labs(title = "Gears and Cylinders - mtcars.csv", y = "") +
  theme_bw() +
  theme(plot.title = element_text(hjust = 0.5, color = "gray50", size = 20),
        legend.position = c(0, 0.25),
        legend.key.height =  unit(1, "cm"), 
        panel.grid.major.x = element_blank(),
        panel.grid.minor.y = element_blank(),
        panel.border = element_rect(fill = NA, color = NA),
        axis.title.x = element_blank(),
        axis.text.x = element_blank(),
        axis.ticks.length.x = unit(0, "mm"))

​

​