Отображать собственное изображение как geom_point

Можно ли отображать пользовательское изображение (например, png format) как geom_point в R ggplot?

library(png)
pic1 <- readPNG("pic1.png")

png("Heatmap.png", units="px", width=3200, height=3200, res=300)
ggplot(data_frame, aes(medium, day, fill = Transactions))  +
   geom_tile(colour="white")  +
   facet_grid(dime3_year~dime3_month) + 
   scale_fill_gradient(high="blue",low="white") +
   theme_bw() + 
   geom_point(aes(dime3_channel, day, size=Conv,alpha=Conv,image=(annotation_raster(pic1,xmin=0,ymin=0,xmax=5,ymax=5)),color="firebrick")) +

Дает ошибку:

Не знаю, как автоматически выбрать масштаб для объекта типа прото/окружающая среда. По умолчанию непрерывная ошибка: Эстетика должна либо быть одной, либо той же длины, что и dataProblems: (annotation_raster (conv_pic, xmin = 0, ymin = 0, xmax = 5, ymax = 5))

Ответ 1

Точечная геометрия используется для создания диаграмм рассеяния и, похоже, не предназначена для того, чтобы делать то, что вам нужно, то есть отображать пользовательские изображения. Однако на тот же вопрос был дан ответ здесь, что указывает на то, что проблема может быть решена в следующих шагах:

(1) Прочитайте пользовательские изображения, которые вы хотите отобразить,

(2) Render растровых объектов в заданном месте, размере и ориентации с помощью функции rasterGrob(),

(3) Используйте функцию построения графика, такую как qplot(),

(4) Используйте геометрию, такую как annotation_custom() для использования в качестве статических аннотаций, определяющих грубые корректировки для пределов x и y, как указано пользователем20650.

Используя приведенный ниже код, я мог бы получить два пользовательских изображения img1.png и img2.png, расположенных в заданных xmin, xmax, ymin и ymax.

library(png)
library(ggplot2)
library(gridGraphics)
setwd("c:/MyFolder/")

img1 <- readPNG("img1.png")
img2 <- readPNG("img2.png")
g1 <- rasterGrob(img1, interpolate=FALSE)
g2 <- rasterGrob(img2, interpolate=FALSE)
qplot(1:10, 1:10, geom="blank") + 
  annotation_custom(g1, xmin=1, xmax=3, ymin=1, ymax=3) +
  annotation_custom(g2, xmin=7, xmax=9, ymin=7, ymax=9) +  
  geom_point()

Ответ 2

Это не совсем то, что вы хотите в geom_point но, возможно, предлагает быструю альтернативу. Тем не менее, он включает в себя довольно грубую корректировку для пределов x и y.

library(png)
library(ggplot2)

img <- readPNG(system.file("img", "Rlogo.png", package="png"))

ggplot(mtcars, aes(mpg, wt)) + 
       geom_blank() +
       mapply(function(xx, yy) 
          annotation_raster(img, xmin=xx-1, xmax=xx+1, ymin=yy-0.2, ymax=yy+0.2),
          mtcars$mpg, mtcars$wt)

О гранях см. Ответ Кохске о том, как изменить функцию mapply.

РЕДАКТИРОВАТЬ

Я думаю, что это на самом деле лучше, используя annotation_custom(), как в ответе Deb. Ниже показано, как обходить все точки, вместо того, чтобы использовать отдельные вызовы annotation_custom. Небольшое изменение сверху, что Grob, как представляется, должен быть переименованы (комментарий от ссылки)

g <- rasterGrob(img, interpolate=FALSE)

ggplot(mtcars, aes(mpg, wt)) + 
          geom_blank() +
          mapply(function(xx, yy, ii) {
          g$name <- ii
          annotation_custom(g, xmin=xx-1, xmax=xx+1, ymin=yy-0.2, ymax=yy+0.2)},
          mtcars$mpg, mtcars$wt, seq_len(nrow(mtcars)))

Ответ 3

Д.Л. Миллер предоставил другое решение, используя ggproto(). https://github.com/dill/emoGG

library(ggplot2)
library(grid)
library(EBImage)
img <- readImage(system.file("img", "Rlogo.png", package = "png"))
RlogoGrob <- function(x, y, size, img) {
    rasterGrob(x = x, y = y, image = img, default.units = "native", height = size, 
        width = size)
}

GeomRlogo <- ggproto("GeomRlogo", Geom, draw_panel = function(data, panel_scales, 
    coord, img, na.rm = FALSE) {
    coords <- coord$transform(data, panel_scales)
    ggplot2:::ggname("geom_Rlogo", RlogoGrob(coords$x, coords$y, coords$size, 
        img))
}, non_missing_aes = c("Rlogo", "size"), required_aes = c("x", "y"), default_aes = aes(size = 0.05), 
    icon = function(.) {
    }, desc_params = list(), seealso = list(geom_point = GeomPoint$desc), 
    examples = function(.) {
    })

geom_Rlogo <- function(mapping = NULL, data = NULL, stat = "identity", 
    position = "identity", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, 
    ...) {
    layer(data = data, mapping = mapping, stat = stat, geom = GeomRlogo, 
        position = position, show.legend = show.legend, inherit.aes = inherit.aes, 
        params = list(na.rm = na.rm, img = img, ...))
}
ggplot(mtcars, aes(wt, mpg))+geom_Rlogo()