Затенение графика плотности ядра между двумя точками.

Question

Я часто использую графики плотности ядра, чтобы проиллюстрировать распределения. Они легко и быстро создать в R следующим образом:

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

Который дает мне этот миленький PDF:

я хотел бы тень площади под PDF с 75-я до 95-го процентиля. Это легко вычислить точки, используя quantile функцию:

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

Но как я затенять область между q75 и q95?

Answer 1

С помощью функции polygon() см. Справочную страницу, и я считаю, что у нас были и подобные вопросы.

Чтобы получить фактические пары (x,y), вам нужно найти индекс значений квантиля.

Edit: Здесь вы идете:

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. Вот очень простой один, просто адаптируя метод, примененный на Dirk и другие:

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