Question

学生问我是否可以使用R重建类似下面的情节：

enter image description here 这是this paper....

这种东西不是我的专长，但使用下面的代码，我能够创建95％CI省略号并用geom_polygon()绘制它们。我使用rphylopic包装填充了我从phylopic库中抓取的图像。

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

其中包含以下内容：

enter image description here

这没关系，但我真正想做的是直接在“填充”中添加图片。命令geom_polygon。这可能吗？

Answer 1

我们无法为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))
}

我要展示的关键功能是将光栅图像转换为data.frame，其中包含X，Y，color列，以便我们稍后可以使用{{1 }}

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) )的{{1}}函数的帮助下实现它。

point.in.polygon

最后......

sp

我们可以在不更改代码的情况下轻松调整绘图大小。

当然，你应该记住机器的性能，并且可能不会选择20MP图片来绘制你的# 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,] =）

Answer 2

不使用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)
}

（图像是＆＃34;随机＆＃34;在维基媒体上找到的图像，为此重新命名）

在这里，我只是将图像集中在每组的平均值上（如文章中所述），并使它们的大小与标准偏差成比例。要使其符合文章中使用的95％置信区间，将难以实现。

这不是完全需要的结果，但它很容易做到（尽管如果你真的想让你的图像适合椭圆，我会更多地去找一个gimp解决方案，正如@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)

将自定义图像添加到geom_polygon会填写ggplot

3 个答案: