是否可以使用 ggplot 创建数据和图像的多图？

Question

我想知道是否可以使用 ggplot2 创建一个多重绘图（如一个方面），包括看起来像这样的图像：

我不确切知道如何安排图像数据以将它们传递给geom_raster() 或如何将图像包含在数据框中...

我尝试过的：

> img1 <- readPNG('1.png')
> img2 <- readPNG('2.png')
> img3 <- readPNG('3.png')

> test <- data.frame(c(1,2,3),c(5,2,7),c(img1,img2,img3))
> nrow(test)
 [1] 4343040

我在这里已经有一个问题来构建一个包含图像的数据框......每 3 行重复一次（我猜每个像素一次）。

Answer 1

我最终采用了这个解决方案，将绘图分解为 gtable，再添加一行并插入图像。当然，一旦分解就不能再增加图层了，所以它应该是最后的操作。我不认为 gtable 可以转换回绘图。

library(png)
library(gridExtra)
library(ggplot2)
library(gtable)
library(RCurl) # just to load image from URL

#Loading images
img0 <- readPNG(getURLContent('http://i.stack.imgur.com/3anUH.png'))
img1 <- readPNG(getURLContent('http://i.stack.imgur.com/3anUH.png'))

#Convert images to Grob (graphical objects)
grob0 <- rasterGrob(img0)
grob1 <- rasterGrob(img1)

# create the plot with data
p <- ggplot(subset(mpg,manufacturer=='audi'|manufacturer=='toyota'),aes(x=cty,y=displ))+facet_grid(year~manufacturer)+geom_point()

# convert the plot to gtable
mytable <- ggplot_gtable(ggplot_build(p))

#Add a line ssame height as line 4 after line 3
# use gtable_show_layout(mytable) to see where you want to put your line
mytable <- gtable_add_rows(mytable, mytable$height[[4]], 3)
# if needed mor row can be added 
# (for example to keep consistent spacing with other graphs)

#Insert the grob in the cells of the new line
mytable <- gtable_add_grob(mytable,grob0,4,4, name = paste(runif(1)))
mytable <- gtable_add_grob(mytable,grob1,4,6, name = paste(runif(1)))

#rendering
grid.draw(mytable)

注意：在此示例中，我使用了两次相同的图像，但当然可以根据需要使用多少。

灵感来自：How do you add a general label to facets in ggplot2?

Answer 2

这是一个相当奇怪的问题。通常情况下，“photoshop”一个可能比将图栅格化成图像等更快（我的意思是，以需要多少人力来衡量）。

但是由于您的问题中有一个有趣的组成部分，因此我在下面提供了一个粗制滥造的解决方案。 起点是您提供的示例。我使用一些 R 代码来提取两个面，然后将它们与两个图（任何图）结合起来。绘图将保存为 PNG，然后作为光栅图像加载到 R 中。

最终你将四个方面结合起来，制作出最终的情节。

library(png)
library(ggplot2)

# load PNG file, and reduce dimension to 1. 
# there's no sanity check to verify how many channels a PNG file has.
# potentially there can be 1 (grayscale), 3 (RGB) and 4 (RGBA).
# Here I assume that PNG file f has 4 channels.
load_png <- function(f) {
  d <- readPNG(f)
  # CCIR 601

  rgb.weights <- c(0.2989, 0.5870, 0.1140)
  grayscale <- matrix(apply(d[,,-4], -3, 
                            function(rgb) rgb %*% rgb.weights), 
                      ncol=dim(d)[2], byrow=T)
  grayscale
}

# the image you provided as an example,
# used to extract the two emoicons
img <- load_png("3anUH.png")

# convert a grayscale matrix into a data.frame,
# facilitating plotting by ggplot
melt_grayscale <- function(d) {
  w <- ncol(d)
  h <- nrow(d)
  coords <- expand.grid(1:w, 1:h)
  df <- cbind(coords, as.vector(d))
  names(df) <- c("x", "y", "gs")
  # so that smallest Y is at the top
  df$y <- h - df$y + 1

  df
}

