दो बिंदुओं के बीच कर्नेल घनत्व प्लॉट को शेड करना।

Question

मैं अक्सर वितरण को चित्रित करने के लिए कर्नेल घनत्व प्लॉट का उपयोग करता हूं। ये आर की तरह बनाने में आसान और तेज़ हैं:

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

जो मुझे इस छोटे से पीडीएफ देता है:

मैं पीडीएफ के तहत क्षेत्र को 75 वें से 95 प्रतिशत तक छाया देना चाहता हूं। quantileफ़ंक्शन का उपयोग करके अंक की गणना करना आसान है :

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

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

Comments

क्या आप अपनी सीमा के बाहर बनाम अपनी सीमा के अंदर छायांकन का उदाहरण प्रदान कर सकते हैं? धन्यवाद।

— मिल्कट्रैडर

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 द्वारा जोड़ा गया)

Comments

मैंने कभी यह काम नहीं किया होगा कि यदि आपने संरचना प्रदान नहीं की है। धन्यवाद!

— JD लॉन्ग

यह उन चीजों में demo(graphics)से एक है ... जो समय से पहले भोर में हुई हैं, इसलिए अब हर एक के पार आता है। NBER रिग्रेशन शेडिंग आदि के लिए समान विचार

— डिर्क एडल्डबुलेटेल

ओह। I KNEW मैंने इसे कहीं देखा था लेकिन अपने मानसिक सूचकांक से नहीं खींच पाया जहाँ मैंने इसे देखा था। मुझे खुशी है कि आपका मानसिक सूचकांक मेरी तुलना में बेहतर है।

— जेडी लॉन्ग

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

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

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

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

परिणाम:

Comments

मेरे पास png फ़ाइल है और इसे freeimagehosting पर होस्ट किया है, और यह लोड नहीं हो रहा है क्योंकि ... मुझे यकीन नहीं है।

— मिल्कट्रैडर

बहुत धुंधली फाइल। क्या आप कृपया इसे पुनः बना सकते हैं और इसे यहाँ अपलोड कर सकते हैं, इसलिए SO के पास इसके लिए स्वयं की सर्वर सेवा है?

— डिर्क एडल्डबुलेटेल

मुझे खेद है, लेकिन मैं इसे एसओ को सीधे अपलोड करने का तरीका नहीं देख सकता।

— मिल्कट्रैडर

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

Answer 5

यहां एक अन्य ggplot2संस्करण है जो एक फ़ंक्शन पर आधारित है जो मूल डेटा मानों में कर्नेल घनत्व का अनुमान लगाता है:

approxdens <- function(x) {
    dens <- density(x)
    f <- with(dens, approxfun(x, y))
    f(x)
}

मूल डेटा का उपयोग करना (घनत्व अनुमान के x और y मानों के साथ एक नया डेटा फ़्रेम का उत्पादन करने के बजाय) के लाभ की योजना है, जिसमें डेटासेट मान उन परिवर्तनीय प्लॉटों पर काम कर रहे हैं, जहां डेटा को समूहीकृत किया जा रहा है:

कोड का इस्तेमाल किया

library(tidyverse)
library(RColorBrewer)

# dummy data
set.seed(1)
n <- 1e2
dt <- tibble(value = rnorm(n)^2)

# function that approximates the density at the provided values
approxdens <- function(x) {
    dens <- density(x)
    f <- with(dens, approxfun(x, y))
    f(x)
}

probs <- c(0.75, 0.95)

dt <- dt %>%
    mutate(dy = approxdens(value),                         # calculate density
           p = percent_rank(value),                        # percentile rank 
           pcat = as.factor(cut(p, breaks = probs,         # percentile category based on probs
                                include.lowest = TRUE)))

ggplot(dt, aes(value, dy)) +
    geom_ribbon(aes(ymin = 0, ymax = dy, fill = pcat)) +
    geom_line() +
    scale_fill_brewer(guide = "none") +
    theme_bw()



# dummy data with 2 groups
dt2 <- tibble(category = c(rep("A", n), rep("B", n)),
              value = c(rnorm(n)^2, rnorm(n, mean = 2)))

dt2 <- dt2 %>%
    group_by(category) %>% 
    mutate(dy = approxdens(value),    
           p = percent_rank(value),
           pcat = as.factor(cut(p, breaks = probs,
                                include.lowest = TRUE)))

# faceted plot
ggplot(dt2, aes(value, dy)) +
    geom_ribbon(aes(ymin = 0, ymax = dy, fill = pcat)) +
    geom_line() +
    facet_wrap(~ category, nrow = 2, scales = "fixed") +
    scale_fill_brewer(guide = "none") +
    theme_bw()

2018-07-13 को रेप्रेक्स पैकेज ( v0.2.0 ) द्वारा बनाया गया ।