如何執行引導程序以找到 R 中 k-nn 模型的置信區間？

Question

我有一個帶有 2 列的訓練 df，例如

   a     b
1  1000  20
2  1008  13
...
n  ...   ...

現在，因為我需要根據特定的 'a' 值找到 95% 的 CI 來估計 'b'，我選擇了一個 'k' 值，並將 CI 結果與其他特定的 'k' 值進行比較。 我的問題是如何使用 1000 個引導程序代表執行引導程序，因為我需要使用適合的 knn 模型來訓練數據， kernel = 'gaussian' 並且 k 只能在 1-20 范圍內？ 我發現這個模型的最佳 k 是 k = 5，並且嘗試了引導程序，但它不起作用

library(kknn)
library(boot)

boot.kn = function(formula, data, indices)
{
  # Create a bootstrapped version
  d = data[indices,]
  
  # Fit a model for bs
  fit.kn =  fitted(train.kknn(formula,data, kernel= "gaussian", ks = 5))
  
  # Do I even need this complicated block
  target = as.character(fit.kn$terms[[2]])
  rv = my.pred.stats(fit.kn, d[,target])
  return(rv)
}
bs = boot(data=df, statistic=boot.kn, R=1000, formula=b ~ a)
boot.ci(bs,conf=0.95,type="bca")

如果我不夠清楚，請告訴我更多信息。 謝謝你。

Answer 1

這里是一個辦法倒退b上a與最近鄰居法。

首先是一組數據。 這是iris數據集的子集，保留前兩列。 一行被刪除到后者是新數據。

i <- which(iris$Sepal.Length == 5.3)
df1 <- iris[-i, 1:2]
newdata <- iris[i, 1:2]
names(df1) <- c("a", "b")
names(newdata) <- c("a", "b")

現在加載要使用的包並使用包kknn確定k的最佳值。

library(caret)
library(kknn)
library(boot)

fit <- kknn::train.kknn(
  formula = b ~ a,
  data = df1,
  kmax = 15,
  kernel = "gaussian",
  distance = 1
)
k <- fit$best.parameters$k
k
#[1] 9

以及對新點a <- 5.3引導預測。

boot.kn <- function(data, indices, formula, newdata, k){
  d <- data[indices, ]
  fit <- knnreg(formula, data = d)
  predict(fit, newdata = newdata)
}

set.seed(2021)
R <- 1e4
bs <- boot(df1, boot.kn, R = R, formula = b ~ a, newdata = newdata, k = k)
ci <- boot.ci(bs, level = 0.95, type = "bca")

ci
#BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
#Based on 10000 bootstrap replicates
#
#CALL : 
#boot.ci(boot.out = bs, type = "bca", level = 0.95)
#
#Intervals : 
#Level       BCa          
#95%   ( 3.177,  3.740 )  
#Calculations and Intervals on Original Scale

繪制結果。

old_par <- par(mfrow = c(2, 1),
               oma = c(5, 4, 0, 0) + 0.1,
               mar = c(1, 1, 1, 1) + 0.1)

hist(bs$t, main = "Histogram of bootstrap values")
abline(v = 3.7, col = "red")
abline(v = mean(bs$t), col = "blue")
abline(v = ci$bca[4:5], col = "blue", lty = "dashed")

plot(b ~ a, df1)
points(5.3, 3.7, col = "red", pch = 19)
points(5.3, mean(bs$t), col = "blue", pch = 19)
arrows(x0 = 5.3, y0 = ci$bca[4],
       x1 = 5.3, y1 = ci$bca[5],
       col = "blue", angle = 90, code = 3)

par(old_par)