Redes Neurais - Atividade Prática 2
Jessica Kubrusly
Departamento de Estatística
Universidade Federal Fluminense
Hoje vamos trabalhar com o mesmo banco de dados da última aula prática, sobre o custo de segurados para uma seguradora.
Rede Neural para Classificação
A diferença desta atividade para a anterior será na variável alvo. Em vez de prever o valor do custo de um segurado vamos prever se um segurado pode ser classificado como de alto custo ou não. Um cliente será classificado como de alto custo se o seu custo for maior que R$ 15.000.
A base de dados pode ser baixada pelo link https://www.kaggle.com/datasets/teertha/ushealthinsurancedataset
Após baixar a base para o seu computador você terá um arquivo
insurance.csv. Verifique se o diretório corrente está
correto com a função getwd(), se for necessário defina o
novo diretório corrente com a função setwd().
Leitura
Para ler esse arquivo no R use o comando a seguir.
base = read.csv2("insurance.csv",sep = ",")Para transformar a base em um tibble:
library(tidyverse)
base = tibble::as_tibble(base)
base## # A tibble: 1,338 × 7
## age sex bmi children smoker region charges
## <int> <chr> <chr> <int> <chr> <chr> <chr>
## 1 19 female 27.9 0 yes southwest 16884.924
## 2 18 male 33.77 1 no southeast 1725.5523
## 3 28 male 33 3 no southeast 4449.462
## 4 33 male 22.705 0 no northwest 21984.47061
## 5 32 male 28.88 0 no northwest 3866.8552
## 6 31 female 25.74 0 no southeast 3756.6216
## 7 46 female 33.44 1 no southeast 8240.5896
## 8 37 female 27.74 3 no northwest 7281.5056
## 9 37 male 29.83 2 no northeast 6406.4107
## 10 60 female 25.84 0 no northwest 28923.13692
## # … with 1,328 more rowsbase$charges = as.numeric(base$charges)
base$bmi = as.numeric(base$bmi)Como já foi adiantado, queremos nesta aula prever se um segurado é ou não de alto custo. Para isso será necessário criar uma nova variável, que será a variável alvo do nosso problema, que indica se o usuário é ou não de alto custo.
base = base %>% mutate(altocusto = ifelse(base$charges > 15000,"sim","nao"))
base## # A tibble: 1,338 × 8
## age sex bmi children smoker region charges altocusto
## <int> <chr> <dbl> <int> <chr> <chr> <dbl> <chr>
## 1 19 female 27.9 0 yes southwest 16885. sim
## 2 18 male 33.8 1 no southeast 1726. nao
## 3 28 male 33 3 no southeast 4449. nao
## 4 33 male 22.7 0 no northwest 21984. sim
## 5 32 male 28.9 0 no northwest 3867. nao
## 6 31 female 25.7 0 no southeast 3757. nao
## 7 46 female 33.4 1 no southeast 8241. nao
## 8 37 female 27.7 3 no northwest 7282. nao
## 9 37 male 29.8 2 no northeast 6406. nao
## 10 60 female 25.8 0 no northwest 28923. sim
## # … with 1,328 more rowsO Problema
Problema: ajustar um modelo de redes neurais para classificar os
segurados de alto custo em função da sua idade (age),
gênero (sex), índice de massa corporal (bmi),
número de filhos (children), hábito de fumar
(smoker) e região onde mora (region).
Perguntas:
- Este é um problema de regressão, classificação ou agrupamento?
## Classificação- Quem é a variável alvo nesta aplicação?
## A variável recém criada altocusto.- Quais os atributos que vamos usar?
## A idade, o gênero, o índice de massa corporal, número de filhos, hábito de fumar e região onde mora.- Todas as linhas da base original entram na base a ser analisada para esta aplicação?
## Sim.Divisão entre treino e teste
O próximo passo é separar a base em treino (70%) e teste (30%). A
base de treino será usada para ajustar o modelo. A base de teste será
usada mais adiante. Para fazer essa partição podemos usar a função
createDataPartition o pacote caret.
library(caret)A função createDataPartition é usada para criar uma
partição nos índices, depois dividimos a base em dois grupos de acordo
com os índices selecionados. Por isso o primeiro argumento da função são
os números de 1 até o índice da última linha da base que queremos
partir.
O argumento p indica a porcentagem da base que será
selecionada.
set.seed(123456789)
n = dim(base)[1]
indices_treino = createDataPartition(1:n,p=0.7)[[1]]
base_treino = base %>% slice(indices_treino)
base_teste = base[-indices_treino,]Padronização das variáveis.
É de extrema importância, principalmente para os modelos mais complexos, a padronização dos dados de entrada.
media = apply(base_treino |> select(age,bmi,children),2,mean)
desvp = apply(base_treino |> select(age,bmi,children),2,sd)
base_treino_ = base_treino |>
mutate(age = (age - media["age"])/(desvp["age"]),
bmi = (bmi - media["bmi"])/(desvp["bmi"]),
children = (children - media["children"])/(desvp["children"])) |>
select(-charges)Dessa vez a variável charge não foi incluída, isso
porque ela não será usada neste problema. Sua única função foi criar a
variável alvo altocusto.
O Modelo de Redes Neurais
Nessa atividade prática vamos ajusatar e analisar o modelo de redes neurais Perceptron Camada Única para classificar como alto custo ou não, considerando todas as covariáveis.
Ajuste do modelo
Nossa rede neural terá como covariáveis todas as 6 variáveis da base,
excluindo as variáveis (não observáveis) que queremos prever
charges e altocusto. Como a base apresenta
variáveis categóricas, primeiro precisamos transformá-las em
binárias.
matriz_treino_ <- model.matrix( ~ age + sex + bmi + children + smoker + region + altocusto,
data = base_treino_)
head(matriz_treino_)## (Intercept) age sexmale bmi children smokeryes
## 1 1 -1.4281508 0 -0.4542247 -0.92264756 1
## 2 1 -1.4985489 1 0.4946667 -0.08322621 0
## 3 1 -0.7945679 1 0.3701955 1.59561648 0
## 4 1 -0.5129755 1 -0.2958067 -0.92264756 0
## 5 1 -0.5833736 0 -0.8033909 -0.92264756 0
## 6 1 -0.1609850 0 -0.4800889 1.59561648 0
## regionnorthwest regionsoutheast regionsouthwest altocustosim
## 1 0 0 1 1
## 2 0 1 0 0
## 3 0 1 0 0
## 4 1 0 0 0
## 5 0 1 0 0
## 6 1 0 0 0Veja que inclusive a variável resposta, que é categórica, foi transformada em uma indicadora.
Vamos agora estimar os parâmetros do Perceptron.
library(neuralnet)
perceptron = neuralnet(formula = altocustosim ~ age + sexmale + bmi + children + smokeryes + regionnorthwest + regionsoutheast + regionsouthwest,
data = matriz_treino_,
err.fct = "ce",
linear.output = F, # Classification
hidden=0)
names(perceptron)## [1] "call" "response" "covariate"
## [4] "model.list" "err.fct" "act.fct"
## [7] "linear.output" "data" "exclude"
## [10] "net.result" "weights" "generalized.weights"
## [13] "startweights" "result.matrix"plot(perceptron, rep="best")
Previsão na base de treino
A previsão na base de treino é encontrada pelo comando
perceptron$net.result[[1]][,1].
prev_treino = perceptron$net.result[[1]][,1]
head(prev_treino)## 1 2 3 4 5 6
## 0.93155857 0.06778202 0.12004909 0.06250210 0.05427506 0.11870199Lembre-se que este é um problema de classificação, a variável alvo é
uma variável indicadora. A variável alvo não foi padronizada e os
valores de previsão já estão na escala correta. A previsão do modelo
pelo comando acima é um número entre 0 e 1. Quanto mais perto de 1 maior
a chance da instância ser altocustosm = 1, por outro lado,
quanto mais perto de 0 maior a chance de ser
altocustosm = 0.
Medida de desempenho na base de treino
Para problemas de classificação, uma medida de qualidade do ajuste pode ser a entropia cruzada: \[ CE = \dfrac{-1}{n} \sum_{i=1}^n \left( y_i \log(\hat{y}_i + (1-y_i)\log(1-\hat{y}_i)) \right) \] Vamos calcular a entropia cruzada para os dados de dentro da amostra.
n = dim(matriz_treino_)[1]
altocusto_treino = matriz_treino_[,"altocustosim"]
CE_treino = (-1/n)*(sum(altocusto_treino*log(prev_treino),(1-altocusto_treino)*log(1-prev_treino)))Classificação na base de treino
A nossa finalidade é prever a classe que pertence um segurado: alto
custo ou não. A decisão mais intuitiva é classificar como cliente de
alto custo aqueles com previsão para altocustosim maior que
0,5 e classificar como não alto custo caso contrário. Vamos ficar com
esse critério de classificação por enquanto, embora ele não seja o
melhor. Depois discutiremos isso com mais cuidado.
classe_prev_treino = ifelse(prev_treino<0.5,0,1)
head(classe_prev_treino)## 1 2 3 4 5 6
## 1 0 0 0 0 0Medida de desempenho da classificação
Para mensurar o quanto bom é um modelo de classificação podemos usar
a matriz de confusão. A matriz de confusão indica a quantidade de
previsões corretas e erradas em cada classe. Essa matriz pode ser
construída a partir da função confusionMatrix do pacote
caret, como mostrado no código a seguir.
classe_real_treino = matriz_treino_[,"altocustosim"]
MC_treino = confusionMatrix(table(classe_prev_treino,classe_real_treino))
MC_treino## Confusion Matrix and Statistics
##
## classe_real_treino
## classe_prev_treino 0 1
## 0 675 76
## 1 5 182
##
## Accuracy : 0.9136
## 95% CI : (0.8938, 0.9308)
## No Information Rate : 0.7249
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.7632
##
## Mcnemar's Test P-Value : 7.381e-15
##
## Sensitivity : 0.9926
## Specificity : 0.7054
## Pos Pred Value : 0.8988
## Neg Pred Value : 0.9733
## Prevalence : 0.7249
## Detection Rate : 0.7196
## Detection Prevalence : 0.8006
## Balanced Accuracy : 0.8490
##
## 'Positive' Class : 0
## Previsão na base de teste
Antes de calcular a previsão na base de teste precisamos replicar tudo que foi feito na base de treino na base de teste.
Primeiro a padronização realizada.
base_teste_ = base_teste |>
mutate(age = (age - media["age"])/(desvp["age"]),
bmi = (bmi - media["bmi"])/(desvp["bmi"])) |>
select(-charges)Depois o tratamento nas variáveis indicadoras.
matriz_teste_ <- model.matrix( ~ age + sex + bmi + children + smoker + region + altocusto,
data = base_teste_)A previsão na base de teste é encontrada com o uso da função
compute. Diferente do problema da aula passada, a função
compute retorna uma lista de tamanho 2 e a previsão está na
segunda posição desta lista. Sempre veja como é o retorno desta função
para saber como pegar os valores previstos.
prev_teste = (perceptron |> compute(matriz_teste_))[[2]][,1]Medida de desempenho na base de teste
A entropia cruzada para os dados de teste é dada pelo comando a seguir.
n = dim(matriz_teste_)[1]
altocusto_teste = matriz_teste_[,"altocustosim"]
CE_teste = (-1/n)*(sum(altocusto_teste*log(prev_teste),(1-altocusto_teste)*log(1-prev_teste)))Classificação na base de teste
Para classificar cada novo segurado vamos usar o mesmo critério da
base de treino. Se a previsão da variável altocustosim for
maior que 0,5 o segurado será considerado de alto custo.
classe_prev_teste = ifelse(prev_teste<0.5,0,1)
head(classe_prev_teste)## 1 2 3 4 5 6
## 0 0 0 0 0 0Medida de desempenho da classificação
A matriz de confusão da base de treino informa as medidas de qualidade da classificação para dados de fora da amostra.
classe_real_teste = matriz_teste_[,"altocustosim"]
MC_teste = confusionMatrix(table(classe_prev_teste,classe_real_teste))
MC_teste## Confusion Matrix and Statistics
##
## classe_real_teste
## classe_prev_teste 0 1
## 0 298 15
## 1 2 85
##
## Accuracy : 0.9575
## 95% CI : (0.9328, 0.9751)
## No Information Rate : 0.75
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.8815
##
## Mcnemar's Test P-Value : 0.003609
##
## Sensitivity : 0.9933
## Specificity : 0.8500
## Pos Pred Value : 0.9521
## Neg Pred Value : 0.9770
## Prevalence : 0.7500
## Detection Rate : 0.7450
## Detection Prevalence : 0.7825
## Balanced Accuracy : 0.9217
##
## 'Positive' Class : 0
## barplot(rbind(MC_treino[[4]],MC_teste[[4]]),
beside = T,
col=c("tomato","skyblue"),
legend.text = c("treino","teste"),
args.legend = list(x = "topright",inset = c(0,-0.15)),
las = 2)