在 ggplot 中将自定义图像添加到 geom_polygon 填充

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

不使用 ggplot的快速而丑陋的解决方案可以是使用 rasterImager和 package(jpg)(或者 png，取决于你图像的格式) :

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

(这些图片是在维基媒体上找到的“随机”图片，因为这个场合而重新命名)

在这里，我只是简单地将图像集中在每个群体的平均值上(就像在文章中那样) ，并使它们的大小与标准差成正比。要让它符合文章中使用的95% 的置信区间并不困难。

这不完全是所需要的结果，但它很容易做到(尽管如果你真的想让你的图像适合椭圆形，如@Mike 所建议的，我更倾向于使用 gimp 解决方案)

我们不能为 ggplot 设置模式填充，但是我们可以在 geom_tile的帮助下制定一个非常简单的解决方案。复制你的初始数据:

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

我想展示的关键特性是将光栅图像转换为具有 X、 Y、 color列的 data.frame，这样我们以后就可以用 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))
}

转换图像:

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

据我所知，作者希望绘制图像只在椭圆内部，而不是在他们原来的矩形形状。我们可以借助于 sp包中的 point.in.polygon函数来实现。

# 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,]

最后。

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

我们可以很容易地调整图的大小，而不需要更改代码。

当然，您应该记住您的机器的性能能力，并且可能不要选择20MP 的图片在 ggplot = 中绘图