দুটি পয়েন্টের মধ্যে কার্নেল ঘনত্বের প্লট শেড করা।


97

আমি প্রায়শই বিতরণ চিত্রিত করতে কার্নেল ঘনত্ব প্লট ব্যবহার করি। এগুলি আর এর মতো তৈরি করা সহজ এবং দ্রুত are

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

যা আমাকে এই সুন্দর সামান্য পিডিএফ দেয়:

এখানে চিত্র বর্ণনা লিখুন

আমি পিডিএফের নীচে area৫ তম থেকে 95 তম পার্সেন্টাইল পর্যন্ত অঞ্চলটি ছায়াযুক্ত করতে চাই। quantileফাংশনটি ব্যবহার করে পয়েন্টগুলি গণনা করা সহজ :

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

কিন্তু কিভাবে আমি আলোছায়া মধ্যে এলাকায় কি q75এবং q95?


আপনি কি আপনার সীমার বাইরে বনামের বাইরে ছায়াযুক্তের উদাহরণ সরবরাহ করতে পারেন? ধন্যবাদ
মিল্কট্রেডার

উত্তর:


76

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

আউটপুট (জেডিএল দ্বারা যুক্ত)

এখানে চিত্র বর্ণনা লিখুন


4
যদি আপনি কাঠামোটি না দিয়ে থাকেন তবে আমি কাজ করতে পারতাম না। ধন্যবাদ!
জেডি লং

4
এটি সেই জিনিসগুলির মধ্যে একটি ... যা demo(graphics)ভোর হওয়ার আগে থেকেই ঠিক সময়ে ঘটেছিল তাই এখনই প্রতিটি সময়ে আসে।
এনবিইআর

4
ওহহহ আমি জানতাম যে আমি এটি কোথাও দেখেছি কিন্তু আমার মানসিক সূচকটি আমি যেখানে দেখেছি তা থেকে টানতে পারি না। আমি আনন্দিত যে আপনার মানসিক সূচকটি আমার চেয়ে ভাল।
জেডি লং

72

আরেকটি সমাধান:

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)

ফলাফল:

বিকল্প পাঠ


22

একটি বর্ধিত সমাধান:

যদি আপনি উভয় লেজকে ছায়া দিতে চান (ডার্কের কোডের অনুলিপি এবং পেস্ট করুন) এবং জানা এক্স মানগুলি ব্যবহার করুন:

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

ফলাফল:

2-লেজযুক্ত পলি


আমার কাছে পিএনজি ফাইল রয়েছে এবং এটি ফ্রিমেজহোস্টিংয়ে হোস্ট করা হয়েছে এবং এটি সম্ভবত লোড হচ্ছে না কারণ ... আমি নিশ্চিত নই।
মিল্কট্রেডার

খুব ঝাপসা ফাইল। আপনি দয়া করে এটি পুনরায় তৈরি করতে এবং এটি এখানে সরাসরি আপলোড করতে পারেন এর জন্য এর নিজস্ব সার্ভার পরিষেবা আছে?
ডার্ক এডেলবুয়েটেল

আমি দুঃখিত, তবে কীভাবে এটি সরাসরি SO এ আপলোড করতে হয় তা আমি দেখতে পাচ্ছি না।
মিল্কট্রেডার

19

এই প্রশ্নের 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))

এখানে চিত্র বর্ণনা লিখুন


3

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

ডিপেক্স প্যাকেজ (v0.2.0) দ্বারা 2018-07-13 এ তৈরি হয়েছিল ।

আমাদের সাইট ব্যবহার করে, আপনি স্বীকার করেছেন যে আপনি আমাদের কুকি নীতি এবং গোপনীয়তা নীতিটি পড়েছেন এবং বুঝতে পেরেছেন ।
Licensed under cc by-sa 3.0 with attribution required.