r - 如何在 R 中用网格绘制非线性决策边界？

Question

我在 ISLR 中找到了这个特定的图表( Figure 2.13 ) 或 ESL做得太好了。我无法猜测作者是如何在 R 中做到这一点的。我知道如何非常轻松地获得橙色和蓝色的点。主要的混淆是背景点和紫色线。

有什么想法吗？

这里是一些示例代码，用于获取带有灰色网格的黄色和橙色点。如何得到一条紫色的任意非线性曲线，然后根据曲线给网格上色？

set.seed(pi)
points = replicate(100, runif(2))
pointsColored = ifelse(apply(points, 2, sum) <= 1, "orange", "blue")
# Confound some
pointsColored[sample.int(length(pointsColored), 10)] = "orange"
plot(x=points[1, ], y=points[2, ])
grid(nx=100, ny=100)
# Plot points over the grid.
points(x=points[1, ], y=points[2, ], col=pointsColored)

Answer 1

正如我在评论中指出的那样，@chl here 提供了解决方案在 stats.stackexchange.com 上。在这里，应用于您的数据集。

library(class)
set.seed(pi)
X <- t(replicate(1000, runif(2)))
g <- ifelse(apply(X, 1, sum) <= 1, 0, 1)
xnew <- cbind(rep(seq(0, 1, length.out=50), 50),
              rep(seq(0, 1, length.out=50), each=50))
m <- knn(X, xnew, g, k=15, prob=TRUE)
prob <- attr(m, "prob")
prob <- ifelse(m=="1", prob, 1-prob)
prob15 <- matrix(prob, 50)
par(mar=rep(3, 4))
contour(unique(xnew[, 1]), unique(xnew[, 2]), prob15, levels=0.5, 
        labels="", xlab='', ylab='', axes=FALSE, lwd=2.5, asp=1)
title(xlab=expression(italic('X')[1]), ylab=expression(italic('X')[2]), 
      line=1, family='serif', cex.lab=1.5)
points(X, bg=ifelse(g==1, "#CA002070", "#0571B070"), pch=21)
gd <- expand.grid(x=unique(xnew[, 1]), y=unique(xnew[, 2]))
points(gd, pch=20, cex=0.4, col=ifelse(prob15 > 0.5, "#CA0020", "#0571B0"))
box()

(更新:我更改了调色板，因为蓝色/黄色/紫色的东西非常丑陋。)