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)

这工作正常：

当您调整 的width和height参数时会出现问题ggsave，例如因为您希望 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 中，这似乎很奇怪，因为我认为人们想要这样做是很常见的。

标签： rimageggplot2plot

Answer 1

我对 ggsave 了解不多，但这似乎是一个与相对单位与绝对单位相关的问题。可能geom_image()计算相对于轴的位置，当轴调整大小时（例如 within 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 

因此，现在我们已经为这些图像创建了一个自定义类，我们可以编写一段代码，该代码在绘制时通过使用makeContentgrid 包中的 S3 泛型为我们的类编写一个方法来执行。

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。