একটি কার্নেল ঘনত্ব অনুমানকারী (কেডিএ) এমন একটি বিতরণ তৈরি করে যা কার্নেল বিতরণের একটি অবস্থান মিশ্রণ, সুতরাং কার্নেলের ঘনত্বের প্রাক্কলন থেকে আপনার প্রয়োজনীয় সমস্ত কিছু (1) কার্নেলের ঘনত্ব থেকে একটি মান আঁকুন এবং তারপরে (2) স্বাধীনভাবে এলোমেলোভাবে ডেটা পয়েন্টগুলির একটি নির্বাচন করুন এবং এর ফলাফলটি (1) এর সাথে যুক্ত করুন।
প্রশ্নটির মতো একটি ডেটাসেটে প্রয়োগ করা এই পদ্ধতির ফলাফল এখানে।
বামদিকে হিস্টোগ্রামে নমুনা চিত্রিত হয়েছে। রেফারেন্সের জন্য, কালো বক্ররেখা ঘনত্বকে প্লট করে যা থেকে নমুনাটি আঁকানো হয়েছিল। লাল বক্ররেখা নমুনার কে.ডি. প্লট করে (সংকীর্ণ ব্যান্ডউইথ ব্যবহার করে)। (এটি কোনও সমস্যা নয় এমনকি অপ্রত্যাশিতও নয় যে, লাল শিখরগুলি কালো শৃঙ্গগুলির চেয়ে সংক্ষিপ্ত: কে-ডি-কে জিনিসগুলি ছড়িয়ে দেয়, তাই শিখরগুলি ক্ষতিপূরণ দিতে কম হবে))
ডান দিকের হিস্টোগোমে কেডিএর থেকে একটি নমুনা (একই আকারের) চিত্রিত করা হয়েছে । কালো এবং লাল বক্ররেখা আগের মতই।
স্পষ্টতই, ঘনত্ব থেকে নমুনার জন্য ব্যবহৃত পদ্ধতিটি কাজ করে। এটি অত্যন্ত চূড়ান্ত: R
নীচের প্রয়োগটি যে কোনও কেডি থেকে প্রতি সেকেন্ডে কয়েক মিলিয়ন মান উৎপন্ন করে। পাইথন বা অন্যান্য ভাষায় পোর্টিংয়ে সহায়তা করার জন্য আমি এটির পক্ষে প্রচুর মন্তব্য করেছি mented স্যাম্পলিং অ্যালগরিদম নিজেই rdens
লাইনগুলি সহ ফাংশনে প্রয়োগ করা হয়
rkernel <- function(n) rnorm(n, sd=width)
sample(x, n, replace=TRUE) + rkernel(n)
rkernel
স্বপক্ষে n
কার্নেল ফাংশন থেকে IID নমুনা যখন sample
স্বপক্ষে n
তথ্য থেকে প্রতিস্থাপন সঙ্গে নমুনা x
। "+" অপারেটর উপাদান দ্বারা নমুনা উপাদানগুলির দুটি অ্যারে যুক্ত করে।
KFKx=(x1,x2,…,xn)
Fx^;K(x)=1n∑i=1nFK(x−xi).
Xxi1/niYX+YxX
FX+Y(x)=Pr(X+Y≤x)=∑i=1nPr(X+Y≤x∣X=xi)Pr(X=xi)=∑i=1nPr(xi+Y≤x)1n=1n∑i=1nPr(Y≤x−xi)=1n∑i=1nFK(x−xi)=Fx^;K(x),
যেমন দাবি করা হয়েছে
#
# Define a function to sample from the density.
# This one implements only a Gaussian kernel.
#
rdens <- function(n, density=z, data=x, kernel="gaussian") {
width <- z$bw # Kernel width
rkernel <- function(n) rnorm(n, sd=width) # Kernel sampler
sample(x, n, replace=TRUE) + rkernel(n) # Here's the entire algorithm
}
#
# Create data.
# `dx` is the density function, used later for plotting.
#
n <- 100
set.seed(17)
x <- c(rnorm(n), rnorm(n, 4, 1/4), rnorm(n, 8, 1/4))
dx <- function(x) (dnorm(x) + dnorm(x, 4, 1/4) + dnorm(x, 8, 1/4))/3
#
# Compute a kernel density estimate.
# It returns a kernel width in $bw as well as $x and $y vectors for plotting.
#
z <- density(x, bw=0.15, kernel="gaussian")
#
# Sample from the KDE.
#
system.time(y <- rdens(3*n, z, x)) # Millions per second
#
# Plot the sample.
#
h.density <- hist(y, breaks=60, plot=FALSE)
#
# Plot the KDE for comparison.
#
h.sample <- hist(x, breaks=h.density$breaks, plot=FALSE)
#
# Display the plots side by side.
#
histograms <- list(Sample=h.sample, Density=h.density)
y.max <- max(h.density$density) * 1.25
par(mfrow=c(1,2))
for (s in names(histograms)) {
h <- histograms[[s]]
plot(h, freq=FALSE, ylim=c(0, y.max), col="#f0f0f0", border="Gray",
main=paste("Histogram of", s))
curve(dx(x), add=TRUE, col="Black", lwd=2, n=501) # Underlying distribution
lines(z$x, z$y, col="Red", lwd=2) # KDE of data
}
par(mfrow=c(1,1))