ggplot

2015-01-29 19 views
69

में भरने मैं एक छात्र द्वारा पूछा गया कि क्या यह संभव था एक साजिश आर का उपयोग कर नीचे एक के समान बनाना geom_polygon को कस्टम छवि जोड़ना:ggplot

enter image description here इस से this paper....

सामान इस तरह की है मेरी विशेषता नहीं है, लेकिन निम्नलिखित कोड का उपयोग करके मैं 95% सीआई इलिप्स बनाने और geom_polygon() के साथ साजिश करने में सक्षम था। मैंने 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() 

निम्नलिखित में से कौन देता है:

enter image description here

यह ठीक है, लेकिन क्या मैं वास्तव में क्या करना चाहते हैं geom_polygon की 'भरने' कमांड के लिए सीधे एक छवि जोड़ना है। क्या यह संभव है ?

+2

मुझे लगता है आधिकारिक उत्तर "यह संभव नहीं है" ([हैडली का जवाब] (http://stackoverflow.com/a/2901210/1900149))। हालांकि, @baptiste [यहां] द्वारा एक और हालिया जवाब है (http://stackoverflow.com/questions/26110160/how-to-apply-cross-hatching-to-a-polygon-using-the-grid- graphical- प्रणाली) जो सहायक साबित हो सकती है। – tonytonov

+0

यह वह नहीं है जो आप पूछ रहे हैं, लेकिन "सही नौकरी के लिए सही उपकरण" की भावना में: मैं इसके पीछे डेटा के साथ आर में अंतर्निहित ग्राफ बनाउंगा। इसके बाद मैं फ़ोटोशॉप का उपयोग करता हूं, या यह मुफ्त, खुले स्रोत के समतुल्य समतुल्य [जीआईएमपी] (http://www.gimp.org/) का उपयोग करेगा। फिर विभिन्न परतें बनाएं और अंडाकार आकार के माध्यम से अपनी पारदर्शिता समायोजित करें। –

उत्तर

12

हम 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 साथ data.frame में एक रास्टर चित्र परिवर्तित करना चाहते हैं, color तो हम बाद में इसे 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() 

enter image description here

हम आसानी से कोड में बदलाव किए बिना भूखंड का आकार परिवर्तन कर सकते हैं।

enter image description here

enter image description here

और, ज़ाहिर है, आप अपने मशीन के मन प्रदर्शन क्षमताओं में रखना चाहिए, और, शायद, अपने ggplot अंदर की साजिश रचने के लिए 20MP चित्रों का चयन नहीं =)

+0

वाह! मैं इस धागे का पीछा कर रहा हूं और जब से मैंने पहली बार सवाल उठाया - यह सुनिश्चित नहीं था कि हमें जवाब मिलेगा। धन्यवाद! 'Point.in.polygon' फ़ंक्शन से प्यार करें। ! – jalapic

-4
#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) 
+0

मुझे सामग्री के बारे में निश्चित नहीं है, लेकिन इसे फ़ॉर्मेटिंग की आवश्यकता है। –

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

(छवियों "यादृच्छिक" कर रहे हैं विकीमीडिया पर मिली छवियां, इस अवसर के लिए नामित)

यहां मैंने बस प्रत्येक समूह (लेख में) के अर्थ पर छवि केंद्रित की और मानक विचलन के लिए अपना आकार आनुपातिक बना दिया। लेख में उपयोग किए गए 95% आत्मविश्वास अंतराल को फिट करना मुश्किल नहीं होगा।

यह बिल्कुल नहीं की जरूरत परिणाम लेकिन यह करने के लिए काफी आसान है (हालांकि मैं और अधिक के रूप में @Mike द्वारा सुझाए गए जिम्प समाधान करने के लिए जाना यदि आप वास्तव में अंडाकार करने के लिए अपनी छवि को फिट करने के लिए चाहते हो जाएगा,)

imageRaster