Thêm hình ảnh tùy chỉnh để geom_polygon điền vào ggplot

Question

tôi được hỏi bởi một sinh viên nếu nó đã có thể tái tạo một âm mưu tương tự như hình dưới đây sử dụng R:

Đây là từ this paper....

này loại công cụ không phải là chuyên môn của tôi, nhưng sử dụng đoạn mã sau tôi đã có thể tạo ra các dấu ba chấm CI 95% và vẽ chúng với geom_polygon(). Tôi đã lấp đầy những hình ảnh bằng hình ảnh tôi chụp từ thư viện phylopic bằng cách sử dụng gói rphylopic.

#example data/ellipses 
set.seed(101) 
n <- 1000 
x1 <- rnorm(n, mean=2) 
y1 <- 1.75 + 0.4*x1 + rnorm(n) 
df <- data.frame(x=x1, y=y1, group="A") 
x2 <- rnorm(n, mean=8) 
y2 <- 0.7*x2 + 2 + rnorm(n) 
df <- rbind(df, data.frame(x=x2, y=y2, group="B")) 
x3 <- rnorm(n, mean=6) 
y3 <- x3 - 5 - rnorm(n) 
df <- rbind(df, data.frame(x=x3, y=y3, group="C")) 


#calculating ellipses 
library(ellipse) 
df_ell <- data.frame() 
for(g in levels(df$group)){ 
    df_ell <- rbind(df_ell, cbind(as.data.frame(with(df[df$group==g,], ellipse(cor(x, y), 
                      scale=c(sd(x),sd(y)), 
                      centre=c(mean(x),mean(y))))),group=g)) 
} 
#drawing 
library(ggplot2) 
p <- ggplot(data=df, aes(x=x, y=y,colour=group)) + 
    #geom_point(size=1.5, alpha=.6) + 
    geom_polygon(data=df_ell, aes(x=x, y=y,colour=group, fill=group), alpha=0.1, size=1, linetype=1) 


### get center points of ellipses 
library(dplyr) 
ell_center <- df_ell %>% group_by(group) %>% summarise(x=mean(x), y=mean(y)) 

### animal images 
library(rphylopic) 
lion <- get_image("e2015ba3-4f7e-4950-9bde-005e8678d77b", size = "512")[[1]] 
mouse <- get_image("6b2b98f6-f879-445f-9ac2-2c2563157025", size="512")[[1]] 
bug <- get_image("136edfe2-2731-4acd-9a05-907262dd1311", size="512")[[1]] 

### overlay images on center points 
p + add_phylopic(lion, alpha=0.9, x=ell_center[[1,2]], y=ell_center[[1,3]], ysize=2, color="firebrick1") + 
    add_phylopic(mouse, alpha=1, x=ell_center[[2,2]], y=ell_center[[2,3]], ysize=2, color="darkgreen") + 
    add_phylopic(bug, alpha=0.9, x=ell_center[[3,2]], y=ell_center[[3,3]], ysize=2, color="mediumblue") + 
    theme_bw() 

Mà cho những điều sau đây:

này là ok, nhưng những gì tôi thực sự muốn làm là thêm một hình ảnh trực tiếp đến 'điền' lệnh của geom_polygon. Điều này có thể không?

Answer 1

Chúng tôi không thể đặt mẫu điền cho ggplot, nhưng chúng tôi có thể thực hiện một giải pháp khá đơn giản với sự trợ giúp của geom_tile. Tái tạo dữ liệu ban đầu của bạn:

#example data/ellipses 
set.seed(101) 
n <- 1000 
x1 <- rnorm(n, mean=2) 
y1 <- 1.75 + 0.4*x1 + rnorm(n) 
df <- data.frame(x=x1, y=y1, group="A") 
x2 <- rnorm(n, mean=8) 
y2 <- 0.7*x2 + 2 + rnorm(n) 
df <- rbind(df, data.frame(x=x2, y=y2, group="B")) 
x3 <- rnorm(n, mean=6) 
y3 <- x3 - 5 - rnorm(n) 
df <- rbind(df, data.frame(x=x3, y=y3, group="C")) 

#calculating ellipses 
library(ellipse) 
df_ell <- data.frame() 
for(g in levels(df$group)){ 
    df_ell <- 
    rbind(df_ell, cbind(as.data.frame(
     with(df[df$group==g,], ellipse(cor(x, y), scale=c(sd(x),sd(y)), 
            centre=c(mean(x),mean(y))))),group=g)) 
} 

