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

Create a Scatterplot of Raster Images in R

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

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

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

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


更新

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

TeachingDemos 包中的 my.symbolsms.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 像这样(虽然显然您将使用真实数据而不是 运行dom 数字作为位置):

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)

下面是一些基于上面评论中的 link 使用 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