r - 是否可以在 ggplot2 绘图中绘制图像，当您保存为任何非标准纵横比时不会失真？

Question

我正在寻找这个问题的任何解决方案，无论使用什么包。

手头的问题是当您使用 ggsave 保存它们时，绘制的图像会失真。让我举个例子:

image_links = data.frame(id = c(1,2,3,4,5),
                         image = c("https://cdn.shopify.com/s/files/1/1061/1924/products/Smiling_Emoji_with_Eyes_Opened_large.png",
                                   "https://cdn.shopify.com/s/files/1/1061/1924/products/Smiling_Emoji_with_Smiling_Eyes_large.png",
                                   "https://cdn.shopify.com/s/files/1/1061/1924/products/Hushed_Face_Emoji_large.png",
                                   "https://cdn.shopify.com/s/files/1/1061/1924/products/Disappointed_but_Relieved_Face_Emoji_large.png",
                                   "https://cdn.shopify.com/s/files/1/1061/1924/products/Expressionless_Face_Emoji_large.png"))


mydata = data.frame(x = rnorm(100, mean = 50, sd = 20),
                    y = rnorm(100, mean = 50, sd = 5),
                    id = rep(c(1,2,3,4,5), 20))

mydata$y = mydata$y - 10*mydata$id

mydata = mydata %>% left_join(image_links, by='id')

g <- ggplot(mydata) + geom_image(aes(x=x, y=y, image=image), size=0.05)

ggsave(g, filename='[INSERT PATH HERE].png', width=width, height=height, dpi=300)

这很好用:

当您调整 ggsave 的 width 和 height 参数时会出现问题，例如因为您希望 x 轴和 y 轴比例正确:

width = (max(mydata$x) - min(mydata$x))/10
height = (max(mydata$y) - min(mydata$y))/10

ggsave(g, filename='[INSERT PATH HERE].png', width = width, height=height, dpi=300)

x 轴和 y 轴现在正常了，但图像失真了:

在您绘制图像但 width/height 纵横比与您要添加的图像的原始纵横比不同的任何情况下都会发生这种情况.

我正在寻找这个问题的任何解决方案，不一定限于 ggimage。无法将图像正确添加到 ggplot 对我来说似乎很奇怪，因为我认为人们想要这样做是很常见的。

Answer 1

我不太了解 ggsave，但这似乎是一个与相对单位和绝对单位相关的问题。 geom_image() 可能会计算相对于轴的位置，当轴调整大小时(例如在 ggsave 内)会发生变形。例如:

ggplot(mydata) + geom_image(aes(x=x, y=y, image=image), size=0.05)

可以看起来像:

或者看起来像:

取决于我可以随意调整大小的设备窗口。

我可以通过两种方式解决此问题，这两种方式都涉及在绘制时重新计算栅格的大小。更简单的修复方法如下。

# Get plot
g <- ggplot(mydata) + geom_image(aes(x=x, y=y, image=image), size=0.05)

# Convert to gtable
gt <- ggplotGrob(g)

# Get the imagegrobs, correct slots found by trial and error
imagegrobs <- gt$grobs[[6]]$children[[3]]$children

# Re-class them to a custom, made-up class
imagegrobs <- lapply(imagegrobs, function(image) {
  class(image) <- c("fixasp_raster", class(image))
  image
})

# Put them back into the gtable
gt$grobs[[6]]$children[[3]]$children <- imagegrobs 

现在我们有了这些图像的自定义类，我们可以编写一段在绘图时执行的代码，方法是使用来自网格包。

library(grid)
makeContent.fixasp_raster <- function(x) {
  # Convert from relative units to absolute units
  h <- convertHeight(x$height, "cm", valueOnly = TRUE)
  w <- convertWidth(x$width, "cm", valueOnly = TRUE)
  # Decide how the units should be equal
  x$height <- x$width <- unit(sqrt(h * w), "cm")
  x
}

请注意，乘积的平方根是即兴的，我不知道这是否是最佳程序。

当我们现在绘制数据时，无论纵横比如何，我们都会有一致大小的图像:

grid.newpage(); grid.draw(gt)

解决此问题的第二种方法是在 ggimage 包的 github 页面中提交问题，激发您的用例并说服他们实现解决您关注的问题。如果他们愿意，他们可以在 ggproto 级别进行修复，这样您就不会涉足 gtables。