在 R 中创建光栅图像的散点图

Question

我不完全确定 SO 是否允许此类问题，因为我目前没有可重复的数据。

我的问题是关于如何在 R 中创建光栅图像的散点图。我不熟悉任何允许您这样做的包。 This is the only example 到目前为止，我在搜索中遇到过。本质上，这就是我想做的事情，但是，我想知道 R 是否可以简单地获取输入数据并绘制图像，而不是在我的绘图区域中提供坐标。

我的最终目标是使用他们的徽标而不是标签创建运动队的光栅图像散点图。我的第一个想法是创建一个包含团队名称、X 变量、Y 变量和 .png 图像 URL 位置的数据框。

这是我最终希望做的一个例子。我不确定 OP 使用什么程序，但显然我想在 R 中做这样的事情。

---

更新

在 Greg Snow 的建议的帮助下，我能够用我自己的徽标重现他的示例。

Answer 1

TeachingDemos 包中的my.symbols 和ms.image 函数是一个可能的起点。 ms.image 的帮助页面上有一个示例，显示了如何使用 R 徽标作为绘图符号。目前它一次只制作一个图像，因此您可以从一个空白图开始并循环遍历一组图像，或者可以编写一个包装函数来获取图像列表和要绘制的指示符。这是包装函数的第一次尝试：

ms.image2 <- function(imgs, transpose=TRUE, 
                      which=1, ...) {
  ms.image(imgs[[which]], transpose=transpose, ...)
}

然后我们可以使用如下代码创建一个图像列表：

require(png)
img1 <- readPNG(system.file("img", "Rlogo.png", package="png"))
logos <- list( img1, img1[76:1,,], img1[,100:1,],
               img1[76:1,100:1,], img1[,,c(3:1,4)])

这些都是徽标的变体，但对于您的示例，您可以将 .png 文件的文件名向量传递给 lapply 以生成类似的列表。

现在我们可以像这样运行my.symbols（尽管显然您将使用真实数据而不是随机数作为位置）：

my.symbols( runif(10), runif(10), ms.image2, 
            MoreArgs=list(imgs=logos), which=rep(1:5,2),
            inches=0.3, symb.plots=TRUE, add=FALSE)

这会根据您的示例生成一个情节：

编辑

为了加快速度，您可以使用rasterImage，这里有一些新代码，运行时间大约是上面的一半（与使用microbenchmark相比）：

ms.rasterImage <- function(imgs, which=1, ...) {
  rasterImage(imgs[[which]], -1, -1, 1, 1)
}

logos2 <- list(as.raster(img1), as.raster(img1[76:1,,]),
               as.raster(img1[,100:1,]), 
               as.raster(img1[76:1,100:1,]),
               as.raster(img1[,,c(3:1,4)])
    )

my.symbols( runif(10), runif(10), ms.rasterImage, 
            MoreArgs=list(imgs=logos2), which=rep(1:5,2),
            inches=0.3, symb.plots=TRUE, add=FALSE)

这里是一些使用 ggplot2 的代码，基于上面评论中的链接，但使用了徽标列表：

ggplot(mtcars, aes(mpg, wt)) + 
  mapply(function(xx, yy, i) 
    annotation_raster(logos[[i]], xmin=xx-1, xmax=xx+1, ymin=yy-0.2, ymax=yy+0.2),
    mtcars$mpg, mtcars$wt, mtcars$gear-2) 

主要出于好奇，以下是时间安排：

> microbenchmark(
+   my.symbols( mtcars$mpg, mtcars$wt, ms.image2, 
+               MoreArgs=list(imgs=logos), which=mtcars$gear-2,
+               inches=0.3, symb.plots=TRUE, add=FALSE),
+   my.symbols( mtcars$mpg, mtcars$wt, ms.rasterImage, 
+               MoreArgs=list(imgs=logos2), which=mtcars$gear-2,
+               inches=0.3, symb.plots=TRUE, add=FALSE),
+   plot(ggplot(mtcars, aes(mpg, wt)) + 
+          mapply(function(xx, yy, i) 
+            annotation_raster(logos[[i]], xmin=xx-1, xmax=xx+1, ymin=yy-0.2, ymax=yy+0.2),
+            mtcars$mpg, mtcars$wt, mtcars$gear-2) )
+ )
Unit: milliseconds

                      min       lq     mean   median        uq       max neval cld
       ms.image  518.9137 530.5549 661.9333 545.3890  751.7116 1737.7430   100  b 
 ms.rasterImage  158.7097 162.4493 244.6673 171.6103  381.6499  544.1656   100 a  
        ggplot2  478.3005 606.3831 896.8793 772.7210 1359.8888 1714.5647   100   c