Conclui tutorial de análise discriminante.

parent a11dd34c
---
title: "Classificador de Bayes ingênuo"
title: "Análise discriminante"
author: Prof. Walmes M. Zeviani & Prof. Eduardo V. Ferreira
date: 2017-10-26
#bibliography: ../config/Refs.bib
......@@ -14,6 +14,351 @@ opts_chunk$set(
warning = FALSE)
```
# Análise discriminante linear
* <https://machinelearningmastery.com/linear-classification-in-r/>
* <https://topepo.github.io/caret/available-models.html>
* <http://archive.ics.uci.edu/ml/datasets.html>
* <http://scikit-learn.org/stable/modules/lda_qda.html>
* <https://www.researchgate.net/publication/308015273_Linear_vs_quadratic_discriminant_analysis_classifier_a_tutorial>
```{r}
# Pacotes.
library(lattice)
library(latticeExtra)
library(MASS)
library(ellipse)
library(mvtnorm)
#-----------------------------------------------------------------------
# Usando um par de preditoras para visualizar a fronteira.
# Obtendo a matriz de covariância residual.
X <- as.matrix(subset(iris, select = c(Sepal.Length, Sepal.Width)))
Xs <- by(X,
INDICES = iris$Species,
FUN = scale,
center = TRUE,
scale = FALSE)
X <- do.call(rbind, Xs)
Sigma <- var(X)
# Dados centrados removendo efeito de Species, escala preservada.
xyplot(X[, 2] ~ X[, 1],
groups = iris$Species,
aspect = "iso") +
layer(panel.ellipse(..., groups = NULL, col = 1))
# Elipses para cada espécie e comum.
xyplot(Sepal.Width ~ Sepal.Length,
groups = Species,
aspect = "iso",
data = iris) +
layer(panel.ellipse(...)) +
glayer({
ell <- ellipse(Sigma,
level = 0.68,
centre = c(mean(x), mean(y)))
print(head(ell))
panel.lines(ell, col = col.line, lty = 2)
})
# Ajuste do modelo.
fit <- lda(Species ~ Sepal.Length + Sepal.Width,
data = iris)
fit
# Para apresentar a fronteira.
grid <- with(iris,
expand.grid(
Sepal.Length = seq(min(Sepal.Length),
max(Sepal.Length),
length.out = 41),
Sepal.Width = seq(min(Sepal.Width),
max(Sepal.Width),
length.out = 41),
KEEP.OUT.ATTRS = FALSE))
grid$pred <- predict(fit, newdata = grid)$class
str(grid)
# Gráfico com pontos, classficações, fronteira e elipses de confiança.
xyplot(Sepal.Width ~ Sepal.Length,
data = iris,
groups = Species,
pch = 19) +
latticeExtra::layer(panel.xyplot(x = Sepal.Length,
y = Sepal.Width,
groups = pred,
subscripts = seq_along(pred),
pch = 4),
data = grid) +
latticeExtra::glayer({
ell <- ellipse(Sigma,
level = 0.68,
centre = c(mean(x), mean(y)))
panel.lines(ell, col = 1)
}) +
latticeExtra::layer(panel.ellipse(..., lwd = 2))
# Avaliando a densidade das normais multivariadas.
dens <- by(iris[, 1:2],
iris$Species,
FUN = function(x) {
m <- colMeans(x)
p <- nrow(x)/nrow(iris)
p * dmvnorm(grid[, 1:2],
mean = m,
sigma = Sigma)
})
dens <- as.data.frame(do.call(cbind, dens[1:3]))
grid <- cbind(grid, dens)
str(grid)
wp <- wireframe(setosa + versicolor + virginica ~
Sepal.Length + Sepal.Width,
zlab = "Densidade",
data = grid,
par.settings = simpleTheme(alpha = 0.7))
wp
# Vendo de cima.
update(wp,
par.settings = simpleTheme(alpha = 1),
screen = list(x = 0, z = 0, y = 0))
# library(wzRfun)
# library(rpanel)
# rp.wire(wp)
# Predições.
yp <- predict(fit)$class
# Acurácia.
tb <- table(yp, iris$Species)
tb
sum(diag(tb))/sum(tb)
#-----------------------------------------------------------------------
# Usando todas as variáveis.
# Ajuste do modelo.
fit <- lda(Species ~ .,
data = iris)
fit
# Predições.
yp <- predict(fit)$class
# Acurácia.
tb <- table(yp, iris$Species)
tb
sum(diag(tb))/sum(tb)
```
# Análise discriminante quadrática
```{r}
# Ajuste do modelo.
fit <- qda(Species ~ Sepal.Length + Sepal.Width,
data = iris)
fit
# Para apresentar a fronteira.
grid$pred <- predict(fit, newdata = grid)$class
str(grid)
# Gráfico com pontos, classficações, fronteira e elipses de confiança.
xyplot(Sepal.Width ~ Sepal.Length,
data = iris,
groups = Species,
pch = 19) +
layer(panel.xyplot(x = Sepal.Length,
y = Sepal.Width,
groups = pred,
subscripts = seq_along(pred),
pch = 4),
data = grid,
under = TRUE) +
glayer({
ell <- ellipse(Sigma,
level = 0.68,
centre = c(mean(x), mean(y)))
print(head(ell))
panel.lines(ell, col = 1)
}) +
layer(panel.ellipse(..., lwd = 2))
# Avaliando a densidade das normais multivariadas.
grid <- subset(grid, select = setdiff(names(grid), names(dens)))
dens <- by(iris[, 1:2],
iris$Species,
FUN = function(x) {
m <- colMeans(x)
p <- nrow(x)/nrow(iris)
p * dmvnorm(grid[, 1:2],
mean = m,
sigma = var(x))
})
dens <- as.data.frame(do.call(cbind, dens[1:3]))
grid <- cbind(grid, dens)
str(grid)
wp <- wireframe(setosa + versicolor + virginica ~
Sepal.Length + Sepal.Width,
zlab = "Densidade",
data = grid,
par.settings = simpleTheme(alpha = 0.5))
wp
# Vendo de cima.
update(wp,
par.settings = simpleTheme(alpha = 1),
screen = list(x = 0, z = 0, y = 0))
# Predições.
yp <- predict(fit)$class
# Acurácia.
tb <- table(yp, iris$Species)
tb
sum(diag(tb))/sum(tb)
#-----------------------------------------------------------------------
# Usando todas as variáveis.
# Ajuste do modelo.
fit <- qda(Species ~ .,
data = iris)
fit
# Predições.
yp <- predict(fit)$class
# Acurácia.
tb <- table(yp, iris$Species)
tb
sum(diag(tb))/sum(tb)
```
# Dados de uva
```{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)
m1 <- lda(cult ~ ., data = uva)
m1
m2 <- qda(cult ~ ., data = uva)
m2
y1 <- predict(m1)$class
y2 <- predict(m2)$class
tb1 <- table(y1, uva$cult)
tb1
sum(diag(tb1))/sum(tb1)
tb2 <- table(y2, uva$cult)
tb2
sum(diag(tb2))/sum(tb2)
```
# Usando o pacote `caret`
* <https://topepo.github.io/caret/available-models.html>
## Exemplo com o `iris`
```{r}
#-----------------------------------------------------------------------
library(caret)
# Criando as partições de treino e validação.
set.seed(135)
intrain <- createDataPartition(y = iris$Species,
p = 0.75,
list = FALSE)
data_train <- iris[intrain, ]
data_test <- iris[-intrain, ]
# Parametriza a valiação cruzada.
trctrl <- trainControl(method = "repeatedcv",
number = 10,
repeats = 3)
fit1 <- train(Species ~ .,
data = data_train,
method = "lda",
trControl = trctrl)
fit1
# Predição e matriz de confusão.
yp1 <- predict(fit1, newdata = data_test)
confusionMatrix(yp1, data_test$Species)
fit2 <- train(Species ~ .,
data = data_train,
method = "qda",
trControl = trctrl)
fit2
# Predição e matriz de confusão.
yp2 <- predict(fit2, newdata = data_test)
confusionMatrix(yp2, data_test$Species)
```
## Exemplo com o conjunto de dados de folhas de uva
```{r}
#-----------------------------------------------------------------------
# Criando as partições de treino e validação.
set.seed(135)
intrain <- createDataPartition(y = uva$cult,
p = 0.75,
list = FALSE)
data_train <- uva[intrain, ]
data_test <- uva[-intrain, ]
fit1 <- train(cult ~ .,
data = data_train,
method = "lda",
trControl = trctrl)
fit1
# Predição e matriz de confusão.
yp1 <- predict(fit1, newdata = data_test)
confusionMatrix(yp1, data_test$cult)
fit2 <- train(cult ~ .,
data = data_train,
method = "qda",
trControl = trctrl)
fit2
# Predição e matriz de confusão.
yp2 <- predict(fit2, newdata = data_test)
confusionMatrix(yp2, data_test$cult)
```
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