दो बिंदुओं के बीच एक कर्नेल घनत्व साजिश छायांकन।

Question

मैं वितरण को चित्रित करने के लिए अक्सर कर्नेल घनत्व भूखंडों का उपयोग करता हूं।

मैं 75 वीं से पीडीएफ के नीचे छाया क्षेत्र करना चाहते हैं:

set.seed(1) 
draws <- rnorm(100)^2 
dens <- density(draws) 
plot(dens) 
#or in one line like this: plot(density(rnorm(100)^2)) 

कौन मुझे इस अच्छी छोटी पीडीएफ देता है: ये आसान और तेजी से तो जैसे आर में बनाने के लिए कर रहे हैं 95 वें प्रतिशत तक। यह quantile फ़ंक्शन का उपयोग अंक की गणना करना आसान है:

q75 <- quantile(draws, .75) 
q95 <- quantile(draws, .95) 

लेकिन मैं कैसे छाया q75 और q95 के बीच के क्षेत्र करते हैं?

Answer 1

polygon() फ़ंक्शन के साथ, इसका सहायता पृष्ठ देखें और मेरा मानना ​​है कि हमारे यहां भी इसी तरह के प्रश्न थे।

वास्तविक (x,y) जोड़े प्राप्त करने के लिए आपको मात्रात्मक मानों की अनुक्रमणिका ढूँढने की आवश्यकता है।

संपादित करें: ये रहा:

x1 <- min(which(dens$x >= q75)) 
x2 <- max(which(dens$x < q95)) 
with(dens, polygon(x=c(x[c(x1,x1:x2,x2)]), y= c(0, y[x1:x2], 0), col="gray")) 

आउटपुट (JDL से जोड़ा)

Answer 2

एक अन्य समाधान:

dd <- with(dens,data.frame(x,y)) 
library(ggplot2) 
qplot(x,y,data=dd,geom="line")+ 
    geom_ribbon(data=subset(dd,x>q75 & x<q95),aes(ymax=y),ymin=0, 
       fill="red",colour=NA,alpha=0.5) 

परिणाम:

Answer 3

एक विस्तारित समाधान:

यदि आप छाया चाहता था दोनों पूंछ (एक प्रकार की कटार के कोड की & पेस्ट कॉपी) और ज्ञात एक्स मूल्यों का उपयोग करें:

set.seed(1) 
draws <- rnorm(100)^2 
dens <- density(draws) 
plot(dens) 

q2  <- 2 
q65 <- 6.5 
qn08 <- -0.8 
qn02 <- -0.2 

x1 <- min(which(dens$x >= q2)) 
x2 <- max(which(dens$x < q65)) 
x3 <- min(which(dens$x >= qn08)) 
x4 <- max(which(dens$x < qn02)) 

with(dens, polygon(x=c(x[c(x1,x1:x2,x2)]), y= c(0, y[x1:x2], 0), col="gray")) 
with(dens, polygon(x=c(x[c(x3,x3:x4,x4)]), y= c(0, y[x3:x4], 0), col="gray")) 

परिणाम:

Answer 4

इस प्रश्न को lattice उत्तर की आवश्यकता है।

#Set up the data 
set.seed(1) 
draws <- rnorm(100)^2 
dens <- density(draws) 

#Put in a simple data frame 
d <- data.frame(x = dens$x, y = dens$y) 

#Define a custom panel function; 
# Options like color don't need to be hard coded  
shadePanel <- function(x,y,shadeLims){ 
    panel.lines(x,y) 
    m1 <- min(which(x >= shadeLims[1])) 
    m2 <- max(which(x <= shadeLims[2])) 
    tmp <- data.frame(x1 = x[c(m1,m1:m2,m2)], y1 = c(0,y[m1:m2],0)) 
    panel.polygon(tmp$x1,tmp$y1,col = "blue") 
} 

#Plot 
xyplot(y~x,data = d, panel = shadePanel, shadeLims = c(1,3))