首先我认为我需要在 powerpoint 中手动进行，然后我想可以尝试使用 R，如果有解决方案。这是我的示例数据：
set.seed(123)
myd<- expand.grid('cat' = LETTERS[1:5], 'cond'= c(F,T), 'phase' = c("Interphase", "Prophase", "Metaphase", "Anaphase", "Telophase"))
myd$value <- floor((rnorm(nrow(myd)))*100)
myd$value[myd$value < 0] <- 0
require(ggplot2)
ggplot() +
geom_bar(data=myd, aes(y = value, x = phase, fill = cat), stat="identity",position='dodge') +
theme_bw()
以下是输出的样子：
jpeg 图像可以随机生成（用于演示示例）或链接中的示例图：
编辑：
建议@bapste
您可以为 创建自定义元素函数axis.text.x，但它非常繁琐且令人费解。过去也提出过类似的要求，如果有一个干净的解决方案来解决这个和其他自定义更改（条形标签、轴等）功能请求，有人吗？
library(jpeg)
img <- lapply(list.files(pattern="jpg"), readJPEG )
names(img) <- c("Anaphase", "Interphase", "Metaphase", "Prophase", "Telophase")
require(ggplot2)
require(grid)
# user-level interface to the element grob
my_axis = function(img) {
structure(
list(img=img),
class = c("element_custom","element_blank", "element") # inheritance test workaround
)
}
# returns a gTree with two children: the text label, and a rasterGrob below
element_grob.element_custom <- function(element, x,...) {
stopifnot(length(x) == length(element$img))
tag <- names(element$img)
# add vertical padding to leave space
g1 <- textGrob(paste0(tag, "\n\n\n\n\n"), x=x,vjust=0.6)
g2 <- mapply(rasterGrob, x=x, image = element$img[tag],
MoreArgs = list(vjust=0.7,interpolate=FALSE,
height=unit(5,"lines")),
SIMPLIFY = FALSE)
gTree(children=do.call(gList,c(g2,list(g1))), cl = "custom_axis")
}
# gTrees don't know their size and ggplot would squash it, so give it room
grobHeight.custom_axis = heightDetails.custom_axis = function(x, ...)
unit(6, "lines")
ggplot(myd) +
geom_bar(aes(y = value, x = phase, fill = cat), stat="identity", position='dodge') +
theme_bw() +
theme(axis.text.x = my_axis(img),
axis.title.x = element_blank())
ggsave("test.png",p,width=10,height=8)
使用grid包，并使用视口，你可以拥有这个
## transform the jpeg to raster grobs
library(jpeg)
names.axis <- c("Interphase", "Prophase", "Metaphase", "Anaphase", "Telophase")
images <- lapply(names.axis,function(x){
img <- readJPEG(paste('lily_',x,'.jpg',sep=''), native=TRUE)
img <- rasterGrob(img, interpolate=TRUE)
img
} )
## main viewports, I divide the scene in 10 rows ans 5 columns(5 pictures)
pushViewport(plotViewport(margins = c(1,1,1,1),
layout=grid.layout(nrow=10, ncol=5),xscale =c(1,5)))
## I put in the 1:7 rows the plot without axis
## I define my nested viewport then I plot it as a grob.
pushViewport(plotViewport(layout.pos.col=1:5, layout.pos.row=1:7,
margins = c(1,1,1,1)))
pp <- ggplot() +
geom_bar(data=myd, aes(y = value, x = phase, fill = cat),
stat="identity",position='dodge') +
theme_bw()+theme(legend.position="none", axis.title.y=element_blank(),
axis.title.x=element_blank(),axis.text.x=element_blank())
gg <- ggplotGrob(pp)
grid.draw(gg)
upViewport()
## I draw my pictures in between rows 8/9 ( visual choice)
## I define a nested Viewport for each picture than I draw it.
sapply(1:5,function(x){
pushViewport(viewport(layout.pos.col=x, layout.pos.row=8:9,just=c('top')))
pushViewport(plotViewport(margins = c(5.2,3,4,3)))
grid.draw(images[[x]])
upViewport(2)
## I do same thing for text
pushViewport(viewport(layout.pos.col=x, layout.pos.row=10,just=c('top')))
pushViewport(plotViewport(margins = c(1,3,1,1)))
grid.text(names.axis[x],gp = gpar(cex=1.5))
upViewport(2)
})
pushViewport(plotViewport(layout.pos.col=1:5, layout.pos.row=1:9,
margins = c(1,1,1,1)))
grid.rect(gp=gpar(fill=NA))
upViewport(2)
我现在将使用 ggtext 包执行此操作。这在概念上类似于此处建议的解决方案，但在包中完成了艰苦的工作。
library(tidyverse)
library(ggtext)
set.seed(123)
data <- expand.grid(
cat = LETTERS[1:5],
cond= c(FALSE, TRUE),
phase = c("Interphase", "Prophase", "Metaphase", "Anaphase", "Telophase")
) %>%
mutate(
value = floor(rnorm(n())*100),
value = ifelse(value < 0, 0, value)
)
# images from: http://www.microbehunter.com/mitosis-stages-of-the-lily/
labels <- c(
Interphase = "<img src='img/interphase.jpg' width='60' /><br>Interphase",
Prophase = "<img src='img/prophase.jpg' width='60' /><br>Prophase",
Metaphase = "<img src='img/metaphase.jpg' width='60' /><br>Metaphase",
Anaphase = "<img src='img/anaphase.jpg' width='60' /><br>Anaphase",
Telophase = "<img src='img/telophase.jpg' width='60' /><br>Telophase"
)
ggplot(data, aes(phase, value, fill = cat)) +
geom_col(position = "dodge") +
scale_x_discrete(name = NULL, labels = labels) +
theme(axis.text.x = element_markdown(lineheight = 1.2))
由reprex 包（v0.3.0）于 2020 年 1 月 29 日创建
注意：我现在推荐这里描述的方法。它更有原则，更容易理解。
axis_canvas()使用 cowplot 包中可用的函数，特别是and函数，生成这样的图形变得相对简单insert_xaxis_grob()。（免责声明：我是包作者。）
require(cowplot)
# create the data
set.seed(123)
myd <- expand.grid('cat' = LETTERS[1:5], 'cond'= c(F,T), 'phase' = c("Interphase", "Prophase", "Metaphase", "Anaphase", "Telophase"))
myd$value <- floor((rnorm(nrow(myd)))*100)
myd$value[myd$value < 0] <- 0
# make the barplot
pbar <- ggplot(myd) +
geom_bar(aes(y = value, x = phase, fill = cat), stat="identity", position='dodge') +
scale_y_continuous(limits = c(0, 224), expand = c(0, 0)) +
theme_minimal(14) +
theme(axis.ticks.length = unit(0, "in"))
# make the image strip
pimage <- axis_canvas(pbar, axis = 'x') +
draw_image("http://www.microbehunter.com/wp/wp-content/uploads/2009/lily_interphase.jpg", x = 0.5, scale = 0.9) +
draw_image("http://www.microbehunter.com/wp/wp-content/uploads/2009/lily_prophase.jpg", x = 1.5, scale = 0.9) +
draw_image("http://www.microbehunter.com/wp/wp-content/uploads/2009/lily_metaphase2.jpg", x = 2.5, scale = 0.9) +
draw_image("http://www.microbehunter.com/wp/wp-content/uploads/2009/lily_anaphase2.jpg", x = 3.5, scale = 0.9) +
draw_image("http://www.microbehunter.com/wp/wp-content/uploads/2009/lily_telophase.jpg", x = 4.5, scale = 0.9)
# insert the image strip into the bar plot and draw
ggdraw(insert_xaxis_grob(pbar, pimage, position = "bottom"))
我在这里直接从网上读取图像，但该draw_image()功能也适用于本地文件。
从理论上讲，应该可以使用geom_image()ggimage 包中的图像条来绘制图像条，但是如果图像不失真，我就无法让它工作，所以我使用了 5 次draw_image()调用。