高斯 kernel R 中的密度估計

Question

我無法理解如何在 R 中實現以下數據集的高斯 kernel 密度估計。如果你能幫助我理解如何做的機制，我將不勝感激。 我目前正在嘗試獲得下圖底部鍾形曲線的公式。 如您所見，每個數據點都有一個鍾形曲線。 （注意圖片不代表我使用的數據。）

這是我的數據：

x<-c(4.09, 4.46, 4.61, 4.30, 4.03, 5.22, 4.21, 4.07, 4.02, 4.58, 4.66, 4.05, 4.23, 5.51, 4.03, 4.72, 4.47, 4.50, 5.80, 4.30, 4.09, 4.78, 4.18, 4.45, 4.40, 5.60, 4.37, 4.42, 4.88, 4.20, 4.45, 4.10, 4.43, 4.58, 4.40, 4.38) （x 有 36 個元素）

這是 kernel 密度估計器：

（如果你看不到圖像，它來自這個頁面http://sfb649.wiwi.hu-berlin.de/fedc_homepage/xplore/tutorials/xlghtmlnode33.html ）

其中 K(u)=

是高斯 kernel function 並且 h=.1516 是 Scott 選擇的帶寬。

所以，插入我們得到 f hat (x) = 1/(36*.1516) (1/sqrt(2pi))[e^(-1/2 ((4.09-x)/.1516)^2 + e ^(-1/2 ((4.46-x)/.1516)^2 +... + e^(-1/2 ((4.38-x)/.1516)^2]

行。 所以我們有 x 的 function。 但是我們如何得到上圖中每條鍾形曲線的方程呢？ 例如，如果我們將 4.09 代入 f hat (x)，我們會得到一個數字，而不是曲線/函數/分布。 有人可以幫我理解找到鍾形曲線/核密度估計方程的過程嗎？

Answer 1

這是一個 function，它會根據你的x值和h值返回你的 fhat function

get_fhat <- function(x, h) {
  Vectorize(function(z) 1/length(x)/h*sum(dnorm((x-z)/h)))  
}

這個 function 返回一個 function，我們可以用它來獲取值。 我們對其進行Vectorize ，以便我們可以一次將多個值傳遞給 function。

我們可以獲得單個值或 plot 它

fhat <- get_fhat(x, .1516)
fhat(4.09)
# [1] 0.9121099
curve(fhat, from=min(x), to=max(x))

Answer 2

圖形

## Given data
x  <- c(4.09, 4.46, 4.61, 4.30, 4.03, 5.22, 4.21, 4.07, 4.02, 4.58, 4.66, 4.05, 
        4.23, 5.51, 4.03, 4.72, 4.47, 4.50, 5.80, 4.30, 4.09, 4.78, 4.18, 4.45, 
        4.40, 5.60, 4.37, 4.42, 4.88, 4.20, 4.45, 4.10, 4.43, 4.58, 4.40, 4.38)
h  <- 0.1516 

# GaussianKernel
GK <- function(u) {(1/sqrt(2*pi))*exp(-(u^2)/2)} # or dnorm(u)

這個 function 給出了類似的 plot。

DensityGraph <- function(x, h){
  n    <- length(x)
  xi   <- seq(min(x) - sd(x), max(x) + sd(x), length.out = 512)
  # fhat without sum since we are interest in the bell shaped curves
  fhat <- sapply(x, function(y){(1/(n*h))*GK((xi - y)/h)})
  # histogram of x
  hist (x, freq = FALSE, nclass = 15, main = "Kernel density with histogram",
        xlab = paste("N = ", n, "   ", "Bandwidth = ", h))
  # add fhat with sum
  lines(xi, rowSums(fhat), lwd = 2)
  # add the bell shaped curves
  apply(fhat, 2, function(j) lines(xi, j, col = 4))
  # show data points
  rug  (x, lwd = 2, col = 2)
}


DensityGraph(x = x, h = 0.05)

藍色鍾形曲線代表 x 的每個數據點

DensityGraph(x = x, h = 0.1516)

與R中內置密度function對比

lines(density(x = x, bw = 0.1516), col = 3, lwd = 2)

每個 x 的 fhat

這個 function 給出了給定特定 x 的 fhat 的值

fhat <- function(x, h, specific_x){
  n    <- length(x)
  xi   <- seq(min(x) - sd(x), max(x) + sd(x), length.out = 512)
  f    <- rowSums(sapply(x, function(y){(1/(n*h))*GK((xi - y)/h)}))
  kde  <- data.frame(xi, fhat = f)
  indx <- which.min(abs(xi - specific_x))
  fx   <- kde[indx, "fhat"]
  list(fx = fx, kde = kde)
}

KernelDensity <- fhat(x = x, h = 0.1516, specific_x = 4.09)
KernelDensity$fx
# [1] 0.9114677
plot(KernelDensity$kde, type  = "l", lwd = 2, xlab = "")
title(xlab = paste("N = ", n, "    Bandwidth = ", h))
rug(x, lwd = 2, col = 2)

比較內置密度 function

lines(density(x, bw = 0.1516), col = 5)