如何在Caret包中为kNN模型创建决策边界图？

Question

我想为Caret包创建的模型绘制决策边界.理想情况下,我想从Caret的任何分类器模型的一般案例方法.但是,我目前正在使用kNN方法.我在下面的代码中使用了UCI的葡萄酒质量数据集,这是我现在正在使用的.

我发现这种方法适用于R中的通用kNN方法,但无法弄清楚如何将其映射到Caret - > https://stats.stackexchange.com/questions/21572/how-to-plot-decision-边界的-AK近邻分类器从元素O/21602#21602

    library(caret)

    set.seed(300)

    wine.r <- read.csv('https://archive.ics.uci.edu/ml/machine-learning-databases/wine-quality/winequality-red.csv', sep=';')
    wine.w <- read.csv('https://archive.ics.uci.edu/ml/machine-learning-databases/wine-quality/winequality-white.csv', sep=';')

    wine.r$style <- "red"
    wine.w$style <- "white"

    wine <- rbind(wine.r, wine.w)

    wine$style <- as.factor(wine$style)

    formula <- as.formula(quality ~ .)

    dummies <- dummyVars(formula, data = wine)
    dummied <- data.frame(predict(dummies, newdata = wine))
    dummied$quality <- wine$quality

    wine <- dummied

    numCols <- !colnames(wine) %in% c('quality', 'style.red', 'style.white')

    low <- wine$quality <= 6
    high <- wine$quality > 6
    wine$quality[low] = "low"
    wine$quality[high] = "high"
    wine$quality <- as.factor(wine$quality)

    indxTrain <- createDataPartition(y = wine[, names(wine) == "quality"], p = 0.7, list = F)

    train <- wine[indxTrain,]
    test <- wine[-indxTrain,]

    corrMat <- cor(train[, numCols])
    correlated <- findCorrelation(corrMat, cutoff = 0.6)

    ctrl <- trainControl(
                         method="repeatedcv",
                         repeats=5,
                         number=10,
                         classProbs = T
                         )

    t1 <- train[, -correlated]
    grid <- expand.grid(.k = c(1:20))

    knnModel <- train(formula, 
                      data = t1, 
                      method = 'knn', 
                      trControl = ctrl, 
                      tuneGrid = grid, 
                      preProcess = 'range'
                      )

    t2 <- test[, -correlated]
    knnPred <- predict(knnModel, newdata = t2)

    # How do I render the decision boundary?

Answer 1

第一步是真正了解您链接的代码正在做什么!实际上,您可以生成这样的图形,而与KNN无关.

例如,我们只需要一些示例数据,我们只是"着色"数据的下象限.

步骤1

生成网格.基本上图形的工作方式是在每个坐标处创建一个点,以便我们知道它属于哪个组.在R中,这是expand.grid用来遍历所有可能的点.

x1 <- 1:200
x2 <- 50:250

cgrid <- expand.grid(x1=x1, x2=x2)
# our "prediction" colours the bottom left quadrant
cgrid$prob <- 1
cgrid[cgrid$x1 < 100 & cgrid$x2 < 170, c("prob")] <- 0

如果这是knn,那将是prob对该特定点的预测.

第2步

现在绘制它是相对简单的.您需要符合该contour功能,因此首先要创建一个包含概率的矩阵.

matrix_val <- matrix(cgrid$prob, 
                     length(x1), 
                     length(x2))

第3步

然后你可以像链接那样继续:

contour(x1, x2, matrix_val, levels=0.5, labels="", xlab="", ylab="", main=
          "Some Picture", lwd=2, axes=FALSE)
gd <- expand.grid(x=x1, y=x2)
points(gd, pch=".", cex=1.2, col=ifelse(prob==1, "coral", "cornflowerblue"))
box()

输出:

那么回到你的特定例子.我将使用虹膜,因为您的数据看起来不是很有趣,但同样的原则也适用.要创建网格,您需要选择xy轴并保留其他所有内容!

knnModel <- train(Species ~., 
                  data = iris, 
                  method = 'knn')

lgrid <- expand.grid(Petal.Length=seq(1, 5, by=0.1), 
                     Petal.Width=seq(0.1, 1.8, by=0.1),
                     Sepal.Length = 5.4,
                     Sepal.Width=3.1)

接下来,只需使用上面所做的预测功能.

knnPredGrid <- predict(knnModel, newdata=lgrid)
knnPredGrid = as.numeric(knnPredGrid) # 1 2 3

然后构建图:

pl = seq(1, 5, by=0.1)
pw = seq(0.1, 1.8, by=0.1)

probs <- matrix(knnPredGrid, length(pl), 
                 length(pw))

contour(pl, pw, probs, labels="", xlab="", ylab="", main=
          "X-nearest neighbour", axes=FALSE)

gd <- expand.grid(x=pl, y=pw)

points(gd, pch=".", cex=5, col=probs)
box()   

这应该产生这样的输出:

要从模型中添加测试/训练结果,您可以按照我的方式进行操作.唯一的区别是您需要添加预测点(这与用于生成边界的网格不同.

library(caret) 
data(iris)

indxTrain <- createDataPartition(y = iris[, names(iris) == "Species"], p = 0.7, list = F)

train <- iris[indxTrain,]
test <- iris[-indxTrain,]

knnModel <- train(Species ~.,
                  data = train,
                  method = 'knn')

pl = seq(min(test$Petal.Length), max(test$Petal.Length), by=0.1)
pw = seq(min(test$Petal.Width), max(test$Petal.Width), by=0.1)

# generates the boundaries for your graph
lgrid <- expand.grid(Petal.Length=pl, 
                     Petal.Width=pw,
                     Sepal.Length = 5.4,
                     Sepal.Width=3.1)

knnPredGrid <- predict(knnModel, newdata=lgrid)
knnPredGrid = as.numeric(knnPredGrid)

# get the points from the test data...
testPred <- predict(knnModel, newdata=test)
testPred <- as.numeric(testPred)
# this gets the points for the testPred...
test$Pred <- testPred

probs <- matrix(knnPredGrid, length(pl), length(pw))

contour(pl, pw, probs, labels="", xlab="", ylab="", main="X-Nearest Neighbor", axes=F)
gd <- expand.grid(x=pl, y=pw)

points(gd, pch=".", cex=5, col=probs)

# add the test points to the graph
points(test$Petal.Length, test$Petal.Width, col=test$Pred, cex=2)
box()

输出:

或者,您可以使用ggplot更简单的图形来执行:

ggplot(data=lgrid) + stat_contour(aes(x=Petal.Length, y=Petal.Width, z=knnPredGrid),
                            bins=2) +
  geom_point(aes(x=Petal.Length, y=Petal.Width, colour=as.factor(knnPredGrid))) +
  geom_point(data=test, aes(x=test$Petal.Length, y=test$Petal.Width, colour=as.factor(test$Pred)),
             size=5, alpha=0.5, shape=1)+
  theme_bw()

输出: