Hiển thị hình ảnh tùy chỉnh dưới dạng geom_point

Question

Có thể hiển thị hình ảnh tùy chỉnh (có định dạng png) làm geom_point trong R ggplot không?

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")) + 

Cho lỗi:

Don't know how to automatically pick scale for object of type proto/environment. Defaulting to continuous Error: Aesthetics must either be length one, or the same length as the dataProblems:(annotation_raster(conv_pic, xmin = 0, ymin = 0, xmax = 5, ymax = 5))

Answer 1

các Geom điểm được sử dụng để tạo tán xạ, và không có vẻ khá được thiết kế để làm những gì bạn cần, ví dụ: , hiển thị hình ảnh tùy chỉnh. Tuy nhiên, một câu hỏi tương tự đã được trả lời here, mà chỉ ra rằng vấn đề có thể được giải quyết trong các bước sau:

(1) đọc những hình ảnh tùy chỉnh bạn muốn hiển thị,

(2) Render đối tượng raster tại được vị trí, kích thước, và định hướng sử dụng rasterGrob() chức năng,

(3) sử dụng một hàm âm mưu như qplot(),

(4) sử dụng một Geom như annotation_custom() để sử dụng các chú thích như tĩnh xác định những điều chỉnh thô cho giới hạn x và y là nam giới tioned bởi user20650.

Sử dụng mã bên dưới, tôi có thể nhận được hai hình ảnh tùy chỉnh img1.png và img2.png được định vị tại xmin, xmax, ymin và ymax đã cho.

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() 

Answer 2

này không hoàn toàn làm những gì bạn muốn trong geom_point nhưng nó có lẽ đề nghị một giải pháp nhanh chóng. Tuy nhiên, nó bao gồm một điều chỉnh khá thô cho các giới hạn x và 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) 

Đối với khía cạnh nhìn thấy Kohske's answer về cách thay đổi mapply chức năng.

EDIT

Tôi nghĩ rằng điều này thực sự làm cho tốt hơn sử dụng annotation_custom(), như trong câu trả lời của Deb. Dưới đây cho phép lặp qua tất cả các điểm, thay vì phải sử dụng từng cuộc gọi tùy chỉnh chú thích. Các thay đổi nhỏ từ trên cao là grob dường như cần phải được đổi tên (comment from link)

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))) 

Answer 3

DL Miller cung cấp giải pháp khác sử dụng 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()