plot_grayscale <- function(d, melt=F) {
  df <- melt_grayscale(d)
  ggplot(df) + geom_raster(aes(x=x, y=y, fill=gs)) + scale_fill_continuous(low="#000000", high="#ffffff")
}

ggplot_blank <- function(x, y) {
  # to plot a graph without any axis, grid and legend
  # otherwise it would look weird when performing facet_wrap()

  qplot(x, y + rnorm(10), size=15) + 
    theme(axis.line=element_blank(),
          axis.text.x=element_blank(),
          axis.text.y=element_blank(),
          axis.ticks=element_blank(),
          axis.title.x=element_blank(),
          axis.title.y=element_blank(),
          legend.position="none",
          panel.background=element_blank(),
          panel.border=element_blank(),
          panel.grid.major=element_blank(),
          panel.grid.minor=element_blank(),
          plot.background=element_blank())
}

# extract the two faces
#offset <- c(50, 40)

img0 <- img[50:200, 40:190]
img1 <- img[210:360, 40:190]

plot_grayscale(img0)
plot_grayscale(img1)

此时我们的img0 看起来像：。

您可能可以调整子集偏移量以获得更清晰的切割。

接下来我们要绘制两个绘图，并将绘图保存为可以稍后加载的 PNG。

# now plot two PNGs using ggplot
png(file="p0.png", width=150, height=150)
ggplot_blank(1:10, 10:1 + rnorm(10))
dev.off()

png(file="p1.png", width=150, height=150)
ggplot_blank(1:10, rnorm(10, 10))
dev.off()

p0 <- load_png("p0.png")
p1 <- load_png("p1.png")

# combine PNG grayscale matrices together
# into a melted data.frame, but with an extra column to
# identify which panel does this pixel belong to.
combine.plots <- function(l) {
  panel <- 0
  do.call(rbind, lapply(l, function(m){
    panel <<- panel + 1
    cbind(melt_grayscale(m), panel)
  }))
}

plots <- combine.plots(list(img0, img1, p0, p1))
ggplot(plots) + geom_raster(aes(x=x, y=y, fill=gs)) + 
  scale_fill_continuous(low="#000000", high="#ffffff") + facet_wrap(~panel)

当然，明显的缺点是上面的例子只有灰度图像。 如果您希望在最终绘图中使用 RGB 颜色，那就更麻烦了。

您可能可以做 GIF 格式正在做的事情：索引颜色。 基本上你：

• 将 RGB 值离散为 256 或 512 种颜色
• 创建离散颜色的向量
• 将scale_fill_continous 替换为scale_fill_manual 并让values 等于您在上面创建的颜色矢量。

编辑：将geom_raster 与geom_point 结合起来。

上述解决方案使用png()函数首先将绘图保存到PNG文件（涉及光栅化），然后将光栅化图像加载到R中。这个过程可能会导致分辨率损失，例如，显示的两个图像在顶部面板中本身的分辨率很低。

我们可以修改上述解决方案，将geom_point 与geom_raster 结合起来，其中前者用于渲染绘图，后者用于渲染图像。

这里唯一的问题，（假设要显示的两个图像具有相同的分辨率，用w x h 表示，其中w 是宽度，h 是高度）是facet_wrap 将强制执行所有面板都具有相同的 X/Y-限制。 因此，我们需要在绘制它们之前将它们重新缩放到相同的限制 (w x h)。

下面是修改后的R代码，用于组合图和图像：

library(png)
library(ggplot2)

load_png <- function(f) {
  d <- readPNG(f)
  # CCIR 601

  rgb.weights <- c(0.2989, 0.5870, 0.1140)
  grayscale <- matrix(apply(d[,,-4], -3, 
                            function(rgb) rgb %*% rgb.weights), 
                      ncol=dim(d)[2], byrow=T)
  grayscale
}

# the image you provided as an example,
# used to extract the two emoicons
img <- load_png("3anUH.png")