Các tính năng quan trọng tôi muốn hiển thị được chuyển đổi một hình ảnh raster vào data.frame với các cột X, Y, color vì vậy chúng tôi có thể sau đó vẽ nó với geom_tile

require("dplyr") 
require("tidyr") 
require("ggplot2") 
require("png") 

# getting sample pictures 
download.file("http://content.mycutegraphics.com/graphics/alligator/alligator-reading-a-book.png", "alligator.png", mode = "wb") 
download.file("http://content.mycutegraphics.com/graphics/animal/elephant-and-bird.png", "elephant.png", mode = "wb") 
download.file("http://content.mycutegraphics.com/graphics/turtle/girl-turtle.png", "turtle.png", mode = "wb") 
pic_allig <- readPNG("alligator.png") 
pic_eleph <- readPNG("elephant.png") 
pic_turtl <- readPNG("turtle.png") 

# converting raster image to plottable data.frame 
ggplot_rasterdf <- function(color_matrix, bottom = 0, top = 1, left = 0, right = 1) { 
    require("dplyr") 
    require("tidyr") 

    if (dim(color_matrix)[3] > 3) hasalpha <- T else hasalpha <- F 

    outMatrix <- matrix("#00000000", nrow = dim(color_matrix)[1], ncol = dim(color_matrix)[2]) 

    for (i in 1:dim(color_matrix)[1]) 
    for (j in 1:dim(color_matrix)[2]) 
     outMatrix[i, j] <- rgb(color_matrix[i,j,1], color_matrix[i,j,2], color_matrix[i,j,3], ifelse(hasalpha, color_matrix[i,j,4], 1)) 

    colnames(outMatrix) <- seq(1, ncol(outMatrix)) 
    rownames(outMatrix) <- seq(1, nrow(outMatrix)) 
    as.data.frame(outMatrix) %>% mutate(Y = nrow(outMatrix):1) %>% gather(X, color, -Y) %>% 
    mutate(X = left + as.integer(as.character(X))*(right-left)/ncol(outMatrix), Y = bottom + Y*(top-bottom)/nrow(outMatrix)) 
} 

hình ảnh Chuyển đổi :

# preparing image data 
pic_allig_dat <- 
    ggplot_rasterdf(pic_allig, 
        left = min(df_ell[df_ell$group == "A",]$x), 
        right = max(df_ell[df_ell$group == "A",]$x), 
        bottom = min(df_ell[df_ell$group == "A",]$y), 
        top = max(df_ell[df_ell$group == "A",]$y)) 

pic_eleph_dat <- 
    ggplot_rasterdf(pic_eleph, left = min(df_ell[df_ell$group == "B",]$x), 
        right = max(df_ell[df_ell$group == "B",]$x), 
        bottom = min(df_ell[df_ell$group == "B",]$y), 
        top = max(df_ell[df_ell$group == "B",]$y)) 

pic_turtl_dat <- 
    ggplot_rasterdf(pic_turtl, left = min(df_ell[df_ell$group == "C",]$x), 
        right = max(df_ell[df_ell$group == "C",]$x), 
        bottom = min(df_ell[df_ell$group == "C",]$y), 
        top = max(df_ell[df_ell$group == "C",]$y)) 

Theo như tôi nhận được, tác giả chỉ muốn vẽ hình ảnh trong hình elip bên, không có hình dạng hình chữ nhật ban đầu của chúng. Chúng ta có thể đạt được nó với sự giúp đỡ của hàm point.in.polygon từ gói sp.

# filter image-data.frames keeping only rows inside ellipses 
require("sp") 

gr_A_df <- 
    pic_allig_dat[point.in.polygon(pic_allig_dat$X, pic_allig_dat$Y, 
           df_ell[df_ell$group == "A",]$x, 
           df_ell[df_ell$group == "A",]$y) %>% as.logical,] 
gr_B_df <- 
    pic_eleph_dat[point.in.polygon(pic_eleph_dat$X, pic_eleph_dat$Y, 
           df_ell[df_ell$group == "B",]$x, 
           df_ell[df_ell$group == "B",]$y) %>% as.logical,] 
gr_C_df <- 
    pic_turtl_dat[point.in.polygon(pic_turtl_dat$X, pic_turtl_dat$Y, 
           df_ell[df_ell$group == "C",]$x, 
           df_ell[df_ell$group == "C",]$y) %>% as.logical,] 

