如何从统计学习元素中绘制k最近邻分类器的决策边界?


31

我想生成由Trevor Hastie和Robert Tibshirani和Jerome Friedman撰写的ElemStatLearn书“统计学习的要素:数据挖掘,推理和预测。第二版”中描述的图。情节是:

在此处输入图片说明

我想知道如何在中生成此精确图形R,尤其要注意网格图形和计算以显示边界。



1
@StasK:是的。如何生成情节?你能帮忙吗?非常感谢!
littleEinstein

Answers:


35

要重现此图,您需要在系统上安装ElemStatLearn软件包。人工数据集mixture.example()由@StasK指出。

library(ElemStatLearn)
require(class)
x <- mixture.example$x
g <- mixture.example$y
xnew <- mixture.example$xnew
mod15 <- knn(x, xnew, g, k=15, prob=TRUE)
prob <- attr(mod15, "prob")
prob <- ifelse(mod15=="1", prob, 1-prob)
px1 <- mixture.example$px1
px2 <- mixture.example$px2
prob15 <- matrix(prob, length(px1), length(px2))
par(mar=rep(2,4))
contour(px1, px2, prob15, levels=0.5, labels="", xlab="", ylab="", main=
        "15-nearest neighbour", axes=FALSE)
points(x, col=ifelse(g==1, "coral", "cornflowerblue"))
gd <- expand.grid(x=px1, y=px2)
points(gd, pch=".", cex=1.2, col=ifelse(prob15>0.5, "coral", "cornflowerblue"))
box()

除最后三个命令外,所有命令都来自的在线帮助mixture.example。请注意,我们使用了这样一个事实,expand.grid即将其输出设置为x首先变化,从而进一步允许(按列)索引prob15矩阵(尺寸为69x99)中的颜色,该矩阵保留每个晶格坐标的获胜类的投票比例(px1px2)。

在此处输入图片说明


+1。谢谢!我也想知道如何按照文本“暴露预言”中的描述生成数据。您还可以添加它,而不是使用网站上的数据吗?
littleEinstein 2012年

@littleEinstein您的意思是在线帮助中提供了mixture.example什么?从# Reproducing figure 2.4, page 17 of the book:示例部分开始,查看下面一行的仿真设置。
chl 2012年

能否让我知道链接?我找不到它。
littleEinstein 2012年

抱歉@littleEinstein,但是我可能缺少一些东西。只需键入help(mixture.example)example(mixture.example)在R提示符下(使用加载所需的包后library(ElemStatLearn))即可。生成人工数据集的代码(不生成图2.4)在“示例”部分用普通R编写。
chl 2012年

1
顺便说一句,我刚遇到@Shane的博客,他曾将其ggplot用于类似目的。检查一下:ESL 2.1:线性回归vs. KNN
chl 2012年

7

我正在自学ESL,并尝试完成本书中提供的所有示例。我只是这样做,您可以检查以下R代码:

library(MASS)
# set the seed to reproduce data generation in the future
seed <- 123456
set.seed(seed)

# generate two classes means
Sigma <- matrix(c(1,0,0,1),nrow = 2, ncol = 2)
means_1 <- mvrnorm(n = 10, mu = c(1,0), Sigma)
means_2 <- mvrnorm(n = 10, mu = c(0,1), Sigma)

# pick an m_k at random with probability 1/10
# function to generate observations
genObs <- function(classMean, classSigma, size, ...)
{
  # check input
  if(!is.matrix(classMean)) stop("classMean should be a matrix")
  nc <- ncol(classMean)
  nr <- nrow(classMean)
  if(nc != 2) stop("classMean should be a matrix with 2 columns")
  if(ncol(classSigma) != 2) stop("the dimension of classSigma is wrong")

  # mean for each obs
    # pick an m_k at random
  meanObs <- classMean[sample(1:nr, size = size, replace = TRUE),]
  obs <- t(apply(meanObs, 1, function(x) mvrnorm(n = 1, mu = x, Sigma = classSigma )) )
  colnames(obs) <- c('x1','x2')
  return(obs)
}


obs100_1 <- genObs(classMean = means_1, classSigma = Sigma/5, size = 100)
obs100_2 <- genObs(classMean = means_2, classSigma = Sigma/5, size = 100)

# generate label
y <- rep(c(0,1), each = 100)

# training data matrix
trainMat <- as.data.frame(cbind(y, rbind(obs100_1, obs100_2)))

# plot them
library(lattice)
with(trainMat, xyplot(x2 ~ x1,groups = y, col=c('blue', 'orange')))

# now fit two models

# model 1: linear regression
lmfits <- lm(y ~ x1 + x2 , data = trainMat)

# get the slope and intercept for the decision boundary
intercept <- -(lmfits$coef[1] - 0.5) / lmfits$coef[3]
slope <- - lmfits$coef[2] / lmfits$coef[3]

# Figure 2.1
xyplot(x2 ~ x1, groups = y, col = c('blue', 'orange'), data = trainMat,
       panel = function(...)
       {
        panel.xyplot(...)
        panel.abline(intercept, slope)
        },
       main = 'Linear Regression of 0/1 Response')    

# model2: k nearest-neighbor methods
library(class)
# get the range of x1 and x2
rx1 <- range(trainMat$x1)
rx2 <- range(trainMat$x2)
# get lattice points in predictor space
px1 <- seq(from = rx1[1], to = rx1[2], by = 0.1 )
px2 <- seq(from = rx2[1], to = rx2[2], by = 0.1 )
xnew <- expand.grid(x1 = px1, x2 = px2)

# get the contour map
knn15 <- knn(train = trainMat[,2:3], test = xnew, cl = trainMat[,1], k = 15, prob = TRUE)
prob <- attr(knn15, "prob")
prob <- ifelse(knn15=="1", prob, 1-prob)
prob15 <- matrix(prob, nrow = length(px1), ncol = length(px2))

# Figure 2.2
par(mar = rep(2,4))
contour(px1, px2, prob15, levels=0.5, labels="", xlab="", ylab="", main=
    "15-nearest neighbour", axes=FALSE)
points(trainMat[,2:3], col=ifelse(trainMat[,1]==1, "coral", "cornflowerblue"))
points(xnew, pch=".", cex=1.2, col=ifelse(prob15>0.5, "coral", "cornflowerblue"))
box()

1
要在此处输入代码而不执行此操作,可以突出显示代码文本,然后单击页面顶部附近的“代码”按钮。它位于图标/按钮行中。代码看起来像花括号。
彼得·弗洛姆

回复:“如何粘贴R代码块”。编辑帖子时,您可以访问一个小菜单栏
chl 2012年

此外,如果您不使用可以轻松缩进代码块的编辑器,我想您会很乐于切换到一个。例如,在Rstudio选择代码和压片缩进它,在vim你可以5>>
马克
By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.