¿Cómo trazar el límite de decisión de un clasificador vecino k-más cercano de Elementos de aprendizaje estadístico?

31

Quiero generar la trama descrita en el libro ElemStatLearn "Los elementos del aprendizaje estadístico: minería de datos, inferencia y predicción. Segunda edición" de Trevor Hastie y Robert Tibshirani y Jerome Friedman. La trama es:

ingrese la descripción de la imagen aquí

Me pregunto cómo puedo producir este gráfico exacto R, especialmente tenga en cuenta los gráficos de cuadrícula y el cálculo para mostrar el límite.

littleEinstein
fuente
1
@StasK: sí, lo es. ¿Cómo generar la trama? ¿Podrías ayudarme por favor? ¡Muchas gracias!
littleEinstein

Respuestas:

35

Para reproducir esta figura, debe tener el paquete ElemStatLearn instalado en su sistema. El conjunto de datos artificial fue generado con mixture.example()lo señalado por @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()

Todos menos los últimos tres comandos provienen de la ayuda en línea para mixture.example. Tenga en cuenta que utilizamos el hecho de que expand.gridorganizará su salida variando xprimero, lo que permite además indexar (por columna) los colores en la prob15matriz (de dimensión 69x99), que contiene la proporción de los votos para la clase ganadora para cada coordenada reticular ( px1, px2).

ingrese la descripción de la imagen aquí

chl
fuente
+1. ¡Gracias! También me pregunto cómo generar los datos como se describe en el texto "exponer el oráculo". ¿Podría agregar eso, en lugar de utilizar los datos del sitio web?
littleEinstein
@littleEinstein ¿Te refieres a lo que se da en la ayuda en línea mixture.example? Mire la configuración de simulación debajo de la línea que comienza # Reproducing figure 2.4, page 17 of the book:en la sección de ejemplos.
chl
¿me puede decir el enlace? No puedo encontrarlo.
littleEinstein
Lo siento @littleEinstein, pero hay algo que probablemente me estoy perdiendo. Es solo una cuestión de escribir help(mixture.example)o example(mixture.example)en el indicador R (después de cargar el paquete requerido con library(ElemStatLearn)). El código para generar el conjunto de datos artificial (no para generar la Fig. 2.4) se escribe en la R simple en la sección de Ejemplo.
chl
1
Por cierto, acabo de encontrar el weblog de @ Shane donde lo usó ggplotpara un propósito similar. Mira esto: ESL 2.1: Regresión lineal vs. KNN .
chl
7

Estoy aprendiendo ESL y estoy tratando de trabajar con todos los ejemplos provistos en el libro. Acabo de hacer esto y puedes consultar el código R a continuación:

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()
Daoying Lin
fuente
1
Para ingresar el código aquí sin hacerlo, puede resaltar el texto que es el código y luego hacer clic en el botón "código" cerca de la parte superior de la página. Está en una fila de iconos / botones. El código uno parece llaves.
Peter Flom - Restablece a Monica
Re: "cómo pegar un bloque de código R". Tienes acceso a una pequeña barra de menú al editar tu publicación.
chl
Además, si no está utilizando un editor que pueda sangrar bloques de código fácilmente, creo que le complacerá cambiar a uno. Por ejemplo, en rstudio seleccionar el código y presionando la pestaña guiones, en vim que pueda 5>>, etc
Marcos