内核密度估计器(KDE)产生的分布是内核分布的位置混合,因此要从内核密度估计中得出一个值,您需要做的就是(1)从内核密度中得出一个值,然后(2)独立地随机选择一个数据点,并将其值加到(1)的结果中。
这是此过程应用于问题中的数据集的结果。
左侧的直方图描述了样本。作为参考,黑色曲线绘制了从中抽取样品的密度。红色曲线绘制了样品的KDE(使用窄带宽)。(红色峰值比黑色峰值短是没有问题的,甚至是出乎意料的:KDE分散了所有内容,因此峰值会变得更低以进行补偿。)
右侧的直方图描绘了来自KDE的样本(大小相同)。 黑色和红色曲线与以前相同。
显然,用于从密度采样的程序起作用。它的速度也非常快:R
下面的实现每秒可以从任何KDE生成数百万个值。我对它进行了评论,以协助移植到Python或其他语言。采样算法本身是通过以下代码在函数中实现rdens
的
rkernel <- function(n) rnorm(n, sd=width)
sample(x, n, replace=TRUE) + rkernel(n)
rkernel
提请n
独立同分布样本内核函数,同时sample
吸引n
来自数据替换样本x
。“ +”运算符逐个分量地添加两个样本数组。
ķFķx =( x1个,X2,… ,xñ)
FX^;ķ(x)=1n∑i=1nFK(x−xi).
Xxi1/niYX+YxX
FX+ Y(x )= Pr (X+ Y≤ X )= ∑我= 1ñPR (X+ Y≤ X | X= x一世)Pr (X= x一世)= ∑我= 1ñPR (X一世+ Y≤ X )1ñ= 1ñ∑我= 1ñ镨(ÿ≤ X - X一世)= 1ñ∑我= 1ñFķ(x − x一世)= FX^;ķ(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))