Adiciona preliminar de k-NN.

parent 79cd9dbc
......@@ -33,6 +33,8 @@ navbar:
href: tutorials/04-regression-trees.html
- text: "Máquina de vetores de suporte"
href: tutorials/05-support-vector-machine.html
- text: "k vizinhos mais próximos"
href: tutorials/06-k-nearest-neighborhood.html
- text: "Scripts"
icon: fa-file-text
href: scripts/
......
---
title: "Classificador de k vizinhos mais próximos"
author: Prof. Walmes M. Zeviani & Prof. Eduardo V. Ferreira
date: 2017-10-24
#bibliography: ../config/Refs.bib
#csl: ../config/ABNT-UFPR-2011-Mendeley.csl
---
```{r, include = FALSE}
source("../config/setup.R")
opts_chunk$set(
cache = FALSE,
message = FALSE,
warning = FALSE)
```
# Classificador de *k* vizinhos mais próximos
```{r, message = FALSE}
rm(list = objects())
library(lattice)
library(latticeExtra)
```
```{r}
# Aquisição dos dados.
url <- "http://archive.ics.uci.edu/ml/machine-learning-databases/breast-cancer-wisconsin/wdbc.data"
da <- read.csv(url)
# x <- "radius
# texture
# perimeter
# area
# smoothness
# compactness
# concavity
# concave
# symmetry
# fractal"
# dput(readLines(textConnection(x)))
# Criando o nome das variáveis.
n <- outer(Y = c("mn", "sd", "lg"),
X = c("radius", "texture", "perimeter", "area", "smoothness",
"compactness", "concavity", "concave", "symmetry",
"fractal"),
FUN = paste, sep = "_")
names(da) <- c("id", "diagnosis", n)
str(da)
head(da[, c(3, 13, 23)])
#-----------------------------------------------------------------------
# Análise exploratória.
# Tabela de frequência.
xtabs(~diagnosis, data = da)
# Criando a formula com todas as medidas.
f <- sprintf("%s ~ diagnosis",
paste(names(da)[-(1:2)], collapse = " + "))
# Gráfico de caixas.
bwplot(as.formula(f),
data = da,
outer = TRUE,
as.table = TRUE,
pch = "|",
fill = "gray",
scales = "free")
# Só os valores médios.
splom(~da[, grepl(x = names(da), pattern = "_mn")],
groups = da$diagnosis,
as.matrix = TRUE,
auto.key = TRUE)
# Só os desvios padrões.
splom(~da[, grepl(x = names(da), pattern = "_sd")],
groups = da$diagnosis,
as.matrix = TRUE,
auto.key = TRUE)
# Só a média dos extremos.
splom(~da[, grepl(x = names(da), pattern = "_lg")],
groups = da$diagnosis,
as.matrix = TRUE,
auto.key = TRUE)
#-----------------------------------------------------------------------
# Padronização de escala.
# Para verificar as escalas das medidas.
summary(da)
# Para padronizar para intervalo unitário.
to_unit <- function(x, ...) {
z <- x - min(x, ...)
return(z/max(z, ...))
}
sort(to_unit(rnorm(5)))
# Criando uma versão com valores padronizados.
db <- da
db$id <- NULL
db[, -1] <- as.data.frame(lapply(da[, -(1:2)],
FUN = to_unit))
summary(db)
#-----------------------------------------------------------------------
# Aplicando o k-nn.
library(class)
# Separando em treino e test.
set.seed(123)
n <- nrow(da)
# i <- sample(x = 1:n, size = floor(n * 0.75))
# db_train <- db[i, ]
# nrow(db_train)
# db_test <- db[-i, ]
# nrow(db_test)
i <- sample(x = c(TRUE, FALSE),
size = n,
replace = TRUE,
prob = c(0.75, 1 - 0.75))
db_train <- db[i, ]
nrow(db_train)
db_test <- db[!i, ]
nrow(db_test)
# Obtendo as predições para o conjunto de teste via conjunto de treino.
m0 <- knn(train = db_train[, -1],
test = db_test[, -1],
cl = db_train[, 1],
k = 1)
# Tabela de confusão.
table(db_test[, 1], m0)
#-----------------------------------------------------------------------
# Simplificando para visualizar e entender.
names(db)
xyplot(radius_mn ~ radius_sd,
data = db_train,
groups = diagnosis,
auto.key = TRUE,
aspect = "iso") +
as.layer(xyplot(radius_mn ~ radius_sd,
data = db_test,
groups = diagnosis,
pch = 19))
# Criando um grid fino de valores para traçar a borda.
grid <- expand.grid(seq(0, 1, length.out = 100),
seq(0, 1, length.out = 100),
KEEP.OUT.ATTRS = FALSE)
names(grid) <- c("radius_mn", "radius_sd")
# Um vizinho.
m0 <- knn(train = db_train[, names(grid)],
test = grid,
cl = db_train[, 1],
k = 1)
levelplot(-as.integer(m0) ~ radius_sd + radius_mn,
data = grid,
col.regions = gray.colors,
colorkey = FALSE,
aspect = "iso") +
as.layer(xyplot(radius_mn ~ radius_sd,
data = db_train,
groups = diagnosis,
pch = 19))
# Variando o número de vizinhos.
k <- c(1:5, 7, 11, 19)
# Criando a predição das categorias variando o k.
pred <- lapply(k,
FUN = knn,
train = db_train[, names(grid)],
test = grid,
cl = db_train[, 1])
names(pred) <- paste0("k", k)
# Coerção.
pred <- as.data.frame(pred)
# Junção.
pred <- cbind(grid, pred)
# Empilha.
pred <- reshape2::melt(data = pred, id.vars = names(grid))
# Formata.
pred$value <- factor(pred$value, levels(db$diagnosis))
str(pred)
levelplot(value ~ radius_sd + radius_mn | variable,
data = pred,
col.regions = gray.colors,
colorkey = FALSE,
as.table = TRUE,
aspect = "iso") +
as.layer(xyplot(radius_mn ~ radius_sd,
data = db_train,
groups = diagnosis,
pch = 19))
```
```{r}
#-----------------------------------------------------------------------
# Usando o pacote caret.
library(caret)
# Criando as partições.
set.seed(789)
intrain <- createDataPartition(y = db$diagnosis, p = 0.7, list = FALSE)
db_train <- db[intrain, ]
db_test <- db[-intrain, ]
nrow(db_train)
nrow(db_test)
# Define a valiação cruzada.
trctrl <- trainControl(method = "repeatedcv", number = 10, repeats = 3)
set.seed(159)
knn_fit <- train(diagnosis ~ .,
data = db_train,
method = "knn",
trControl = trctrl,
tuneLength = 10)
class(knn_fit)
methods(class = class(knn_fit))
# Usa a função caret::knn3() como workhorse. Baseia-se no código em C do
# pacote class.
class(knn_fit$finalModel)
methods(class = class(knn_fit$finalModel))
# help(knn3, help_type = "html")
# Resultado do procedimento.
knn_fit
# Gráfico para escolha do parâmetro de tunning.
plot(knn_fit)
# Predição nos dados deixados de fora.
m0 <- predict(knn_fit, newdata = db_test)
# Matriz de confusão.
confusionMatrix(m0, db_test$diagnosis)
```
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment