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

Question

我想知道ggplot2是否有可能创建一个包含图像的多图（如facet）：

我不确切知道如何安排图像数据将其传递给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＆＃34;一个比将图表光栅化为图像等（我的意思是，根据人类的努力程度来衡量）。

但由于你的问题中有一个有趣的组成部分，下面我提供了一个劣质的解决方案。 起点是您提供的示例。我使用一些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的答案。

希望有所帮助。