Adiciona tutorial de naive Bayes.

parent 8194422a
......@@ -35,6 +35,8 @@ navbar:
href: tutorials/05-support-vector-machine.html
- text: "k vizinhos mais próximos"
href: tutorials/06-k-nearest-neighborhood.html
- text: "Bayes ingênuo"
href: tutorials/07-naive-bayes.html
- text: "Scripts"
icon: fa-file-text
href: scripts/
......
---
title: "Classificador de Bayes ingênuo"
author: Prof. Walmes M. Zeviani & Prof. Eduardo V. Ferreira
date: 2017-10-26
#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)
```
# Implementando o Naive Bayes para variáveis categóricas
* <http://www.di.fc.ul.pt/~jpn/r/naive_bayes/naivebayes.html>;
* <https://eight2late.wordpress.com/2015/11/06/a-gentle-introduction-to-naive-bayes-classification-using-r/>;
* <https://www.ncbi.nlm.nih.gov/pmc/articles/PMC4930525/>;
```{r}
rm(list = objects())
library(lattice)
library(latticeExtra)
```
```{r}
# Documentação dos dados.
# help(UCBAdmissions, help_type = "html")
# Carrega.
data(UCBAdmissions)
# Dados da forma de um array cúbico.
str(UCBAdmissions)
# Gráfico de mosaico.
mosaicplot(UCBAdmissions)
# Frequencia cruzada.
addmargins(margin.table(UCBAdmissions, 1:2))
# Transforma em tabela.
da <- as.data.frame(UCBAdmissions)
da
# Total de casos.
tot <- sum(da$Freq)
tot
# Divide nos níveis de Admit e calcula a marginal e todas as
# condicionais. Retorna as probabilidades.
probs <- by(data = da,
INDICES = da$Admit,
FUN = function(a_subset) {
with(a_subset, {
a <- as.character(a_subset$Admit[1])
# Freq(A = a) e Prob(A = a)
f_a <- sum(Freq)
p_a <- f_a/tot
# Freq(g | A = a) e Prob(g | A = a)
f_g.a <- tapply(Freq, Gender, sum)
p_g.a <- f_g.a/f_a
# Freq(d | A = a) e Prob(g | A = a).
f_d.a <- tapply(Freq, Dept, sum)
p_d.a <- f_d.a/f_a
cat("------------------------------\n")
cat(sprintf("P(A = %s): %0.3f", a, p_a), "\n\n")
cat(sprintf("P(G = %s | A = %s): %0.3f",
names(p_g.a), a, p_g.a),
sep = "\n")
cat("\n")
cat(sprintf("P(D = %s | A = %s): %0.3f",
names(p_d.a), a, p_d.a),
sep = "\n")
cat("\n")
probs <- (p_a) * outer(p_g.a, p_d.a, FUN = "*")
probs <- plyr::adply(probs, seq_along(dim(probs)))
names(probs) <- c("Gender", "Dept", a)
return(probs)
})
})
probs
# Fazendo a junção recursiva.
probs <- Reduce(merge, probs)
# probs
A <- levels(da$Admit)
probs$class <- A[apply(probs[, A],
MARGIN = 1,
FUN = which.max)]
probs
#-----------------------------------------------------------------------
# Repetindo com os dados do HairEyeColor.
HairEyeColor
# Transforma em tabela.
da <- as.data.frame(HairEyeColor)
da
# Total de casos.
tot <- sum(da$Freq)
tot
# Divide nos níveis de Eye e calcula a marginal e todas as
# condicionais. Retorna as probabilidades.
probs <- by(data = da,
INDICES = da$Eye,
FUN = function(a_subset) {
with(a_subset, {
a <- as.character(a_subset$Eye[1])
# Freq(A = a) e Prob(A = a)
f_a <- sum(Freq)
p_a <- f_a/tot
# Freq(g | A = a) e Prob(g | A = a)
f_g.a <- tapply(Freq, Sex, sum)
p_g.a <- f_g.a/f_a
# Freq(d | A = a) e Prob(g | A = a).
f_d.a <- tapply(Freq, Hair, sum)
p_d.a <- f_d.a/f_a
cat("------------------------------\n")
cat(sprintf("P(%s): %0.3f", a, p_a), "\n\n")
cat(sprintf("P(%s | %s): %0.3f",
names(p_g.a), a, p_g.a),
sep = "\n")
cat("\n")
cat(sprintf("P(%s | %s): %0.3f",
names(p_d.a), a, p_d.a),
sep = "\n")
cat("\n")
probs <- (p_a) * outer(p_g.a, p_d.a, FUN = "*")
probs <- plyr::adply(probs, seq_along(dim(probs)))
names(probs) <- c("Sex", "Hair", a)
return(probs)
})
})
# probs
# Fazendo a junção recursiva.
probs <- Reduce(merge, probs)
# probs
A <- levels(da$Eye)
probs$class <- A[apply(probs[, A],
MARGIN = 1,
FUN = which.max)]
probs
```
# Usando o pacote `e1071`
```{r}
library(e1071)
# help(naiveBayes, h = "html")
# Converte array para tabela.
hec <- as.data.frame(HairEyeColor)
# O dado está agregado. As linhas terão que ser repetidas baseado em
# Freq.
r <- rep(seq_len(nrow(hec)), hec$Freq)
hec$Freq <- NULL
hec <- hec[r, ]
str(hec)
# Faz o ajuste do modelo.
nb <- naiveBayes(Eye ~ Hair + Sex, data = hec)
# Classe e métodos.
class(nb)
methods(class = class(nb))
# Resultado.
nb
# pred <- with(hec,
# expand.grid(Sex = levels(Sex),
# Hair = levels(Hair),
# KEEP.OUT.ATTRS = FALSE))
pred <- probs[, c("Sex", "Hair")]
# As probabilidades para cada classe.
probs[, A]/rowSums(probs[, A])
predict(nb, newdata = pred, type = "raw")
# A classe predita.
pred$class <- predict(nb, newdata = pred, type = "class")
pred
```
# Classificação com preditoras numéricas
* <http://rischanlab.github.io/NaiveBayes.html>;
```{r}
splom(~iris[1:4], groups = iris$Species)
# nb <- naiveBayes(iris[, 1:4], iris[, 5])
nb <- naiveBayes(Species ~ ., data = iris)
nb
table(predict(nb, iris[, -5]), iris[, 5])
#-----------------------------------------------------------------------
# Determinar média e desvio-padrão amostral das preditoras para cada
# classe de iris.
meas <- c("mean", "sd")
res <- lapply(meas,
FUN = function(m) {
a <- aggregate(as.matrix(iris[, 1:4]) ~ Species,
data = iris,
FUN = m)
a <- reshape2::melt(a, id.vars = "Species")
names(a)[ncol(a)] <- m
return(a)
})
Reduce(merge, res)
f <- sprintf("~%s", paste(names(iris)[1:4], collapse = " + "))
densityplot(as.formula(f),
outer = TRUE,
data = iris,
lty = 2,
groups = Species,
scales = "free") +
glayer({
mx <- mean(x)
sdx <- sd(x)
panel.mathdensity(dmath = dnorm,
n = 303,
col = col.line,
args = list(mean = mx,
sd = sdx))
})
```
# Usando o pacote `caret`
TODO
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