Và cuối cùng ...

#drawing 
p <- ggplot(data=df) + 
    geom_polygon(data=df_ell, aes(x=x, y=y,colour=group, fill=group), alpha=0.1, size=1, linetype=1) 

p + geom_tile(data = gr_A_df, aes(x = X, y = Y), fill = gr_A_df$color) + 
    geom_tile(data = gr_B_df, aes(x = X, y = Y), fill = gr_B_df$color) + 
    geom_tile(data = gr_C_df, aes(x = X, y = Y), fill = gr_C_df$color) + theme_bw() 

Chúng ta có thể dễ dàng thay đổi kích thước cốt truyện mà không làm thay đổi mã.

Và, tất nhiên, bạn nên giữ trong khả năng hoạt động tâm trí của máy tính của bạn, và, có lẽ, không chọn hình ảnh 20MP cho âm mưu bên trong ggplot của bạn =)

Answer 2

#example data/ellipses set.seed(101) n <- 1000 x1 <- rnorm(n, mean=2) y1 <- 1.75 + 0.4*x1 + rnorm(n) df <- data.frame(x=x1, y=y1, 
    group="A") x2 <- rnorm(n, mean=8) y2 <- 0.7*x2 + 2 + rnorm(n) df <- 
    rbind(df, data.frame(x=x2, y=y2, group="B")) x3 <- rnorm(n, mean=6) 
    y3 <- x3 - 5 - rnorm(n) df <- rbind(df, data.frame(x=x3, y=y3, 
    group="C")) 


#calculating ellipses library(ellipse) df_ell <- data.frame() for(g in levels(df$group)){ 
    df_ell <- rbind(df_ell, 
    cbind(as.data.frame(with(df[df$group==g,], ellipse(cor(x, y),                    
    scale=c(sd(x),sd(y)),                     
    centre=c(mean(x),mean(y))))),group=g)) } 

#drawing library(ggplot2) p <- ggplot(data=df, aes(x=x, y=y,colour=group)) +  
    #geom_point(size=1.5, alpha=.6) + 
    geom_polygon(data=df_ell, aes(x=x, y=y,colour=group, fill=group), 
    alpha=0.1, size=1, linetype=1) 

Answer 3

Một giải pháp nhanh chóng và xấu xí mà không sử dụng ggplot có thể được sử dụng rasterImager và package(jpg) (hoặc png, tùy thuộc vào định dạng của bạn hình ảnh):

set.seed(101) 
n <- 1000 
x1 <- rnorm(n, mean=2) 
y1 <- 1.75 + 0.4*x1 + rnorm(n) 
df <- data.frame(x=x1, y=y1, group="1") 
x2 <- rnorm(n, mean=8) 
y2 <- 0.7*x2 + 2 + rnorm(n) 
df <- rbind(df, data.frame(x=x2, y=y2, group="2")) 
x3 <- rnorm(n, mean=6) 
y3 <- x3 - 5 - rnorm(n) 
df <- rbind(df, data.frame(x=x3, y=y3, group="3")) 

plot(df$x,df$y,type="n") 
for(g in unique(df$group)){ 
    ifile=readJPEG(paste(g,".jpg",sep=""),FALSE) 
    x=df$x[df$group == g] 
    y=df$y[df$group == g] 
    xmin=mean(x)-sd(x)*2 
    ymin=mean(y)-sd(y)*2 
    xmax=mean(x)+sd(x)*2 
    ymax=mean(y)+sd(y)*2 
    rasterImage(ifile,xmin,ymin,xmax,ymax) 
} 

(hình ảnh là "ngẫu nhiên" hình ảnh tìm thấy trên wikimedia, đổi tên cho dịp này)

Ở đây tôi chỉ đơn giản là căn giữa hình ảnh trên trung bình của mỗi nhóm (như trong bài viết) và làm cho kích thước của chúng tỷ lệ với độ lệch chuẩn. Nó sẽ không khó để làm cho nó phù hợp với khoảng tin cậy 95% được sử dụng trong bài viết.

Đó là không chính xác kết quả cần thiết nhưng nó khá dễ dàng để làm (mặc dù tôi sẽ nhiều hơn đi đến một giải pháp gimp nếu bạn thực sự muốn để phù hợp với hình ảnh của bạn vào hình elip, theo đề nghị của @ Mike)