# convert a grayscale matrix into a data.frame,
# facilitating plotting by ggplot
melt_grayscale <- function(d) {
  w <- ncol(d)
  h <- nrow(d)
  coords <- expand.grid(1:w, 1:h)
  df <- cbind(coords, as.vector(d))
  names(df) <- c("x", "y", "gs")
  df$y <- h - df$y + 1

  df
}

plot_grayscale <- function(d, melt=F) {
  df <- melt_grayscale(d)
  ggplot(df) + geom_raster(aes(x=x, y=y, fill=gs)) + scale_fill_continuous(low="#000000", high="#ffffff")
}

ggplot_blank <- function(x, y) {
  # to plot a graph without any axis, grid and legend
  qplot(x, y + rnorm(10), size=15) + 
    theme(axis.line=element_blank(),
          axis.text.x=element_blank(),
          axis.text.y=element_blank(),
          axis.ticks=element_blank(),
          axis.title.x=element_blank(),
          axis.title.y=element_blank(),
          legend.position="none",
          panel.background=element_blank(),
          panel.border=element_blank(),
          panel.grid.major=element_blank(),
          panel.grid.minor=element_blank(),
          plot.background=element_blank())
}

# extract the two faces
#offset <- c(50, 40)

img0 <- img[50:200, 40:190]
img1 <- img[210:360, 40:190]

plot_grayscale(img0)
plot_grayscale(img1)

# now plot two PNGs using ggplot
png(file="p0.png", width=300, height=300)
ggplot_blank(1:10, 10:1 + rnorm(10))
dev.off()

png(file="p1.png", width=300, height=300)
ggplot_blank(1:10, rnorm(10, 10))
dev.off()

p0 <- load_png("p0.png")
p1 <- load_png("p1.png")

combine.plots <- function(l) {
  panel <- 0
  do.call(rbind, lapply(l, function(m){
    panel <<- panel + 1
    cbind(melt_grayscale(m), panel)
  }))
}

rescale.plots <- function(x, y, w, h, panel) {
  # need to rescale plots to the same scale (w x h)
  x <- (x - min(x)) / (max(x) - min(x)) * w
  y <- (y - min(y)) / (max(y) - min(y)) * h

  data.frame(x=x, y=y, panel=panel)
}

imgs <- combine.plots(list(img0, img1))


# combine two plots, with proper rescaling
plots <- rbind(
  rescale.plots(1:100, 100:1 + rnorm(100), 150, 150, panel=3),
  rescale.plots(1:100, rnorm(100), 150, 150, panel=4)
)


ggplot() + geom_raster(data=imgs, aes(x=x, y=y, fill=gs)) + geom_point(data=plots, aes(x=x, y=y)) +
  facet_wrap(~panel) + scale_fill_continuous(low="#000000", high="#ffffff")

这会给你：

您可能无法直观地检测到直接的差异，但是当您在 R 中调整输出图像的大小时会很明显。

Answer 3

您是否考虑过使用 gridExtra 将单独的绘图与您想要的图像结合起来？

例如；

# import packages needed
library(png)
library(gridExtra)
library(ggplot2)

# read image files
img1 <- readPNG('1.png')
img2 <- readPNG('2.png')

# convert images to objects that gridExtra can handle
image1 <- rasterGrob(img1, interpolate=TRUE)
image2 <- rasterGrob(img2, interpolate=TRUE)

# create whatever plot you want under the images;
test <- data.frame(x = c(1,2,3), y =c(5,2,7), facet = c("A", "B", "B"))
plot <- ggplot(test,aes(x=x, y= y)) + geom_point() + facet_wrap(~ facet) 

# use grid.arrange to display the images and the plot on the same output. 
grid.arrange(image1,image2,plot, ncol = 2)

您可能需要使用 grid.arrange 来获得准确的输出。

# perhaps something like:
p = rectGrob()
grid.arrange(arrangeGrob(image1, image2, widths=c(1/2), ncol =2), plot, ncol=1)

改编自this question的回答。

希望对您有所帮助。