是否可以在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中似乎很奇怪，因为我对人们想这样做的图像非常普遍。

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 

因此，现在我们为这些图像提供了一个自定义类，我们可以通过使用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了。