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

Можно ли отобразить пользовательское изображение (скажем, в формате png) как 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")) +

Выдает ошибку:

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

3 ответа

Решение

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

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

(2) Рендеринг растровых объектов в заданном месте, размере и ориентации, используя 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()

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

library(png)
library(ggplot2)

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

ggplot(mtcars, aes(mpg, wt)) + 
       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) 

Для граней см . Ответ Kohske о том, как изменить mapply функция.

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

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

g <- rasterGrob(img, interpolate=FALSE)

ggplot(mtcars, aes(mpg, wt)) + 
       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))) 

Д.Л. Миллер предоставил другое решение, используя 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()
Другие вопросы по тегам