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

Cria tutorial apenas com as aplicações.

parent a897ae34
---
title: "Aplicações de SVM"
author: Prof. Walmes M. Zeviani & Prof. Eduardo V. Ferreira
date: 2017-10-10
#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)
```
# Aplicações em conjuntos de dados reais
## 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
pesquisador
[João Peterson Pereira Gardin](https://www.researchgate.net/profile/Joao_Gardin).
Os valores de área das folhas foram determinados por análise de imagem
das folhas digitalizadas por scanner usando o pacote
[EBImage](http://bioconductor.org/packages/release/bioc/html/EBImage.html).
```{r}
#-----------------------------------------------------------------------
# Dados hospedados na web.
url <- "http://www.leg.ufpr.br/~walmes/data/areafoliarUva.txt"
uva <- read.table(url, header = TRUE, sep = "\t",
stringsAsFactors = FALSE)
uva$cult <- factor(uva$cult)
uva$id <- NULL
# Comprimento da nervura lateral: média dos lados direito e esquerdo.
uva$nl <- with(uva, apply(cbind(nld, nle), 1, mean))
uva <- subset(uva, select = -c(nld, nle))
str(uva)
splom(uva[-(1:2)],
groups = uva$cult,
auto.key = TRUE,
cex = 0.2)
```
```{r, fig.height = 12}
splom(~uva[-(1:2)] | uva$cult,
cex = 0.2,
layout = c(1, NA))
```
```{r, eval = FALSE, include = FALSE}
# Testando componentes principais.
u <- scale(uva[, -1])
pr <- princomp(x = u)
screeplot(pr, type = "lines")
biplot(pr)
plot(pr$scores[, 1:2],
col = as.integer(uva$cult))
abline(v = 0, h = 0, lty = 2)
```
## 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")
table(da$cult)
m0 <- ksvm(cult ~ ., data = da)
m0
# Classe e funções disponíveis.
class(m0)
isS4(m0)
methods(class = class(m0))
# Número de vetores de suporte.
nSV(m0)
# Classficação nas observações de treino.
table(fitted(m0))
# Erro de classificação.
error(m0)
# Parâmetros.
param(m0)
# Só funciona para classificações binárias com duas preditoras.
# plot(m0)
splom(~da[, -1] | da$cult,
groups = fitted(m0),
auto.key = list(title = "Classificação"))
# Matriz de confusão.
ct <- table(fitted(m0), da$cult)
prop.table(ct)
# Percentual de acerto na classificação.
100 * sum(diag(ct))/sum(ct)
#-----------------------------------------------------------------------
# Parametrizando a chamada do método.
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.
m0
# Matriz de confusão.
ct <- table(uva$cult, fitted(m0))
prop.table(ct)
# Gráfico de mosaico da matriz de confusão.
mosaicplot(ct,
color = brewer.pal(n = nlevels(uva$cult),
name = "Spectral"))
# Percentual de acerto na classificação.
100 * sum(diag(ct))/sum(ct)
#-----------------------------------------------------------------------
# Mais variações.
# Para diminuir o número de vetores de suporte.
m0 <- ksvm(cult ~ .,
data = uva,
scaled = TRUE,
type = "C-svc",
kernel = "rbfdot",
kpar = list(sigma = 0.01),
C = 1e5,
cross = 10)
m0
# Kernel linear (baunilha).
m0 <- ksvm(cult ~ .,
data = uva,
scaled = TRUE,
type = "nu-svc",
kernel = "vanilladot",
nu = 0.5,
cross = 10)
m0
# Percentual de acerto na classificação.
ct <- table(fitted(m0), uva$cult)
100 * sum(diag(ct))/sum(ct)
```
## Pacote `e1071`
```{r}
library(e1071)
# Especificação com fórmula.
m1 <- svm(cult ~ .,
data = uva)
summary(m1)
str(m1)
# Quantidade e coordenadas dos pontos de suporte.
m1$tot.nSV
m1$nSV
head(m1$SV)
#-----------------------------------------------------------------------
# Fazendo a tunagem com a grid search.
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)))
print(tune)
str(tune)
# A superfície do erro.
levelplot(error ~ log10(cost) + log2(gamma),
data = tune$performances,
contour = TRUE) +
layer(panel.abline(v = log10(cost), h = log2(gamma), lty = 2),
data = tune$best.model)
# Usando os valores otimizados na validação cruzada.
m2 <- svm(cult ~ .,
data = uva,
kernel = "radial",
cost = tune$best.model$cost,
gamma = tune$best.model$gamma)
summary(m2)
yfit <- predict(m2)
ct <- table(yfit, y)
sum(diag(ct))/sum(ct)
```
O código abaixo foi aperfeiçoado do material
<http://rischanlab.github.io/SVM.html> e trabalha os dados de especies
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.
# Nomes das funções kernel.
ker <- c("linear", "polynomial", "radial", "sigmoid")
svm0 <- sapply(ker,
simplify = FALSE,
FUN = function(k) {
svm(Species ~ Petal.Length + Sepal.Length,
data = iris,
kernel = k)
})
lapply(svm0, summary)
# Tabelas de confusão.
lapply(svm0,
FUN = function(model) {
ct <- table(iris$Species, predict(model))
cat("Acertos:", 100 * sum(diag(ct))/sum(ct), "\n")
return(ct)
})
# Gerando um grid no retângulo que contém os pontos.
grid <- with(iris,
expand.grid(Sepal.Length = seq(min(Sepal.Length),
max(Sepal.Length),
l = 51),
Petal.Length = seq(min(Petal.Length),
max(Petal.Length),
l = 51)))
y <- lapply(svm0, FUN = predict, newdata = grid)
y <- lapply(y, as.data.frame)
names(y) <- ker
y <- plyr::ldply(y)
names(y) <- c("kernel", "y")
grid <- cbind(grid, y)
str(grid)
# Exibindo a fronteira de classificação.
xyplot(Petal.Length ~ Sepal.Length | kernel,
data = grid,
groups = y,
pch = 3,
as.table = TRUE,
aspect = 1,
auto.key = TRUE) +
as.layer(xyplot(Petal.Length ~ Sepal.Length,
data = iris,
pch = 19,
groups = Species))
```
## Pacote `caret`
Adaptação feita baseada no material <http://dataaspirant.com/2017/01/19/support-vector-machine-classifier-implementation-r-caret-package/>.
```{r}
library(caret)
set.seed(1234)
# Especificação da validação cruzada.
trctrl <- trainControl(method = "repeatedcv",
number = 10,
repeats = 3)
# Ajuste.
svm_Linear <- train(cult ~ .,
data = uva,
method = "svmLinear",
trControl = trctrl,
preProcess = c("center", "scale"),
tuneLength = 10)
# Resultado do ajuste.
svm_Linear
str(svm_Linear)
# Mostra que foi feito a chamada da kernlab::ksvm().
svm_Linear$finalModel
# Matriz de confusão.
confusionMatrix(uva$cult, predict(svm_Linear))
#-----------------------------------------------------------------------
# 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))
svm_Linear_Grid <- train(cult ~ .,
data = uva,
method = "svmLinear",
trControl = trctrl,
preProcess = c("center", "scale"),
tuneGrid = grid,
tuneLength = 10)
svm_Linear_Grid
plot(svm_Linear_Grid)
#-----------------------------------------------------------------------
# Usando kernel radial.
svm_Radial <- train(Species ~ .,
data = iris,
method = "svmRadial",
trControl = trctrl,
preProcess = c("center", "scale"),
tuneLength = 10)
svm_Radial
plot(svm_Radial)
```
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