legends - Agregar una imagen personalizada a geom_polygon complete ggplot

guides ggplot2

Question

Un estudiante me preguntó si era posible recrear una trama similar a la siguiente usando R:

Esto es de este papel ...

Este tipo de cosas no es mi especialidad, pero usando el siguiente código pude crear puntos suspensivos de CI al 95% y geom_polygon() con geom_polygon() . Llené las imágenes con imágenes que tomé de la biblioteca filopópica utilizando el paquete 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()

Que da lo siguiente:

Esto está bien, pero lo que realmente me gustaría hacer es agregar una imagen directamente al comando ''fill'' de geom_polygon. Es posible ?

Answer 1

No podemos establecer el relleno de patrón para ggplot, pero podemos hacer una solución bastante simple con la ayuda de geom_tile . Reproducción de sus datos iniciales:

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

La característica clave que quiero mostrar es convertir una imagen ráster en data.frame con columnas X , Y , color para que luego podamos geom_tile con 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))
}

Conversión de imágenes:

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

Hasta donde he llegado, el autor quiere trazar imágenes solo dentro de elipsis, no en su forma rectangular original. Podemos lograrlo con la ayuda de la función point.in.polygon del paquete 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,]

Y finalmente...

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

Podemos cambiar el tamaño de la trama fácilmente sin hacer cambios en el código.

Y, por supuesto, debe tener en cuenta las capacidades de rendimiento de su máquina y, probablemente, no elegir imágenes de ggplot para trazar dentro de su ggplot =)

Answer 2

Una solución rápida y fea sin usar ggplot podría ser usar rasterImager y el package(jpg) (o png , dependiendo del formato de sus imágenes):

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

(las imágenes son imágenes "aleatorias" encontradas en wikimedia, renombradas para la ocasión)

Aquí simplemente centré la imagen en la media de cada grupo (como en el artículo) y hago que su tamaño sea proporcional a la desviación estándar. No será difícil hacerlo coincidir con el intervalo de confianza del 95% utilizado en el artículo.

No es exactamente el resultado necesario, pero es bastante fácil de hacer (aunque me gustaría ir más a una solución de gimp si realmente quieres ajustar tu imagen a la elipse, como lo sugiere @Mike)

Answer 3

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