Vecinos de K-Nearest más cercanos desde cero

Bienvenido, les saluda Luis y aquí les traigo un nuevo tutorial.

Crearemos dos conjuntos de muestras diferentes:

• Conjunto de entrenamiento: Este contendrá el 75% de nuestros datos de trabajo, seleccionados al azar. Este conjunto se utilizará para generar nuestro modelo.
• Equipo de prueba: El 25% restante de nuestros datos de trabajo se utilizará para probar la precisión fuera de la muestra de nuestro modelo. Una vez realizadas nuestras predicciones de este 25%, comprobaremos el «porcentaje de clasificaciones correctas» comparando las predicciones con los valores reales.

# Load Data
library(readr)
RGB <- as.data.frame(read_csv("RGB.csv"))
RGB$x <- as.numeric(RGB$x)
RGB$y <- as.numeric(RGB$y)
print("Working data ready")# Training Dataset
smp_siz = floor(0.75*nrow(RGB))
train_ind = sample(seq_len(nrow(RGB)),size = smp_siz)
train =RGB[train_ind,]# Testting Dataset
test=RGB[-train_ind,]
OriginalTest <- test
paste("Training and test sets done")

Podemos observar que nuestros datos de trenes se clasifican en 3 grupos en función de los colores.

# We plot test colored datapoints
library(ggplot2)
colsdot <- c("Blue" = "blue", "Red" = "darkred", "Green" = "darkgreen")
ggplot() + 
geom_tile(data=train,mapping=aes(x, y), alpha=0) +
##Ad tiles according to probabilities
##add points
geom_point(data=train,mapping=aes(x,y, colour=Class),size=3 ) + 
scale_color_manual(values=colsdot) +
#add the labels to the plots
xlab('X') + ylab('Y') + ggtitle('Train Data')+
#remove grey border from the tile
scale_x_continuous(expand=c(0,.05))+scale_y_continuous(expand=c(0,.05))

Datos del tren: podemos observar 3 clases (azul, verde y rojo)

Aunque conocemos la clasificación de color original de nuestros datos de prueba, intentaremos crear un modelo que pueda adivinar su color basándose únicamente en una suposición informada. Para ello, eliminaremos sus colores originales y los guardaremos solo para fines de prueba; una vez que nuestro modelo haga su predicción, podremos calcular nuestra Precisión del modelo comparando el original con nuestra predicción.

# We plot test colored datapoints
colsdot <- c("Blue" = "blue", "Red" = "darkred", "Green" = "darkgreen")
ggplot() + 
geom_tile(data=test,mapping=aes(x, y), alpha=0) +
##Ad tiles according to probabilities
##add points
geom_point(data=test,mapping=aes(x,y),size=3 ) + 
scale_color_manual(values=colsdot) +
#add the labels to the plots
xlab('X') + ylab('Y') + ggtitle('Test Data')+
#remove grey border from the tile
scale_x_continuous(expand=c(0,.05))+scale_y_continuous(expand=c(0,.05))

Datos de prueba: eliminamos y olvidamos intencionalmente sus colores de clasificación para crear un modelo que pueda adivinarlos.

A continuación se muestra un ejemplo paso a paso de una implementación de este algoritmo. Lo que queremos lograr es para cada punto gris seleccionado arriba (nuestros valores de prueba), donde supuestamente no conocemos su color real, buscamos el vecino más cercano o el punto de datos de color más cercano de nuestros valores de tren y asignamos el mismo color que este.

En particular, necesitamos:

• Normalizar datos: aunque en este caso no es necesario, dado que todos los valores están en la misma escala (decimales entre 0 y 1), se recomienda normalizar para tener una “métrica de distancia estándar”.
• Definir cómo medimos la distancia: Podemos definir la distancia entre dos puntos en este conjunto de datos bidimensionales como la distancia euclidiana entre ellos. Calcularemos las distancias L1 (suma de diferencias absolutas) y L2 (suma de diferencias al cuadrado), aunque los resultados finales se calcularán utilizando L2 ya que es más implacable que L1.
• Calcular distancias: necesitamos calcular la distancia entre cada punto de datos probado y cada valor dentro de nuestro conjunto de datos de trenes. La normalización es fundamental aquí ya que, en el caso de la estructura corporal, una distancia en peso (1 KG) y altura (1 M) no es comparable. Podemos anticipar una desviación mayor en KG que en los Metros, lo que lleva a distancias generales incorrectas.
• Clasificar distancias: Una vez que calculamos la distancia entre cada prueba y puntos de entrenamiento, debemos ordenarlos en orden descendente.
• Selección de los K vecinos más cercanos: Seleccionaremos los primeros K puntos de datos de trenes más cercanos para inspeccionar a qué categoría (colores) pertenecen para también asignar esta categoría a nuestro punto probado. Dado que podríamos usar varios vecinos, podríamos terminar con múltiples categorías, en cuyo caso, deberíamos calcular una probabilidad.

