如何使用cowplot为x轴和y轴添加一个grob？

Question

我发现了如何轻松插入 png 作为轴刻度标签，遵循 这篇文章。 然而，这似乎只适用于单轴。我不太确定如何将 y 轴和 x 轴 grob 绘制到我的绘图中。

要为 y 或 x 轴绘制一个 grob，可以执行以下操作...

library(ggplot2)
library(cowplot2)
library(png)
library(Rcurl)

data <- data.frame(
  pairType = c("assortative", "disassortative", "disassortative", "assortative", "disassortative", "disassortative", "assortative"),
  Male_Phenotype = c("metallic", "rufipennis", "metallic", "militaris-a", "metallic", "militaris-a", "rufipennis"),
  Female_Phenotype = c("metallic", "metallic", "militaris-a", "militaris-a", "rufipennis", "rufipennis", "rufipennis"),
  exp = c(0.10204082, 0.11224490, 0.28571429, 0.10204082, 0.02040816, 0.08163265, 0.29591837),
  obs = c(0.04081633, 0.02040816, 0.02040816, 0.03061224, 0.00000000, 0.00000000, 0.03061224)
)


rufiPNG<- "https://i.stack.imgur.com/Q8BqO.png"
rufipennis <- readPNG(getURLContent(rufiPNG))

militarisPNG<- "https://i.stack.imgur.com/EtdfR.png"
militaris_a <- readPNG(getURLContent(militarisPNG))


metallicPNG<- "https://i.stack.imgur.com/YIDoA.png"
metallic <- readPNG(getURLContent(metallicPNG))

#my crazy plot
p<- ggplot(chiMate, aes(x = `Male Phenotype`, y = `Female Phenotype`)) +
  geom_point(aes(color = pairType, size = 2.1*exp))+
  geom_point(color = "black", aes(size = 1.6*exp)) +
  geom_point(color = "white", aes(size = 1.3*exp)) +
  geom_point(aes(size = 1.25*obs), color= "salmon") +
  scale_color_manual("Pair type", values = c("assortative" = "cornflowerblue", "disassortative" = "aquamarine3")) +
  scale_size_continuous(range = c(10, 45))+
  scale_x_discrete(expand=c(.3,.3))+
  scale_y_discrete(expand=c(0.3,0.3))+
  geom_text(aes(label= round(obs, digits= 3)))+
  theme_minimal() +
  labs(x = "Male Phenotype", y = "Female Phenotype", size = "Mate Count")+
  theme(legend.position = 'bottom', legend.box.background = element_rect(color='black'),  axis.title = element_text(size= 14), axis.text = element_text(size= 10))+
  guides(color = guide_legend(override.aes = list(size = 12)),  size = "none")


#create canvas
ystrip <- axis_canvas(p, axis = 'y') + 
  draw_image(rufipennis, y = 2.35, scale = 4) +
  draw_image(militaris_a, y = 1.5, scale = 4) +
  draw_image(metallic, y = .65, scale = 4)

#'draw' grob onto ggplot, 'p'
ggdraw(insert_yaxis_grob(p, ystrip, position = "left",width = grid::unit(0.05, "null")))

我试过了

ggdraw(p)+ 
insert_yaxis_grob(p, ystrip, position = "left",width = grid::unit(0.05, "null"))+
insert_xaxis_grob(p, xstrip, position = "bottom",height = grid::unit(0.1, "null"))

和

ggdraw(insert_yaxis_grob(p, ystrip, position = "left",width = grid::unit(0.05, "null")),
insert_xaxis_grob(p, xstrip, position = "bottom",height = grid::unit(0.1, "null")))

无济于事。有什么想法吗？

Answer 1

将图像添加到轴文本的一个选项是使用

ggtext

 包，该包允许使用 

<img>

 以及使用 

ggtext::element_markdown()

 将图像添加到轴文本。但是，我还没有找到将 y 轴文本的文本和图像居中对齐的选项。相反，对于 y 轴，我使用 

geom_richtext

 添加图像：

library(ggplot2)
library(ggtext)

chiMate <- data.frame(
  pairType = c("assortative", "disassortative", "disassortative", "assortative", "disassortative", "disassortative", "assortative"),
  Male_Phenotype = c("metallic", "rufipennis", "metallic", "militaris-a", "metallic", "militaris-a", "rufipennis"),
  Female_Phenotype = c("metallic", "metallic", "militaris-a", "militaris-a", "rufipennis", "rufipennis", "rufipennis"),
  exp = c(0.10204082, 0.11224490, 0.28571429, 0.10204082, 0.02040816, 0.08163265, 0.29591837),
  obs = c(0.04081633, 0.02040816, 0.02040816, 0.03061224, 0.00000000, 0.00000000, 0.03061224)
)

labels <- c(
  rufipennis = "<img src='https://i.stack.imgur.com/Q8BqO.png'
    width='20' />",
  "militaris-a" = "<img src='https://i.stack.imgur.com/EtdfR.png'
    width='20' />",
  metallic = "<img src='https://i.stack.imgur.com/YIDoA.png'
    width='20' />"
)

p <- ggplot(chiMate, aes(x = Male_Phenotype, y = Female_Phenotype)) +
  geom_point(aes(color = pairType, size = 2.1 * exp)) +
  geom_point(color = "black", aes(size = 1.6 * exp)) +
  geom_point(color = "white", aes(size = 1.3 * exp)) +
  geom_point(aes(size = 1.25 * obs), color = "salmon") +
  scale_color_manual("Pair type",
    values = c(
      "assortative" = "cornflowerblue",
      "disassortative" = "aquamarine3"
    )
  ) +
  scale_size_continuous(range = c(10, 45)) +
  scale_x_discrete(
    expand = c(0, 1),
    labels = \(x) paste0(labels[x], "<br>", x)
  ) +
  scale_y_discrete(
    expand = c(0, .8)
  ) +
  geom_text(aes(label = round(obs, digits = 3))) +
  # Add images for the y axis using ggtext::geom_richtext
  # to vertically align with the axis text
  ggtext::geom_richtext(
    data = tibble::enframe(labels),
    aes(y = name, label = value), x = -Inf,
    fill = "white", label.color = NA, hjust = 0
  ) +
  theme_minimal() +
  labs(x = "Male Phenotype", y = "Female Phenotype", size = "Mate Count") +
  theme(
    legend.position = "bottom",
    legend.box.background = element_rect(color = "black"),
    axis.title = element_text(size = 14),
    axis.text = ggtext::element_markdown(
      size = 10, valign = 0
    ),
    axis.text.y.left = ggtext::element_markdown(
      size = 10, valign = 1
    )
  ) +
  coord_cartesian(clip = "off") +
  guides(color = guide_legend(
    override.aes = list(size = 12)
  ), size = "none")

p