O perceptron multicamadas é a combinação de vários neurônios artificiais organizados em camadas. A ideia principal é, partindo de uma rede perceptron de um único neurônio, e em vez de “imputar” os valores de cováveis neste neurônio vão entrar saídas de outras rede perceptron de camada única.
Vamos começar com o perceptron de camada única apresentado na Figura 1. Supondo 3 variáveis de entrada, são 4 parâmetros desconhecidos para serem estimados.
Perceptron camada única
Suponha agora que em vez desse único neurônio receber os valores das 3 covariáveis da base ele receba as saídas de outros perceptrons de camada única, e estes sim são alimentados pelos valores das covariáveis. A nova arquitetura da rede está apresentada na Figura 2. A rede, que antes tinha apenas um neurônio na camada de saída, agora possui uma camada oculra com mais 3 neurônios, total de 4 neurônios na rede. Esta rede possui 16 parâmetros desconhecidos.
Perceptron com 1 camada oculta de 3 neurônios
A camada oculta pode ter quantos neurônios a gente quiser, e puder estimar seus valores. Para o exemplo, a Figura 3 apresenta uma rede com uma camada oculta com 4 neurônios, que resulta em 21 parâmetros desconhecidos.
Perceptron com 1 camada oculta de 4 neurônios
Também podemos incluir quantas novas camadas quisermos, e pudermos estimar. Para o exemplo da Figura 4 a rede possui 2 camadas ocultas, a primeira com 4 neurônios e a segunda com 3. Para esta rede temos 31 parâmetros desconhecidos.
Perceptron com 2 camadas ocultas
Em comparação com o Perceptron camada única, a arquitetura dos perceptrons de múltiplas camadas são bem mais complexas.
Chamamos de camada de entrada a camada da rede representada pelas covariáveis, que é entendida como uma camada visível. Chamamos de camada de saída a última camada, com o(s) neurônio(s) de saída (já explico o caso de mais de um neurônio na saída), que também é visível. Por fim, chamamos de camadas ocultas todas as outras camadas da rede.
Arquitetura Perceptron Múltiplas Camadas
O número de parâmetros desconhecidos da rede depende do tamanho e da arquitetura da rede. Quanto mais camadas ocultas, mais parâmetros teremos e mais complexo o modelo é. É a complexidade das redes que capturam melhor padrões não lineares dos dados.
Cada neurônio da rede possui uma função de ativação, que para a rede perceptron será a função logística ou a função tnah.
Estas são as redes que vimos até agora, com uma única saída. A saída \(\hat{Y}\) pode ser a estimativa para uma variável resposta contínua \(Y\), dado algum problema de regressão, ou a estimativa para uma variável resposta indicadora \(Y\), dado algum problema de classificação. Veja que neste último caso consideramos \(Y= 1\) ou \(Y=0\) para indicar se a instância pertence ou não à classe de interesse. Sendo assim, cada instância pertence a uma de duas classes possíveis.
Perceptron com 1 camada oculta e 1 neurônio na camada de saída
No exemplo de rede apresentado na Figura 6 são 3 covariáveis de entrada, uma camada oculta (hide) com 4 neurônios e uma camada de saída com 1 neurônio. Cada seta na figura representa um peso sináptico \(w\) ou um limiar de ativação \(\theta\). O número de parâmetros desconhecidos neste exemplo é: \((3 + 1) \times 5 = 20\).
Já a rede apresentada Figura 7 possui duas camadas ocultas, a primeira com 4 neurônios e a segunda com 3. A camada de saída contém um único neurônio. Esta rede contém \[ (3 + 1) \times 8 + (4 + 1) \times 3 + (3+1) \times 1 = 16 + 15 + 4 = 35 \] parâmetros desconhecidos.
Perceptron com 2 camadas ocultas e 1 neurônio na camada de saída
Vamos continuar o exemplo dos dados de seguro. O objetivo é o mesmo de antes: criar um modelo de redes neurais para prever o gasto de um segurado.
library(caret)
library(tidyverse)
library(neuralnet)
library(pROC)
base = read_csv("insurance.csv")
set.seed(1234567890)
N = dim(base)[1]
indices_treino = createDataPartition(1:N,p=0.7)[[1]]
base_treino = base[indices_treino,]
base_teste = base[-indices_treino,]
scale = scale(base_treino$age)
age_ = scale[,1]
media_age = attr(scale,"scaled:center")
dp_age = attr(scale,"scaled:scale")
scale = scale(base_treino$bmi)
bmi_ = scale[,1]
media_bmi = attr(scale,"scaled:center")
dp_bmi = attr(scale,"scaled:scale")
scale = scale(base_treino$children)
children_ = scale[,1]
media_children = attr(scale,"scaled:center")
dp_children = attr(scale,"scaled:scale")
scale = scale(base_treino$charges)
charges_ = scale[,1]
media_charges = attr(scale,"scaled:center")
dp_charges = attr(scale,"scaled:scale")
#completar como ficam as variaveis quantitativas depos da base modificada
base_treino_ = base_treino |>
mutate(age = age_,
bmi = bmi_,
children = children_,
charges = charges_)
matriz_treino_ <- model.matrix( ~ age + sex + bmi + children + smoker + region + charges, data = base_treino_)
A função ‘neuralnet’ assume como valor padrão para
linear.output = TRUE e err.fct = "sse", que
são adequados para o caso de problemas de regressão. Neste exemplo não
atribuir valores para esses parâmetros e trabalhar com seus valores
padrão.
modelo_r_completo_0 = neuralnet(
charges ~ age + sexmale + bmi + children + smokeryes + regionnorthwest + regionsoutheast + regionsouthwest,
data = matriz_treino_,
hidden = 0)
plot(modelo_r_completo_0,rep = "best")
modelo_r_completo_2 = neuralnet(
charges ~ age + sexmale + bmi + children + smokeryes + regionnorthwest + regionsoutheast + regionsouthwest,
data = matriz_treino_,
hidden = 2)
plot(modelo_r_completo_2,rep = "best")
modelo_r_completo_2_2 = neuralnet(
charges ~ age + sexmale + bmi + children + smokeryes + regionnorthwest + regionsoutheast + regionsouthwest,
data = matriz_treino_,
hidden = c(2,2),
stepmax = 1e+06)
plot(modelo_r_completo_2_2,rep = "best")
prev_r_treino_0 = modelo_r_completo_0$net.result[[1]][,1]
prev_r_treino_0 = prev_r_treino_0*dp_charges + media_charges
prev_r_treino_2 = modelo_r_completo_2$net.result[[1]][,1]
prev_r_treino_2 = prev_r_treino_2*dp_charges + media_charges
prev_r_treino_2_2 = modelo_r_completo_2_2$net.result[[1]][,1]
prev_r_treino_2_2 = prev_r_treino_2_2*dp_charges + media_charges
real = base_treino$charges
n = length(real)
prev = prev_r_treino_0
MSE_treino_0 = sum((prev-real)^2)/n
prev = prev_r_treino_2
MSE_treino_2 = sum((prev-real)^2)/n
prev = prev_r_treino_2_2
MSE_treino_2_2 = sum((prev-real)^2)/n
| Modelo | MSE_treino |
|---|---|
| o camadas ocultas | 36530706 |
| 1 camada oculta | 19529214 |
| 2 camadas ocultas | 18655758 |
base_teste_ = base_teste |> mutate(age = (age - media_age)/dp_age ,
bmi = (bmi - media_bmi)/dp_bmi,
children = (children - media_children)/dp_children,
charges = (charges-media_charges)/dp_charges)
matriz_teste_ <- model.matrix( ~ age + sex + bmi + children + smoker + region + charges, data = base_teste_)
prev_r_teste_0 = (modelo_r_completo_0 |> neuralnet::compute(matriz_teste_))$net.result[,1]
prev_r_teste_0 = prev_r_teste_0*dp_charges + media_charges
prev_r_teste_2 = (modelo_r_completo_2 |> neuralnet::compute(matriz_teste_))$net.result[,1]
prev_r_teste_2 = prev_r_teste_2*dp_charges + media_charges
prev_r_teste_2_2 = (modelo_r_completo_2_2 |> neuralnet::compute(matriz_teste_))$net.result[,1]
prev_r_teste_2_2 = prev_r_teste_2_2*dp_charges + media_charges
real = base_teste$charges
n = length(real)
prev = prev_r_teste_0
MSE_teste_0 = sum((prev-real)^2)/n
prev = prev_r_teste_2
MSE_teste_2 = sum((prev-real)^2)/n
prev = prev_r_teste_2_2
MSE_teste_2_2 = sum((prev-real)^2)/n
O objetivo agora é criar um modelo de redes neurais para prever se um segurado é da classealto custo ou não.
base = base |>
mutate(altocusto = ifelse(base$charges > 15000,"sim","nao"))
base = base |> select(-charges)
Vamos separar base de treino e teste balanceadas. Isto é, mesma quantidade de cada clategoria em cada base. Para isso serão desconsideradas algumas observações. Mais pra frente vamos discutir este assunto.
N = dim(base)[1]
indices_altocusto_sim = which(base$altocusto=="sim")
indices_altocusto_nao = which(base$altocusto=="nao")
#criando uma base balanceada
n_s = length(indices_altocusto_sim)
n_n = length(indices_altocusto_nao)
if(n_s < n_n){
indices_altocusto_nao = sample(indices_altocusto_nao,size = n_s)
} else {
indices_altocusto_sim = sample(indices_altocusto_sim,size = n_n)
}
subbase = base[c(indices_altocusto_sim,indices_altocusto_nao),]
indices_treino = createDataPartition(subbase$altocusto,p=0.7)$Resample1
base_treino = subbase[indices_treino,]
base_teste = subbase[-indices_treino,]
| altocusto | treino | teste |
|---|---|---|
| nao | 251 | 107 |
| sim | 251 | 107 |
scale = scale(base_treino$age)
age_ = scale[,1]
media_age = attr(scale,"scaled:center")
dp_age = attr(scale,"scaled:scale")
scale = scale(base_treino$bmi)
bmi_ = scale[,1]
media_bmi = attr(scale,"scaled:center")
dp_bmi = attr(scale,"scaled:scale")
scale = scale(base_treino$children)
children_ = scale[,1]
media_children = attr(scale,"scaled:center")
dp_children = attr(scale,"scaled:scale")
#completar como ficam as variaveis quantitativas depos da base modificada
base_treino_ = base_treino |> mutate(age = age_,
bmi = bmi_,
children = children_)
matriz_treino_ <- model.matrix( ~ age + sex + bmi + children + smoker + region + altocusto, data = base_treino_)
Para os modelos de classificação é necessário mudar os valores dos
parâmetros linear.output e err.fct da função
neuralnet. Para a classificação a função de erro será
ce (entropia cruzada) e linear.output = F,
para que o neurônio da camada de saída tenha a mesma função de ativação
que os demais neurônios
#modelo completo
modelo_c_completo_0 = neuralnet(
altocustosim ~ age + sexmale + bmi + children + smokeryes + regionnorthwest + regionsoutheast + regionsouthwest,
data = matriz_treino_,
hidden = 0,
linear.output = FALSE,
err.fct = "ce")
plot(modelo_c_completo_0,rep = "best")
#modelo completo
modelo_c_completo_2 = neuralnet(
altocustosim ~ age + sexmale + bmi + children + smokeryes + regionnorthwest + regionsoutheast + regionsouthwest,
data = matriz_treino_,
hidden = 2,
linear.output = FALSE,
err.fct = "ce")
plot(modelo_c_completo_2,rep = "best")
#modelo completo
modelo_c_completo_2_2 = neuralnet(
altocustosim ~ age + sexmale + bmi + children + smokeryes + regionnorthwest + regionsoutheast + regionsouthwest,
data = matriz_treino_,
hidden = c(2,2),
linear.output = FALSE,
err.fct = "ce",
stepmax = 1e+06)
plot(modelo_c_completo_2_2,rep = "best")
prev_c_treino_0 = modelo_c_completo_0$net.result[[1]][,1]
prev_c_treino_2 = modelo_c_completo_2$net.result[[1]][,1]
prev_c_treino_2_2 = modelo_c_completo_2_2$net.result[[1]][,1]
EC = function(real,previsao){
ec = -mean(
ifelse(real==1,
log(previsao),
log(1-previsao)))
return(ec)
}
real = matriz_treino_[,"altocustosim"]
prev = prev_c_treino_0
EC_treino_0 = EC(real,prev)
prev = prev_c_treino_2
EC_treino_2 = EC(real,prev)
prev = prev_c_treino_2_2
EC_treino_2_2 = EC(real,prev)
| Redes Neurais | EC |
|---|---|
| Neuronio Único | 0.2988738 |
| 1 camada oculta | 0.2743764 |
| 2 camadas ocultas | 0.2516307 |
real = matriz_treino_[,"altocustosim"]
roc_0 = roc(response = real, predictor = prev_c_treino_0)
roc = roc_0
AUC_0 = as.numeric(roc$auc)
q_0 = coords(roc, "best", ret = "threshold")[1,1]
i = which(roc$thresholds==q_0)
plot.roc(roc,print.auc = TRUE)
points(x = roc$specificities[i],y=roc$sensitivities[i],col="red",pch=19)
roc_2 = roc(response = real, predictor = prev_c_treino_2)
roc = roc_2
AUC_2 = as.numeric(roc$auc)
q_2 = coords(roc, "best", ret = "threshold")[1,1]
i = which(roc$thresholds==q_2)
plot.roc(roc,print.auc = TRUE)
points(x = roc$specificities[i],y=roc$sensitivities[i],col="red",pch=19)
roc_2_2 = roc(response = real, predictor = prev_c_treino_2_2)
roc = roc_2_2
AUC_2_2 = as.numeric(roc$auc)
q_2_2 = coords(roc, "best", ret = "threshold")[1,1]
i = which(roc$thresholds==q_2_2)
plot.roc(roc,print.auc = TRUE)
points(x = roc$specificities[i],y=roc$sensitivities[i],col="red",pch=19)
cla_treino_0 = ifelse(prev_c_treino_0 < q_0,0,1)
tab_treino_0 = table(prev=cla_treino_0,real=real)
CM_treino_0 = confusionMatrix(tab_treino_0,positive = "1")
| 0 | 1 | |
|---|---|---|
| 0 | 247 | 54 |
| 1 | 4 | 197 |
cla_treino_2 = ifelse(prev_c_treino_2 < q_2,0,1)
tab_treino_2 = table(prev=cla_treino_2,real=real)
CM_treino_2 = confusionMatrix(tab_treino_2,positive = "1")
| 0 | 1 | |
|---|---|---|
| 0 | 242 | 39 |
| 1 | 9 | 212 |
cla_treino_2_2 = ifelse(prev_c_treino_2_2 < q_2_2,0,1)
tab_treino_2_2 = table(prev=cla_treino_2_2,real=real)
CM_treino_2_2 = confusionMatrix(tab_treino_2_2,positive = "1")
| 0 | 1 | |
|---|---|---|
| 0 | 251 | 46 |
| 1 | 0 | 205 |
#completar como ficam as variaveis quantitativas depos da base modificada
base_teste_ = base_teste |> mutate(age = (age - media_age)/dp_age,
bmi = (bmi - media_bmi)/dp_bmi,
children = (children - media_children)/dp_children)
matriz_teste_ <- model.matrix( ~ age + sex + bmi + children + smoker + region + altocusto, data = base_teste_)
prev_c_teste_0 = (modelo_c_completo_0 |> neuralnet::compute(matriz_teste_))$net.result[,1]
prev_c_teste_2 = (modelo_c_completo_2 |> neuralnet::compute(matriz_teste_))$net.result[,1]
prev_c_teste_2_2 = (modelo_c_completo_2_2 |> neuralnet::compute(matriz_teste_))$net.result[,1]
real = matriz_teste_[,"altocustosim"]
prev = prev_c_teste_0
EC_teste_0 = EC(real,prev)
prev = prev_c_teste_2
EC_teste_2 = EC(real,prev)
prev = prev_c_teste_2_2
EC_teste_2_2 = EC(real,prev)
| Redes Neurais | EC |
|---|---|
| Neuronio Único | 0.3791873 |
| 1 camada oculta | 0.4139094 |
| 2 camadas ocultas | 0.6477214 |
prev = prev_c_teste_0
q = q_0
cla_teste_0 = ifelse(prev<q,0,1)
tab_teste_0 = table(prev=cla_teste_0,real=real)
CM_teste_0 = confusionMatrix(tab_teste_0,positive = "1")
| 0 | 1 | |
|---|---|---|
| 0 | 105 | 31 |
| 1 | 2 | 76 |
prev = prev_c_teste_2
q = q_2
cla_teste_2 = ifelse(prev<q,0,1)
tab_teste_2 = table(prev=cla_teste_2,real=real)
CM_teste_2 = confusionMatrix(tab_teste_2,positive = "1")
| 0 | 1 | |
|---|---|---|
| 0 | 92 | 27 |
| 1 | 15 | 80 |
prev = prev_c_teste_2_2
q = q_2_2
cla_teste_2_2 = ifelse(prev<q,0,1)
tab_teste_2_2 = table(prev=cla_teste_2_2,real=real)
CM_teste_2_2 = confusionMatrix(tab_teste_2_2,positive = "1")
| 0 | 1 | |
|---|---|---|
| 0 | 100 | 28 |
| 1 | 7 | 79 |
| Neurônio Único | 1 camada oculta | 2 camadas ocultas | |
|---|---|---|---|
| Sensitivity | 0.7848606 | 0.8446215 | 0.8167331 |
| Specificity | 0.9840637 | 0.9641434 | 1.0000000 |
| Pos Pred Value | 0.9800995 | 0.9592760 | 1.0000000 |
| Neg Pred Value | 0.8205980 | 0.8612100 | 0.8451178 |
| Precision | 0.9800995 | 0.9592760 | 1.0000000 |
| Recall | 0.7848606 | 0.8446215 | 0.8167331 |
| F1 | 0.8716814 | 0.8983051 | 0.8991228 |
| Neurônio Único | 1 camada oculta | 2 camadas ocultas | |
|---|---|---|---|
| Sensitivity | 0.7102804 | 0.7476636 | 0.7383178 |
| Specificity | 0.9813084 | 0.8598131 | 0.9345794 |
| Pos Pred Value | 0.9743590 | 0.8421053 | 0.9186047 |
| Neg Pred Value | 0.7720588 | 0.7731092 | 0.7812500 |
| Precision | 0.9743590 | 0.8421053 | 0.9186047 |
| Recall | 0.7102804 | 0.7476636 | 0.7383178 |
| F1 | 0.8216216 | 0.7920792 | 0.8186528 |