LVQ

O algoritmo de quantização de vetores de aprendizagem (LVQ) é um algoritmo de rede neural artificial que permite escolher quantas instâncias de treinamento você deseja trabalhar e aprende exatamente como elas devem ser.

Preparando os dados

.

library(class)
library(e1071)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(caret)
## Loading required package: lattice
## Loading required package: ggplot2
abalone <- read.csv("abalone.csv", header =T)
suppressWarnings(suppressMessages(library(dplyr)))

Criando a coluna sexo numérica

abalone <- abalone %>%
  mutate(sex_num =case_when(
    sex %in% 'M' ~ 0,
    sex %in% "F"  ~ 1,
    sex %in% "I" ~ 2
  ))

Criando a coluna da Idade

abalone <- abalone %>%
  mutate(age=case_when(
    rings %in% 1:5 ~ "young",
    rings %in% 6:13 ~ "adult",
    rings %in% 14:30 ~ "old"
  ))

removendo rings, sex

abalone <- abalone[c(-1, -9)]
str(abalone)
## 'data.frame':    4177 obs. of  9 variables:
##  $ length  : num  0.455 0.35 0.53 0.44 0.33 0.425 0.53 0.545 0.475 0.55 ...
##  $ diameter: num  0.365 0.265 0.42 0.365 0.255 0.3 0.415 0.425 0.37 0.44 ...
##  $ height  : num  0.095 0.09 0.135 0.125 0.08 0.095 0.15 0.125 0.125 0.15 ...
##  $ ww      : num  0.514 0.226 0.677 0.516 0.205 ...
##  $ sw      : num  0.2245 0.0995 0.2565 0.2155 0.0895 ...
##  $ vw      : num  0.101 0.0485 0.1415 0.114 0.0395 ...
##  $ shell   : num  0.15 0.07 0.21 0.155 0.055 0.12 0.33 0.26 0.165 0.32 ...
##  $ sex_num : num  0 0 1 0 2 2 1 1 0 1 ...
##  $ age     : chr  "old" "adult" "adult" "adult" ...

Dividindo os dados em conjunto de treino e teste

### A variável dependente é idade, com diferentes valores: Jovem, adulto e idoso.
### standardize the predictors
set.seed(100)
abalone_scale <- data.frame(scale(abalone[1:8]))
### add the target variable to the data set abalone_scale 
abalone$age <- as.factor(abalone$age)
abalone_scale  <- cbind(abalone_scale, age = abalone$age)
i <- sample(4177, 2088)
abalone_train <- abalone_scale[i,]
abalone_test <- abalone_scale[-i,]

Convertendo os dataframes divididos em matrizes

treino = data.matrix(abalone_train[, c("length","diameter","height","ww","sw","vw","shell","sex_num","age")])
teste = data.matrix(abalone_test[, c("length","diameter","height","ww","sw","vw","shell","sex_num","age")])
 
treino_label = factor(abalone_train[, "age"])
teste_label = abalone_test$age

Construíndo um codebook para o LVQ

codeBook = lvqinit(treino, treino_label, size = 100)

olvq1() representa o conjunto de treinamento em um codebook

buildCodeBook = olvq1(treino, treino_label, codeBook)

Predição

predict = lvqtest(buildCodeBook, teste)

Criando a Matriz de confusão para verificar a acurácia da predição

confusionMatrix(teste_label, predict)
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction adult  old young
##      adult  1744    3     0
##      old      33  215     0
##      young     1    0    93
## 
## Overall Statistics
##                                           
##                Accuracy : 0.9823          
##                  95% CI : (0.9757, 0.9875)
##     No Information Rate : 0.8511          
##     P-Value [Acc > NIR] : < 2.2e-16       
##                                           
##                   Kappa : 0.9353          
##                                           
##  Mcnemar's Test P-Value : NA              
## 
## Statistics by Class:
## 
##                      Class: adult Class: old Class: young
## Sensitivity                0.9809     0.9862      1.00000
## Specificity                0.9904     0.9824      0.99950
## Pos Pred Value             0.9983     0.8669      0.98936
## Neg Pred Value             0.9006     0.9984      1.00000
## Prevalence                 0.8511     0.1044      0.04452
## Detection Rate             0.8348     0.1029      0.04452
## Detection Prevalence       0.8363     0.1187      0.04500
## Balanced Accuracy          0.9856     0.9843      0.99975

Observação na Matriz de confusão

No KNN usamos a função tune.knn que realiza uma validação cruzada dez vezes até encontrar o melhor valor de k, mesmo assim o LVQ obteve uma acurácia superior. Em destaque nós percebemos que em relação aos idosos o KNN foi aquém das expectativas, enquanto que o lvq superou as expectativas.