Aprimora tutorial de k-nn.

parent cf4f6243
......@@ -16,6 +16,8 @@ opts_chunk$set(
# Classificador de *k* vizinhos mais próximos
## Preparando os dados
```{r, message = FALSE}
rm(list = objects())
library(lattice)
......@@ -23,7 +25,9 @@ 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)
......@@ -40,15 +44,17 @@ da <- read.csv(url)
# dput(readLines(textConnection(x)))
# Criando o nome das variáveis.
nms <- c("radius", "texture", "perimeter", "area", "smoothness",
"compactness", "concavity", "concave", "symmetry",
"fractal")
n <- outer(Y = c("mn", "sd", "lg"),
X = c("radius", "texture", "perimeter", "area", "smoothness",
"compactness", "concavity", "concave", "symmetry",
"fractal"),
X = nms,
FUN = paste, sep = "_")
names(da) <- c("id", "diagnosis", n)
str(da)
head(da[, c(3, 13, 23)])
# head(da[, c(3, 13, 23)])
head(da[, grepl("radius", names(da))])
#-----------------------------------------------------------------------
# Análise exploratória.
......@@ -60,6 +66,9 @@ xtabs(~diagnosis, data = da)
f <- sprintf("%s ~ diagnosis",
paste(names(da)[-(1:2)], collapse = " + "))
# Opções estéticas do gráfico de caixas.
grep(x = names(trellis.par.get()), pattern = "box", value = TRUE)
# Gráfico de caixas.
bwplot(as.formula(f),
data = da,
......@@ -67,7 +76,9 @@ bwplot(as.formula(f),
as.table = TRUE,
pch = "|",
fill = "gray",
scales = "free")
scales = "free",
par.settings = list(
box.umbrella = list(lty = 1)))
# Só os valores médios.
splom(~da[, grepl(x = names(da), pattern = "_mn")],
......@@ -99,6 +110,7 @@ to_unit <- function(x, ...) {
return(z/max(z, ...))
}
# 1, 2, 3, testando...
sort(to_unit(rnorm(5)))
# Criando uma versão com valores padronizados.
......@@ -107,7 +119,11 @@ db$id <- NULL
db[, -1] <- as.data.frame(lapply(da[, -(1:2)],
FUN = to_unit))
summary(db)
```
## Aplicando o k-NN com o pacote `class`
```{r}
#-----------------------------------------------------------------------
# Aplicando o k-nn.
......@@ -130,7 +146,7 @@ nrow(db_train)
db_test <- db[!i, ]
nrow(db_test)
# 430/nrow(da)
c(nrow(db_train), nrow(db_test))/nrow(db)
# Obtendo as predições para o conjunto de teste via conjunto de treino.
m0 <- knn(train = db_train[, -1],
......@@ -142,13 +158,28 @@ m0 <- knn(train = db_train[, -1],
ct <- table(db_test[, 1], m0)
ct
# Fração de acertos.
sum(diag(ct))/sum(ct)
```
```{r}
#-----------------------------------------------------------------------
# Simplificando para visualizar e entender.
names(db)
# Formulas usando sd contra mn.
f <- sapply(nms,
FUN = function(x) {
as.formula(sprintf("%s_sd ~ %s_mn", x, x))
})
xyplot.list(f,
data = db,
groups = diagnosis,
type = c("p", "smooth"),
as.table = TRUE,
auto.key = TRUE,
x.same = FALSE, y.same = FALSE)
# Dados de treino (aberto) e teste (fechado).
xyplot(radius_mn ~ radius_sd,
data = db_train,
groups = diagnosis,
......@@ -159,18 +190,20 @@ xyplot(radius_mn ~ radius_sd,
groups = diagnosis,
pch = 19))
# Criando um grid fino de valores para traçar a borda.
# Criando um grid fino de valores para traçar a fronteira do
# classificador.
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.
# Usando apenas o vizinho mais próximo.
m0 <- knn(train = db_train[, names(grid)],
test = grid,
cl = db_train[, 1],
k = 1)
# Gráfico da fronteira de classificação.
levelplot(-as.integer(m0) ~ radius_sd + radius_mn,
data = grid,
col.regions = gray.colors,
......@@ -178,10 +211,12 @@ levelplot(-as.integer(m0) ~ radius_sd + radius_mn,
aspect = "iso") +
as.layer(xyplot(radius_mn ~ radius_sd,
data = db_train,
groups = diagnosis,
pch = 19))
groups = diagnosis))
# Variando o número de vizinhos.
#-----------------------------------------------------------------------
# Serializar variando o número de vizinhos.
# Valores para o número de vizinhos.
k <- c(1:5, 7, 11, 19)
# Criando a predição das categorias variando o k.
......@@ -201,6 +236,7 @@ pred <- reshape2::melt(data = pred, id.vars = names(grid))
pred$value <- factor(pred$value, levels(db$diagnosis))
str(pred)
# Suavização da fronteira como função do número de vizinhos.
levelplot(value ~ radius_sd + radius_mn | variable,
data = pred,
col.regions = gray.colors,
......@@ -209,25 +245,40 @@ levelplot(value ~ radius_sd + radius_mn | variable,
aspect = "iso") +
as.layer(xyplot(radius_mn ~ radius_sd,
data = db_train,
groups = diagnosis,
pch = 19))
groups = diagnosis))
```
## Aplicando o k-NN com o pacote `caret`
```{r}
#-----------------------------------------------------------------------
# Usando o pacote caret.
# Divisão dos dados em treino e teste.
library(caret)
# Proporções das classes no treino e teste usando sample().
rbind(train = prop.table(xtabs(~diagnosis, db_train)),
test = prop.table(xtabs(~diagnosis, db_test)))
# Criando as partições.
set.seed(789)
intrain <- createDataPartition(y = db$diagnosis, p = 0.7, list = FALSE)
intrain <- createDataPartition(y = db$diagnosis,
p = 0.75,
list = FALSE)
db_train <- db[intrain, ]
db_test <- db[-intrain, ]
nrow(db_train)
nrow(db_test)
# Define a valiação cruzada.
# Proporções das classes no treino e teste usando createDataPartition().
rbind(train = prop.table(xtabs(~diagnosis, db_train)),
test = prop.table(xtabs(~diagnosis, db_test)))
#-----------------------------------------------------------------------
# Submete para o método.
# Parametriza a valiação cruzada.
trctrl <- trainControl(method = "repeatedcv", number = 10, repeats = 3)
set.seed(159)
......@@ -235,8 +286,9 @@ knn_fit <- train(diagnosis ~ .,
data = db_train,
method = "knn",
trControl = trctrl,
tuneLength = 10)
tuneLength = 15)
# Classe e métodos.
class(knn_fit)
methods(class = class(knn_fit))
......@@ -259,7 +311,10 @@ m0 <- predict(knn_fit, newdata = db_test)
confusionMatrix(m0, db_test$diagnosis)
```
# k-NN para os dados de cultivares de uva
```{r}
# Carrega os dados.
url <- "http://www.leg.ufpr.br/~walmes/data/areafoliarUva.txt"
uva <- read.table(url, header = TRUE, sep = "\t",
stringsAsFactors = FALSE)
......@@ -271,25 +326,22 @@ uva$nl <- with(uva, apply(cbind(nld, nle), 1, mean))
uva <- subset(uva, select = -c(nld, nle))
str(uva)
# uva[, -1] <- as.data.frame(lapply(uva[, -1]),
# FUN = scale)
library(caret)
set.seed(1234)
# Especificação da validação cruzada.
trctrl <- trainControl(method = "repeatedcv",
number = 10,
repeats = 3)
# Opções de SVM.
grep(pattern = "^svm", x = names(getModelInfo()), value = TRUE)
# Ajuste.
svm_Linear <- train(cult ~ .,
data = uva,
method = "svmLinear",
trControl = trctrl,
preProcess = c("center", "scale"),
tuneLength = 10)
set.seed(1234)
svm_fit <- train(cult ~ .,
data = uva,
method = "svmRadial",
trControl = trctrl,
preProcess = c("center", "scale"),
tuneLength = 10)
knn_fit <- train(cult ~ .,
data = uva,
......@@ -298,16 +350,24 @@ knn_fit <- train(cult ~ .,
preProcess = c("center", "scale"),
tuneLength = 10)
# Resultado do ajuste.
svm_Linear
# Resultado dos métodos de classificação.
svm_fit
knn_fit
str(svm_Linear)
plot(svm_fit)
plot(knn_fit)
# Mostra que foi feito a chamada da kernlab::ksvm().
svm_Linear$finalModel
svm_fit$finalModel
knn_fit$finalModel
# Matriz de confusão.
confusionMatrix(uva$cult, predict(svm_Linear))
confusionMatrix(predict(svm_fit), uva$cult)
confusionMatrix(predict(knn_fit), uva$cult)
```
# Referências
* <https://rstudio-pubs-static.s3.amazonaws.com/123438_3b9052ed40ec4cd2854b72d1aa154df9.html>
* <http://dataaspirant.com/2017/01/09/knn-implementation-r-using-caret-package/>
* <https://rpubs.com/njvijay/16444>
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