# We define a function for prediction
KnnL2Prediction <- function(x,y,K)
# Train data
Train <- train
# This matrix will contain all X,Y values that we want test.
Test <- data.frame(X=x,Y=y)

# Data normalization
Test$X <- (Test$X - min(Train$x))/(min(Train$x) - max(Train$x))
Test$Y <- (Test$Y - min(Train$y))/(min(Train$y) - max(Train$y))
Train$x <- (Train$x - min(Train$x))/(min(Train$x) - max(Train$x))
Train$y <- (Train$y - min(Train$y))/(min(Train$y) - max(Train$y))

# We will calculate L1 and L2 distances between Test and Train values.
VarNum <- ncol(Train)-1
L1 <- 0
L2 <- 0
for (i in 1:VarNum)
L1 <- L1 + (Train[,i] - Test[,i])
L2 <- L2 + (Train[,i] - Test[,i])^2

# We will use L2 Distance
L2 <- sqrt(L2)

# We add labels to distances and sort
Result <- data.frame(Label=Train$Class,L1=L1,L2=L2)

# We sort data based on score
ResultL1 <-Result[order(Result$L1),]
ResultL2 <-Result[order(Result$L2),]

# Return Table of Possible classifications
a <- prop.table(table(head(ResultL2$Label,K)))
b <- as.data.frame(a)
return(as.character(b$Var1[b$Freq == max(b$Freq)]))

Para ello, usaremos un método llamado «validación cruzada». Lo que esto significa es que haremos predicciones dentro de los datos de entrenamiento y los iteraremos en muchos valores diferentes de K para muchos pliegues o permutaciones diferentes de los datos. Una vez que hayamos terminado, promediaremos nuestros resultados y obtendremos la mejor K para nuestro algoritmo de vecinos «K-más cercano».

# We will use 5 folds
FoldSize = floor(0.2*nrow(train)) # Fold1
piece1 = sample(seq_len(nrow(train)),size = FoldSize ) 
Fold1 = train[piece1,]
rest = train[-piece1,] # Fold2
piece2 = sample(seq_len(nrow(rest)),size = FoldSize)
Fold2 = rest[piece2,]
rest = rest[-piece2,] # Fold3
piece3 = sample(seq_len(nrow(rest)),size = FoldSize)
Fold3 = rest[piece3,]
rest = rest[-piece3,] # Fold4
piece4 = sample(seq_len(nrow(rest)),size = FoldSize)
Fold4 = rest[piece4,]
rest = rest[-piece4,] # Fold5
Fold5 <- rest# We make folds
Split1_Test <- rbind(Fold1,Fold2,Fold3,Fold4)
Split1_Train <- Fold5Split2_Test <- rbind(Fold1,Fold2,Fold3,Fold5)
Split2_Train <- Fold4Split3_Test <- rbind(Fold1,Fold2,Fold4,Fold5)
Split3_Train <- Fold3Split4_Test <- rbind(Fold1,Fold3,Fold4,Fold5)
Split4_Train <- Fold2Split5_Test <- rbind(Fold2,Fold3,Fold4,Fold5)
Split5_Train <- Fold1# We select best K
OptimumK <- data.frame(K=NA,Accuracy=NA,Fold=NA)
results <- trainfor (i in 1:5) 
if(i == 1) 
train <- Split1_Train
test <- Split1_Test
 else if(i == 2)  
train <- Split2_Train
test <- Split2_Test
 else if(i == 3)  
train <- Split3_Train
test <- Split3_Test
 else if(i == 4)  
train <- Split4_Train
test <- Split4_Test
 else if(i == 5)  
train <- Split5_Train
test <- Split5_Test

for(j in 1:20) 
results$Prediction <- mapply(KnnL2Prediction, results$x, results$y,j)
# We calculate accuracy
results$Match <- ifelse(results$Class == results$Prediction, 1, 0)
Accuracy <- round(sum(results$Match)/nrow(results),4)
OptimumK <- rbind(OptimumK,data.frame(K=j,Accuracy=Accuracy,Fold=paste("Fold",i)))

OptimumK <- OptimumK [-1,]
MeanK <- aggregate(Accuracy ~ K, OptimumK, mean)
ggplot() + 
geom_point(data=OptimumK,mapping=aes(K,Accuracy, colour=Fold),size=3 ) +
geom_line(aes(K, Accuracy, colour="Moving Average"), linetype="twodash", MeanK) +
scale_x_continuous(breaks=seq(1, max(OptimumK$K), 1))

5 pliegues para 20 valores diferentes de K

Como se ve en la gráfica anterior, podemos observar que la precisión de predicción de nuestro algoritmo está en el rango de 88% -95% para todos los pliegues y disminuyendo de K = 3 en adelante. Podemos observar los resultados de mayor precisión consistente en K = 1 (3 también es una buena alternativa).

Precisión del modelo

# Predictions over our Test sample
test <- OriginalTest
K <- 1
test$Prediction <- mapply(KnnL2Prediction, test$x, test$y,K)
head(test,10)# We calculate accuracy
test$Match <- ifelse(test$Class == test$Prediction, 1, 0)
Accuracy <- round(sum(test$Match)/nrow(test),4)
print(paste("Accuracy of ",Accuracy*100,"%",sep=""))

Primeras 10 predicciones usando K = 1

Como se ve en los resultados anteriores, podemos esperar “adivinar la clase o el color correcto” el 93% del tiempo.

Colores originales

A continuación podemos observar los colores o clases originales de nuestra muestra de prueba.

ggplot() + 
geom_tile(data=test,mapping=aes(x, y), alpha=0) +
geom_point(data=test,mapping=aes(x,y,colour=Class),size=3 ) + 
scale_color_manual(values=colsdot) +
xlab('X') + ylab('Y') + ggtitle('Test Data')+
scale_x_continuous(expand=c(0,.05))+scale_y_continuous(expand=c(0,.05))

Este es el color / clase original de nuestras muestras de prueba.

Colores predichos

Usando nuestro algoritmo, obtenemos los siguientes colores para nuestro conjunto de datos de muestra inicialmente incoloro.

ggplot() + 
geom_tile(data=test,mapping=aes(x, y), alpha=0) +
geom_point(data=test,mapping=aes(x,y,colour=Prediction),size=3 ) + 
scale_color_manual(values=colsdot) +
xlab('X') + ylab('Y') + ggtitle('Test Data')+
scale_x_continuous(expand=c(0,.05))+scale_y_continuous(expand=c(0,.05))

En círculos rojos, hemos marcado las diferencias o clasificaciones incorrectas.

Como se ve en el gráfico anterior, parece que a pesar de que nuestro algoritmo clasificó correctamente la mayoría de los puntos de datos, falló con algunos de ellos (marcados en rojo).

Límites de decisión

Finalmente, podemos visualizar nuestros «límites de decisión» sobre nuestro conjunto de datos de prueba original. Esto proporciona una excelente aproximación visual de qué tan bien nuestro modelo clasifica nuestros datos y los límites de su espacio de clasificación.

En palabras simples, simularemos 160.000 puntos de datos (matriz de 400×400) dentro del rango de nuestro conjunto de datos original, que, cuando se traza posteriormente, llenará la mayoría de los espacios vacíos con colores. Esto nos ayudará a expresar en detalle cómo nuestro modelo clasificaría este espacio 2D dentro de sus clases de color aprendidas. Cuantos más puntos generemos, mejor será nuestra «resolución», al igual que los píxeles de un televisor.

# We calculate background colors
x_coord = seq(min(train[,1]) - 0.02,max(train[,1]) + 0.02,length.out = 40)
y_coord = seq(min(train[,2]) - 0.02,max(train[,2]) + 0.02, length.out = 40)
coord = expand.grid(x = x_coord, y = y_coord)
coord[['prob']] = mapply(KnnL2Prediction, coord$x, coord$y,K)# We calculate predictions and plot decition area
colsdot <- c("Blue" = "blue", "Red" = "darkred", "Green" = "darkgreen")
colsfill <- c("Blue" = "#aaaaff", "Red" = "#ffaaaa", "Green" = "#aaffaa")
ggplot() + 
geom_tile(data=coord,mapping=aes(x, y, fill=prob), alpha=0.8) +
geom_point(data=test,mapping=aes(x,y, colour=Class),size=3 ) + 
scale_color_manual(values=colsdot) +
scale_fill_manual(values=colsfill) +
xlab('X') + ylab('Y') + ggtitle('Decision Limits')+
scale_x_continuous(expand=c(0,0))+scale_y_continuous(expand=c(0,0))

Como se vio anteriormente, la región coloreada representa qué áreas nuestro algoritmo definiría como un «punto de datos coloreado». Es visible por qué no pudo clasificar algunos de ellos correctamente.

Feliz codificación.