Commit a7191196 authored by Walmes Marques Zeviani's avatar Walmes Marques Zeviani
Browse files

Conclui aplicações de classificação com SVM.

parent 3d99603f
......@@ -45,6 +45,8 @@ navbar:
href: tutorials/04-regression-trees.html
- text: "Máquina de vetores de suporte"
href: tutorials/05-support-vector-machine.html
- text: "Aplicação de máquina de vetores de suporte"
href: tutorials/05-support-vector-machine-aplic.html
- text: "k vizinhos mais próximos"
href: tutorials/06-k-nearest-neighborhood.html
- text: "Bayes ingênuo"
......
---
title: "Aplicações de SVM"
author: Prof. Walmes M. Zeviani & Prof. Eduardo V. Ferreira
date: 2017-10-10
date: 2018-10-19
#bibliography: ../config/Refs.bib
#csl: ../config/ABNT-UFPR-2011-Mendeley.csl
---
......@@ -14,9 +14,7 @@ opts_chunk$set(
warning = FALSE)
```
# Aplicações em conjuntos de dados reais
## Classificação de cultivares de uva de vinho
# Classificação de cultivares de uva de vinho
Os dados são medidas de comprimento feitos em 100 folhas de 3 variedades
de uva: malbec, marlot e souvignon blanc. Os dados foram fornecidos pelo
......@@ -27,6 +25,12 @@ das folhas digitalizadas por scanner usando o pacote
[EBImage](http://bioconductor.org/packages/release/bioc/html/EBImage.html).
```{r}
#-----------------------------------------------------------------------
# Pacotes.
library(lattice)
library(latticeExtra)
#-----------------------------------------------------------------------
# Dados hospedados na web.
......@@ -44,17 +48,26 @@ str(uva)
splom(uva[-(1:2)],
groups = uva$cult,
auto.key = TRUE,
as.matrix = TRUE,
cex = 0.2)
```
```{r, fig.height = 12}
splom(~uva[-(1:2)] | uva$cult,
cex = 0.2,
layout = c(1, NA))
# IMPORTANT: padronizar as variáveis para reduzir problemas de escala.
str(uva)
uva$larea <- log10(uva$area)
uva$area <- NULL
uva[, -1] <- sapply(uva[, -1], FUN = scale)
str(uva)
# Verifica se a média 0 e variância 1.
# apply(uva[, -1], 2, mean, na.rm = TRUE)
# apply(uva[, -1], 2, sd, na.rm = TRUE)
```
```{r, eval = FALSE, include = FALSE}
# Testando componentes principais.
u <- scale(uva[, -1])
# u <- scale(uva[, -1])
pr <- princomp(x = u)
screeplot(pr, type = "lines")
......@@ -64,16 +77,18 @@ biplot(pr)
plot(pr$scores[, 1:2],
col = as.integer(uva$cult))
abline(v = 0, h = 0, lty = 2)
splom(pr$scores,
groups = uva[, 1],
type = c("p", "r"),
as.matrix = TRUE)
```
## Pacote `kernlab`
# Explorando utilidades no pacote `kernlab`
```{r}
library(kernlab)
# help(ksvm, help_type = "html")
str(uva)
# Chamada com apenas duas classes. Simplificar para aprender.
da <- uva
levels(da$cult) <- c("malbec-merlot", "malbec-merlot", "sauvignonblanc")
......@@ -93,10 +108,12 @@ nSV(m0)
# Classficação nas observações de treino.
table(fitted(m0))
# Erro de classificação.
error(m0)
# Desempenho na classificação.
abs(c("Acerto" = 1, "Erro" = 0) - error(m0))
# ATTENTION: Cuidado que o modelo ingênuo irá acertar 1/2.
# Parâmetros.
# Parâmetros do SVM.
param(m0)
# Só funciona para classificações binárias com duas preditoras.
......@@ -110,22 +127,25 @@ splom(~da[, -1] | da$cult,
ct <- table(fitted(m0), da$cult)
prop.table(ct)
# Percentual de acerto na classificação.
# Percentual de acerto na classificação (já visto antes).
100 * sum(diag(ct))/sum(ct)
#-----------------------------------------------------------------------
# Parametrizando a chamada do método.
# Usando funções kernel e fazendo tunnings arbitrários.
# Agora é a classificação das 3 espécies de uva.
m0 <- ksvm(cult ~ .,
data = uva,
scaled = TRUE, # Padronizar com média 0 e variância 1.
type = "C-svc", # Emprego: classificação/regressão, etc.
C = 0.1, # Parâmetros do tipo de tarefa.
kernel = "rbfdot", # Função kernel.
kpar = list(sigma = 1), # Parâmetros da função kernel.
cross = 10) # Quantidade de folds para validação cruzada.
C = 50, # Parâmetro de penalização.
kernel = "rbfdot", # Função kernel.
kpar = list(sigma = 0.1), # Parâmetros da função kernel.
cross = 1) # Quantidade de folds para validação cruzada.
m0
# ATTENTION
# Matriz de confusão.
ct <- table(uva$cult, fitted(m0))
prop.table(ct)
......@@ -137,6 +157,7 @@ mosaicplot(ct,
# Percentual de acerto na classificação.
100 * sum(diag(ct))/sum(ct)
1 - error(m0)
#-----------------------------------------------------------------------
# Mais variações.
......@@ -149,8 +170,9 @@ m0 <- ksvm(cult ~ .,
kernel = "rbfdot",
kpar = list(sigma = 0.01),
C = 1e5,
cross = 10)
cross = 1)
m0
1 - error(m0)
# Kernel linear (baunilha).
m0 <- ksvm(cult ~ .,
......@@ -159,15 +181,12 @@ m0 <- ksvm(cult ~ .,
type = "nu-svc",
kernel = "vanilladot",
nu = 0.5,
cross = 10)
cross = 1)
m0
# Percentual de acerto na classificação.
ct <- table(fitted(m0), uva$cult)
100 * sum(diag(ct))/sum(ct)
1 - error(m0)
```
## Pacote `e1071`
# Explorando utilidades no pacote `e1071`
```{r}
library(e1071)
......@@ -176,8 +195,7 @@ library(e1071)
m1 <- svm(cult ~ .,
data = uva)
summary(m1)
str(m1)
# str(m1)
# Quantidade e coordenadas dos pontos de suporte.
m1$tot.nSV
......@@ -187,18 +205,23 @@ head(m1$SV)
#-----------------------------------------------------------------------
# Fazendo a tunagem com a grid search.
# tune() é uma função do e1071 que permite avaliar o modelo em vários
# valores para os hiperparâmetros.
# help(tune, h = "html")
# Configura.
x <- as.matrix(subset(uva, select = -cult))
y <- uva$cult
tune <- tune(method = svm,
train.x = x,
train.y = y,
kernel = "radial",
ranges = list(cost = 10^seq(-2, 5, l = 10),
gamma = 2^seq(-3, 3, l = 10)))
ranges = list(cost = 10^seq(-2, 5, l = 8),
gamma = 2^seq(-3, 3, l = 8)),
tunecontrol = tune.control(cross = 5))
print(tune)
str(tune)
# ATTENTION: o acerto do modelo ingênuo é 1/3.
# A superfície do erro.
levelplot(error ~ log10(cost) + log2(gamma),
......@@ -217,6 +240,7 @@ summary(m2)
yfit <- predict(m2)
ct <- table(yfit, y)
ct
sum(diag(ct))/sum(ct)
```
......@@ -226,85 +250,6 @@ O código abaixo foi aperfeiçoado do material
de iris em `iris`.
```{r}
splom(iris[1:4],
groups = iris$Species)
# xyplot(Petal.Length ~ Sepal.Length,
# data = iris,
# groups = Species,
# auto.key = TRUE)
#
# # Apenas duas espécies.
# irisb <- droplevels(subset(iris,
# Species != "virginica",
# select = c(1, 3, 5)))
# str(irisb)
#
# xyplot(Petal.Length ~ Sepal.Length,
# data = irisb,
# groups = Species,
# auto.key = TRUE)
#
# # Exemplo com o Iris. Usando apenas duas variáveis.
# x <- subset(irisb, select = -Species)
# y <- irisb$Species
#
# # Especificação com fórmula
# svm0 <- svm(Species ~ Petal.Length + Sepal.Length,
# data = irisb)
# summary(svm0)
#
# # Quantidade e coordenadas dos pontos de suporte.
# svm0$nSV
# svm0$SV
#
# # ATTENTION: O processamento dos dados é na escala padronizada!
# plot(scale(Petal.Length) ~ scale(Sepal.Length),
# data = irisb)
# # points(x = svm0$SV[, "Sepal.Length"],
# # y = svm0$SV[, "Petal.Length"],
# # col = 2,
# # pch = 19)
# segments(x0 = 0,
# y0 = 0,
# x1 = svm0$SV[, "Sepal.Length"],
# y1 = svm0$SV[, "Petal.Length"],
# col = 2,
# pch = 19)
# abline(v = 0, h = 0, lty = 2, col = "gray")
#
# # Usando matrizes e vetores.
# svm1 <- svm(x, y)
# summary(svm1)
#
# # Predição dos valores.
# pred <- predict(svm1, newdata = x)
#
# # Performance do classificador.
# table(pred, y)
#
# # Gerando um grid no retângulo que contém os pontos.
# grid <- with(irisb,
# expand.grid(Sepal.Length = seq(min(Sepal.Length),
# max(Sepal.Length),
# l = 101),
# Petal.Length = seq(min(Petal.Length),
# max(Petal.Length),
# l = 101)))
# grid$y <- predict(svm1, newdata = grid)
#
# # Exibindo a fronteira de classificação.
# xyplot(Petal.Length ~ Sepal.Length,
# data = grid,
# groups = y,
# pch = 3,
# aspect = 1,
# auto.key = TRUE) +
# as.layer(xyplot(Petal.Length ~ Sepal.Length,
# data = irisb,
# pch = 19,
# groups = Species))
#-----------------------------------------------------------------------
# Usando com todas as variáveis e 3 classes de espécie e avaliando
# diferentes funções kernel.
......@@ -312,6 +257,7 @@ splom(iris[1:4],
# Nomes das funções kernel.
ker <- c("linear", "polynomial", "radial", "sigmoid")
# Ajusta com cada opção de kernel.
svm0 <- sapply(ker,
simplify = FALSE,
FUN = function(k) {
......@@ -319,7 +265,10 @@ svm0 <- sapply(ker,
data = iris,
kernel = k)
})
lapply(svm0, summary)
# lapply(svm0, summary)
# Número de pontos de suporte.
colSums(sapply(svm0, getElement, "nSV"))
# Tabelas de confusão.
lapply(svm0,
......@@ -345,7 +294,7 @@ y <- plyr::ldply(y)
names(y) <- c("kernel", "y")
grid <- cbind(grid, y)
str(grid)
# str(grid)
# Exibindo a fronteira de classificação.
xyplot(Petal.Length ~ Sepal.Length | kernel,
......@@ -354,74 +303,151 @@ xyplot(Petal.Length ~ Sepal.Length | kernel,
pch = 3,
as.table = TRUE,
aspect = 1,
auto.key = TRUE) +
auto.key = list(columns = 3)) +
as.layer(xyplot(Petal.Length ~ Sepal.Length,
data = iris,
pch = 19,
groups = Species))
```
## Pacote `caret`
# Tunning de hiperparâmentros com o `caret`
Adaptação feita baseada no material <http://dataaspirant.com/2017/01/19/support-vector-machine-classifier-implementation-r-caret-package/>.
Adaptação feita baseada no material
<http://dataaspirant.com/2017/01/19/support-vector-machine-classifier-implementation-r-caret-package/>.
Modelos disponíveis no `caret`: <https://rdrr.io/cran/caret/man/models.html>.
Modelos de máquinas de vetores de suporte: <https://topepo.github.io/caret/train-models-by-tag.html#support-vector-machines>.
```{r}
library(caret)
packageVersion("caret")
# Modelos de SVM.
names(getModelInfo(model = "^svm"))
# Definir a semente para haver reprodutibilidade.
set.seed(1234)
# Especificação da validação cruzada.
trctrl <- trainControl(method = "repeatedcv",
number = 10,
repeats = 3)
number = 5,
repeats = 3,
returnResamp = "all",
savePredictions = "all")
# Ajuste.
svm_Linear <- train(cult ~ .,
data = uva,
method = "svmLinear",
trControl = trctrl,
preProcess = c("center", "scale"),
tuneLength = 10)
trControl = trctrl)
# Resultado do ajuste.
svm_Linear
str(svm_Linear)
# Estrutura.
# str(svm_Linear)
names(svm_Linear)
# Mostra que foi feito a chamada da kernlab::ksvm().
svm_Linear$finalModel
# Matriz de confusão.
confusionMatrix(uva$cult, predict(svm_Linear))
confusionMatrix(svm_Linear$trainingData$.outcome,
predict(svm_Linear))
svm_Linear$results
str(svm_Linear$pred)
# Desempenho em cada partição.
aggregate(cbind(acc = pred == obs) ~ Resample,
data = svm_Linear$pred,
FUN = mean)
#-----------------------------------------------------------------------
# Tunando.
grid <- expand.grid(C = c(0, 0.01, 0.05, 0.1, 0.25, 0.5, 0.75,
1, 1.25, 1.5, 1.75, 2, 5))
# Parâmetro de penalidade.
grid <- expand.grid(C = c(0.01, 0.05, 0.1, 0.25, 0.5, 0.75,
1, 1.25, 1.5, 1.75, 2, 5, 10, 20))
svm_Linear_Grid <- train(cult ~ .,
data = uva,
method = "svmLinear",
trControl = trctrl,
preProcess = c("center", "scale"),
tuneGrid = grid,
tuneLength = 10)
tuneGrid = grid)
svm_Linear_Grid
plot(svm_Linear_Grid)
sc <- list(x = list(log = 2))
c("Performance média" =
plot(svm_Linear_Grid, scales = sc),
"Performances por partição" =
xyplot(svm_Linear_Grid, scales = sc) +
as.layer(plot(svm_Linear_Grid, scales = sc)))
#-----------------------------------------------------------------------
# Usando kernel radial.
svm_Radial <- train(Species ~ .,
data = iris,
# O parâmetro C já é avaliado em grid.
svm_Radial <- train(cult ~ .,
data = uva,
method = "svmRadial",
trControl = trctrl,
preProcess = c("center", "scale"),
tuneLength = 10)
svm_Radial
plot(svm_Radial)
sc <- list(x = list(log = 2))
c("Performance média" =
plot(svm_Radial, scales = sc),
"Performances por partição" =
xyplot(svm_Radial, scales = sc) +
as.layer(plot(svm_Radial, scales = sc)))
svm_Radial$finalModel
# Número de pontos de suporte.
svm_Radial$finalModel@nSV
# Acurácia.
1 - error(svm_Radial$finalModel)
# str(svm_Radial$finalModel)
#-----------------------------------------------------------------------
# Usando kernel polinomial.
# Gride de configurações para tunning.
grid <- expand.grid(C = 2^seq(-2, 5),
degree = c(2, 3),
scale = 1,
KEEP.OUT.ATTRS = FALSE)
dim(grid)
trctrl <- trainControl(method = "cv",
number = 5,
returnResamp = "all",
savePredictions = "all")
# O parâmetro C já é avaliado em grid.
svm_Poly <- train(cult ~ .,
data = uva,
method = "svmPoly",
trControl = trctrl,
tuneGrid = grid)
svm_Poly
sc <- list(x = list(log = 2))
plot(svm_Poly, scales = sc)
xyplot(svm_Poly,
scales = sc,
type = c("p", "a"))
svm_Poly$finalModel
# Número de pontos de suporte.
svm_Poly$finalModel@nSV
# Acurácia.
1 - error(svm_Poly$finalModel)
```
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