在R中将照片与图表对齐

Question

起初我想手动在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 图片可以随机生成（用于演示示例），或者使用以下链接中的示例图像： Interphase prophase , metaphase, anaphase , telophase 编辑： 建议 @bapste

- jon

---

这似乎是annotation_raster的工作，但不幸的是它似乎无法与离散轴一起使用。 - baptiste

Answer 1

你可以为 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)

- baptiste

---

@bapsite谢谢你的解决方案。我相信这个函数适用于n个类别。如果我们制作5个不同的图表而不是一个分组的条形图，我想看看是否有更好的替代版本... - jon

@baptiste 很好的结果！但是获取它有点复杂吧？似乎我们需要详细了解如何使用ggplot2构建自定义几何/元素！ - agstudy

@agstudy 目前来看，这可能不值得；我会在Illustrator中完成它。不过，我希望能够更轻松地将这些自定义元素插入到ggplot2框架中。Lattice在这方面提供了更多的灵活性，每个元素都是一个可以被用户覆盖的函数。 - baptiste

@baptiste 我的方法不同。 我假设我们不能将所有用户自定义集成到任何框架中，因此我利用lattice/ggplot2的优势进行第一次绘制，然后使用基础网格框架处理我的绘图。 例如，我可以使用lattice bwplot来使用上面相同的代码。 我认为这种方法将在R.2.16中通过新的makeContent（）钩子得到增强。 - agstudy

当然，这是一个旧答案。gtable确实有潜力解决许多tricky ggplot2问题，不幸的是它的开发早在很久以前就停止了。 - baptiste

Answer 2

使用 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)

- agstudy

---

谢谢你的回答。也许我会尝试更好地组织它 - 特别是像我的手动布局一样对齐并将标签放在轴上...再次感谢你的建议。 - jon

是的，现在好多了！！谢谢，我需要调整边距来使照片变大，这是你建议的吗？ - jon

@jon 绝对没错！你需要调整边距！我已经修改了。我认为现在看起来很好。 - agstudy

@agstudy，赞一个好答案。是否有可能打印不同的照片，而对于OP来说，不同的数字有不同的阶段。我们如何强制匹配条形图中类别的适当顺序？ - SHRram

@SHRram 我更新了我的答案，并添加了一个虚拟图像列表。顺序是经典的，因为您要操作2个列表（images和names.axis）。 - agstudy

Answer 3

我现在会使用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 package (v0.3.0)于2020年01月29日创建}

- Claus Wilke

Answer 4

注意：我现在建议使用这里描述的方法。它更有原则性，更易于理解。

通过cowplot包中提供的函数（特别是axis_canvas()和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()函数也适用于本地文件。

理论上，可以使用ggimage包中的geom_image()来绘制图像条，但我无法做到不失真，所以我使用了五个draw_image()调用。

- Claus Wilke