Che khuất mật độ hạt nhân giữa hai điểm.

Question

Tôi thường xuyên sử dụng các ô mật độ hạt nhân để minh họa các bản phân phối. Đây là những dễ dàng và nhanh chóng để tạo ra trong R như vậy:

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

nào mang lại cho tôi này tốt đẹp chút PDF:

Tôi muốn bóng râm diện tích dưới PDF từ 75 đến phần trăm thứ 95. Thật dễ dàng để tính điểm bằng cách sử dụng chức năng quantile:

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

Nhưng làm cách nào để che khu vực giữa q75 và q95?

Answer 1

Với chức năng polygon(), xem trang trợ giúp của nó và tôi tin rằng chúng tôi cũng có câu hỏi tương tự ở đây.

Bạn cần phải tìm chỉ mục của các giá trị định lượng để nhận được các cặp (x,y) thực tế.

Edit: Ở đây bạn đi:

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

Output (bổ sung bởi JDL)

Answer 2

Một giải pháp:

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) 

Kết quả:

Answer 3

Một giải pháp mở rộng:

Nếu bạn muốn bóng râm cả đuôi (sao chép & dán mã Dirk) và sử dụng tiếng x giá trị:

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

Kết quả:

Answer 4

Câu hỏi này cần câu trả lời lattice. Dưới đây là một rất cơ bản, chỉ cần thích nghi với các phương pháp được sử dụng bởi Dirk và những người khác:

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