Função para estudar os parâmetros do modelo
Neste projeto será feito um estudo de simulação para encontrar o melhor caminho para a Tuning dos hiperparâmetros do modelo de rede neural. Usaremos uma rede neural com 1 camada inicial e 1 camada interna. Abaixo uma função para gerar a simulação.
estuda_rede <- function(X_train,
X_test,
Y_train,
Y_test,
neurons1,
neurons2,# Numeric Vector
batch_size, # Numeric Vector
epochs, # Numeric Vector
dropout1, # Numeric Vector
dropout2, # Numeric Vector
optimizer = c("Adam","RMSprop"),
loss = c("categorical_hinge","categorical_crossentropy"),
activation1 = c("relu","elu"),
activation2 = c("relu","elu"),
last_activation = c("softmax","softplus")){
require(progress)
a=b=c=d=e=f=g=h=i=j=n=1
combinations <- data.frame(neurons1 = NA,
neurons2 = NA,
batch_size = NA,
epochs = NA,
dropout1 = NA,
dropout2 = NA,
optimizer = NA,
loss = NA,
activation1 = NA,
activation2 = NA,
last_activation = NA)
n <- length(neurons1)*length(neurons2)*length(batch_size)*length(epochs)*length(dropout1)*
length(dropout2)*length(optimizer)*length(loss)*length(activation1)*
length(activation2)*length(last_activation)
cat("Total of combinations: ",n,"\nCalculating combinations \n")
for(a in 1:length(neurons1)){
for(b in 1:length(neurons2)){
for(c in 1:length(batch_size)){
for(d in 1:length(epochs)){
for(e in 1:length(dropout1)){
for(f in 1:length(dropout2)){
for(g in 1:length(optimizer)){
for(h in 1:length(loss)){
for(i in 1:length(activation1)){
for(j in 1:length(activation2)){
for(l in 1:length(last_activation)){
aux <- data.frame(neurons1 = neurons1[a],
neurons2 = neurons2[b],
batch_size = batch_size[c],
epochs = epochs[d],
dropout1 = dropout1[e],
dropout2 = dropout2[f],
optimizer = optimizer[g],
loss = loss[h],
activation1 = activation1[i],
activation2 = activation2[j],
last_activation = last_activation[l])
combinations <- rbind.data.frame(combinations,aux)
}
}
}
}
}
}
}
}
}
}
}
perda <- numeric(n)
res <- numeric(n)
combinations <- na.omit(combinations)
for(k in 1:n){
cat("\n Treinamento",k,"de ",n)
rnn_model <- keras_model_sequential()
rnn_model %>%
layer_dense(units = combinations$neurons1[k],
activation = combinations$activation1[k],
input_shape = ncol(X_train)) %>%
layer_dropout(rate = combinations$dropout1[k]) %>%
layer_dense(units = combinations$neurons2[k], activation = combinations$activation2[k]) %>%
layer_dropout(rate = combinations$dropout2[k]) %>%
layer_dense(units = ncol(Y_train), activation = combinations$last_activation[k])
if(combinations$optimizer[k]=="Adam"){
rnn_model %>% compile(
loss = combinations$loss[k], #categorical_accuracy
optimizer = optimizer_adam(),
metrics = c('accuracy')
)
}
else{
rnn_model %>% compile(
loss = combinations$loss[k], #categorical_accuracy
optimizer = optimizer_rmsprop(),
metrics = c('accuracy')
)
}
history <- rnn_model %>% fit(
X_train, Y_train,
epochs = combinations$epochs[k], batch_size = combinations$batch_size[k],
validation_split = 0.2,verbose = 0)
resu <- rnn_model %>%
evaluate(X_test, Y_test,verbose = 0)
perda[k] <- resu[[1]]
res[k] <- resu[[2]]
}
combinations <- combinations %>%
mutate(acc = res,
loss_value = perda)
return(as_tibble(combinations))
}Os parâmetros considerados para fazer as simulações serão:
- Neurônios da primeira cadama: 256;
- Neurônios da camada interna: 128;
- Batch Size: 128 e 100;
- Épocas: 10,15 e 20;
- Dropout da primeira camada: 30% e 40%;
- Dropout da camada interna: 20% e 10%;
- Otimizador: Adam e RMSprop;
- Função de perda: Hinge e Entropia cruzada;
- Função de ativação: Relu e Elu;
- Função de ativação da última camada: Softmax e Softplus;
As simulações deram um total de 768 combinações. Levou um total aproximado de 10h para gerar os dados para este estudo.
Análise estatística com os resultados da simulação
Para a análise estatística vamos utilizar a regressão beta através do pacote gamlss. Existe também o pacote betareg porém o mesmo não possui algoritmo de seleção de variáveis. Os resíduos gerados pelo gamlss seguem uma distribuição normal assintótica, e sendo assim, é interesse garantir que estes sejam normais e independentes. Além disso o gamlss possue um gráfico de resíduos chamado warm plot. Ele funciona como um gráfico de envelope. Para mais detalhes ler o livro do gamlss.
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.09869 0.96585 0.97017 0.96186 0.97269 0.97789res %>%
ggplot(aes(acc)) +
geom_histogram(bins = 30,colour = "black",fill = "white") +
theme_minimal() +
scale_x_continuous(labels = scales::percent_format())
Note que houveram valores de acúracia que foram muito baixos. Vamos entao fazer um modelo sem esses valores. Antes de estimar um modelo, vamos fazer uma pequena análise gráfica.
res %>%
filter(acc>0.5) %>%
ggplot(aes(acc)) +
geom_histogram(bins = 30,colour = "black",fill = "white") +
theme_minimal() +
scale_x_continuous(labels = scales::percent_format())
res %>%
filter(acc>0.5) %>%
ggplot(aes(factor(batch_size),acc)) +
geom_boxplot() +
theme_minimal() +
scale_y_continuous(labels = scales::percent_format())
res %>%
filter(acc>0.5) %>%
ggplot(aes(factor(epochs),acc)) +
geom_boxplot() +
theme_minimal() +
scale_y_continuous(labels = scales::percent_format())
res %>%
filter(acc>0.5) %>%
ggplot(aes(factor(dropout1),acc)) +
geom_boxplot() +
theme_minimal()+
scale_y_continuous(labels = scales::percent_format())
res %>%
filter(acc>0.5) %>%
ggplot(aes(factor(dropout2),acc)) +
geom_boxplot() +
theme_minimal()+
scale_y_continuous(labels = scales::percent_format())
res %>%
filter(acc>0.5) %>%
ggplot(aes(factor(optimizer),acc)) +
geom_boxplot() +
theme_minimal()+
scale_y_continuous(labels = scales::percent_format())
res %>%
filter(acc>0.5) %>%
ggplot(aes(factor(loss),acc)) +
geom_boxplot() +
theme_minimal() +
scale_y_continuous(labels = scales::percent_format())
res %>%
filter(acc>0.5) %>%
ggplot(aes(factor(activation1),acc)) +
geom_boxplot() +
theme_minimal()+
scale_y_continuous(labels = scales::percent_format())
res %>%
filter(acc>0.5) %>%
ggplot(aes(factor(activation2),acc)) +
geom_boxplot() +
theme_minimal()+
scale_y_continuous(labels = scales::percent_format())
res %>%
filter(acc>0.5) %>%
ggplot(aes(factor(last_activation),acc)) +
geom_boxplot() +
theme_minimal()+
scale_y_continuous(labels = scales::percent_format())
Descobertas interessantes:
- Quanto maior o número de epócas maior a acúracia, sendo que a variância e assimetria também diminuem.
- A função de perda de entropia cruzada fornece melhor acúracia com uma menor variância se comparada a hinge, que varia muito mais e que possui mediana inferior.
- A função de ativação da primeira camada é muito mais importante do que a da camada intermédiaria. Além disso, a função relu apresenta um desempenho bastante superior se comparado com a função relu, pois a variância é bastante pequena, onde o quartil de 75% da função relu é maior que o de 25% da função elu.
- A função de ativação softplus para a camada de saída é superior a softmax, porém , não muito.
- O otimizador não influencia na acúracia. Provavelmente só irá influenciar no tempo de treinamento, porém, a escolha de um otmizador adequado é crucial, já que é graças a ele que temos como obter acúracia.
- O dropout para essa aplicação não mudou nada. Ele deve influenciar em aplicações de deep learning.
Modelagem estatística
res <- res %>%
mutate(epochs = factor(epochs)) %>%
mutate_if(is.character,as.factor)
res$loss <- factor(res$loss,levels = c("categorical_hinge","categorical_crossentropy"))
library(gamlss)## Loading required package: splines## Loading required package: gamlss.data##
## Attaching package: 'gamlss.data'## The following object is masked from 'package:datasets':
##
## sleep## Loading required package: gamlss.dist## Loading required package: MASS##
## Attaching package: 'MASS'## The following object is masked from 'package:dplyr':
##
## select## Loading required package: nlme##
## Attaching package: 'nlme'## The following object is masked from 'package:dplyr':
##
## collapse## Loading required package: parallel## ********** GAMLSS Version 5.1-5 **********## For more on GAMLSS look at http://www.gamlss.org/## Type gamlssNews() to see new features/changes/bug fixes.
##
## Family: c("BE", "Beta")
## Fitting method: "nlminb"
##
## Call: gamlssML(formula = resmod$acc, family = "BE", data = sys.parent())
##
## Mu Coefficients:
## [1] 3.431
## Sigma Coefficients:
## [1] -3.44
##
## Degrees of Freedom for the fit: 2 Residual Deg. of Freedom 760
## Global Deviance: -5805.1
## AIC: -5801.1
## SBC: -5791.83mod <- gamlss(acc~(epochs + loss + activation1 + activation2 + last_activation)^2,
sigma.formula = ~epochs + loss + activation1 + activation2 + last_activation,
data = resmod,family = "BE")## GAMLSS-RS iteration 1: Global Deviance = -2666.726
## GAMLSS-RS iteration 2: Global Deviance = -3238.072
## GAMLSS-RS iteration 3: Global Deviance = -4103.821
## GAMLSS-RS iteration 4: Global Deviance = -5654.238
## GAMLSS-RS iteration 5: Global Deviance = -7297.578
## GAMLSS-RS iteration 6: Global Deviance = -7513.074
## GAMLSS-RS iteration 7: Global Deviance = -7524.43
## GAMLSS-RS iteration 8: Global Deviance = -7524.767
## GAMLSS-RS iteration 9: Global Deviance = -7524.775
## GAMLSS-RS iteration 10: Global Deviance = -7524.776## Start: AIC= -7468.78
## acc ~ (epochs + loss + activation1 + activation2 + last_activation)^2## Warning in RS(): Algorithm RS has not yet converged
## Warning in RS(): Algorithm RS has not yet converged
## Warning in RS(): Algorithm RS has not yet converged
## Warning in RS(): Algorithm RS has not yet converged## Start: AIC= -7472.4
## ~epochs + loss + activation1 + activation2 + last_activation## ******************************************************************
## Family: c("BE", "Beta")
##
## Call: gamlss(formula = acc ~ epochs + loss + activation1 +
## activation2 + last_activation + epochs:loss + epochs:activation1 +
## loss:activation1 + loss:last_activation + activation1:activation2 +
## activation1:last_activation + activation2:last_activation,
## sigma.formula = ~epochs + loss + activation1, family = "BE",
## data = resmod, trace = FALSE)
##
## Fitting method: RS()
##
## ------------------------------------------------------------------
## Mu link function: logit
## Mu Coefficients:
## Estimate Std. Error
## (Intercept) 2.988149 0.009254
## epochs15 0.136624 0.009759
## epochs20 0.218030 0.009717
## losscategorical_crossentropy 0.290726 0.009961
## activation1relu 0.354519 0.010710
## activation2relu 0.070124 0.007802
## last_activationsoftplus 0.215630 0.009176
## epochs15:losscategorical_crossentropy -0.008490 0.010328
## epochs20:losscategorical_crossentropy -0.044335 0.010276
## epochs15:activation1relu -0.056564 0.010528
## epochs20:activation1relu -0.063021 0.010508
## losscategorical_crossentropy:activation1relu -0.086112 0.008546
## losscategorical_crossentropy:last_activationsoftplus -0.216293 0.008987
## activation1relu:activation2relu -0.076270 0.008713
## activation1relu:last_activationsoftplus -0.038785 0.009033
## activation2relu:last_activationsoftplus 0.021676 0.008375
## t value Pr(>|t|)
## (Intercept) 322.895 < 2e-16 ***
## epochs15 14.000 < 2e-16 ***
## epochs20 22.438 < 2e-16 ***
## losscategorical_crossentropy 29.188 < 2e-16 ***
## activation1relu 33.102 < 2e-16 ***
## activation2relu 8.988 < 2e-16 ***
## last_activationsoftplus 23.500 < 2e-16 ***
## epochs15:losscategorical_crossentropy -0.822 0.41132
## epochs20:losscategorical_crossentropy -4.314 1.82e-05 ***
## epochs15:activation1relu -5.373 1.04e-07 ***
## epochs20:activation1relu -5.997 3.14e-09 ***
## losscategorical_crossentropy:activation1relu -10.077 < 2e-16 ***
## losscategorical_crossentropy:last_activationsoftplus -24.067 < 2e-16 ***
## activation1relu:activation2relu -8.754 < 2e-16 ***
## activation1relu:last_activationsoftplus -4.294 1.99e-05 ***
## activation2relu:last_activationsoftplus 2.588 0.00984 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## ------------------------------------------------------------------
## Sigma link function: logit
## Sigma Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -4.29306 0.05846 -73.438 < 2e-16 ***
## epochs15 -0.08767 0.06464 -1.356 0.1755
## epochs20 -0.13756 0.06625 -2.077 0.0382 *
## losscategorical_crossentropy -0.12166 0.05552 -2.191 0.0288 *
## activation1relu -0.31394 0.05471 -5.738 1.39e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## ------------------------------------------------------------------
## No. of observations in the fit: 762
## Degrees of Freedom for the fit: 21
## Residual Deg. of Freedom: 741
## at cycle: 10
##
## Global Deviance: -7517.214
## AIC: -7475.214
## SBC: -7377.859
## ******************************************************************
## ******************************************************************
## Summary of the Quantile Residuals
## mean = 0.0007438302
## variance = 1.00121
## coef. of skewness = -0.2444616
## coef. of kurtosis = 3.191686
## Filliben correlation coefficient = 0.9971653
## ******************************************************************## Warning in wp(mod): Some points are missed out
## increase the y limits using ylim.all
# Matriz para efeitos marginais
pred <- predict(mod,what = "mu" , type= "response" )
de <- model.matrix(mod$mu.formula,data = resmod %>%
dplyr::select(epochs,loss,activation1,activation2,last_activation,acc)) %>%
as_tibble()O modelo parece estar bem ajustado. Vamos agora estudar como estas variáveis influênciam no desempenho do modelo.
Interpretação de \(\mu\)
Vamos agora estudar os efeitos marginais de cada variável já que temos interação entre elas. Deste modo é mais fácil identificar onde cada uma será melhor que outra.
O efeito marginal de uma variável é a derivada parcial da variável explicativa de interesse em relação à variável resposta. Para este modelo, como a função de ligação para o parâmetro de localização é logit, o efeito marginal fica dado por:
\[ \frac{\partial X_i}{\partial Y} = \frac{\beta_ie^{-X\beta}}{1 + e^{-X\beta}} \text{ , se a a variável interessada não possui interação} \]
e
\[ \frac{\partial X_i}{\partial Y} = \frac{\beta_i + \beta_kX_ke^{-X\beta}}{1 + e^{-X\beta}} \text{ , se a a variável interessada possui interação} \]
em que \(\beta_k\) e \(X_k\) são as variáveis que fazem interação com \(X_i\).
Efeito do número de épocas
epoch15 <- function(x){
b2 <- mod$mu.coefficients[2] # epoch15
b8 <- mod$mu.coefficients[8] # crossentropy
b10 <- mod$mu.coefficients[10] # act1 relu
c1 <- (b2 + b8*de$`epochs15:losscategorical_crossentropy` + b10*de$`epochs15:activation1relu`)*de$epochs15
c2 <- exp(-rowSums(mod$mu.coefficients*de))
res <- c1*c2*pred
return(as.numeric(res))
}
data.frame(epoch15 = de$epochs15,
loss_cross = de$`epochs15:losscategorical_crossentropy`,
act1 = de$`epochs15:activation1relu`,
efeito = epoch15()) %>%
group_by(epoch15,loss_cross,act1) %>%
summarise(efeito = mean(efeito)) %>%
arrange(-efeito) %>%
mutate(efeito = scales::percent(efeito)) %>%
knitr::kable(digits = 2,format = "html") %>%
kableExtra::kable_styling()| epoch15 | loss_cross | act1 | efeito |
|---|---|---|---|
| 1 | 1 | 0 | 11.24% |
| 1 | 0 | 0 | 7.13% |
| 1 | 0 | 1 | 5.81% |
| 1 | 1 | 1 | 1.79% |
| 0 | 0 | 0 | 0% |
Note que quando temos 15 épocas, o maior efeito marginal é quando temos a função de perda sendo a entropia cruzada e função de ativação para primeira camada igual a elu.
epoch20 <- function(x){
b3 <- mod$mu.coefficients[3] # epoch15
b9 <- mod$mu.coefficients[9] # crossentropy
b11 <- mod$mu.coefficients[11] # act1 relu
c1 <- (b3 + b9*de$`epochs20:losscategorical_crossentropy` + b11*de$`epochs20:activation1relu`)*de$epochs20
c2 <- exp(-rowSums(mod$mu.coefficients*de))
res <- c1*c2*pred
return(as.numeric(res))
}
data.frame(epoch20 = de$epochs20,
loss_cross = de$`epochs20:losscategorical_crossentropy`,
act1 = de$`epochs20:activation1relu`,
efeito = epoch20()) %>%
group_by(epoch20,loss_cross,act1) %>%
summarise(efeito = mean(efeito)) %>%
arrange(-efeito) %>%
mutate(efeito = scales::percent(efeito)) %>%
knitr::kable(digits = 2,format = "html") %>%
kableExtra::kable_styling()| epoch20 | loss_cross | act1 | efeito |
|---|---|---|---|
| 1 | 0 | 0 | 15.35% |
| 1 | 1 | 0 | 13.72% |
| 1 | 1 | 1 | 6.81% |
| 1 | 0 | 1 | 6.66% |
| 0 | 0 | 0 | 0% |
Já quando temos 20 épocas, usar a entropia cruzada não é tão bom, sendo que usar a função de ativação para primeira camada sendo a elu ainda assim é melhor.
Logo, o efeito do número de épocas é melhorado quando temos função de ativação elu, sendo que, quando temos menos épocas é melhor usar a função de perda de entropia cruzada e com mais épocas, melhor utilizar a função de perda hinge.
Função de perda
loss <- function(x){
b4 <- mod$mu.coefficients[4] # crossentropy
b8 <- mod$mu.coefficients[8] # epoch15
b9 <- mod$mu.coefficients[9] # epoch20
b12 <- mod$mu.coefficients[12] # act1 relu
b13 <- mod$mu.coefficients[13] # last_act softplus
c1 <- (b4 + b8*de$`epochs15:losscategorical_crossentropy` +
b9*de$`epochs20:losscategorical_crossentropy` +
b12*de$`losscategorical_crossentropy:activation1relu` +
b13*de$`losscategorical_crossentropy:last_activationsoftplus`)*de$losscategorical_crossentropy
c2 <- exp(-rowSums(mod$mu.coefficients*de))
res <- c1*c2*pred
return(as.numeric(res))
}
data.frame(loss_cross = de$losscategorical_crossentropy,
epoch15 = de$`epochs15:losscategorical_crossentropy`,
epoch20 = de$`epochs20:losscategorical_crossentropy`,
actrelu = de$`losscategorical_crossentropy:activation1relu`,
lact_soft = de$`losscategorical_crossentropy:last_activationsoftplus`,
efeito = loss()) %>%
group_by(loss_cross,epoch15,epoch20,actrelu,lact_soft) %>%
summarise(efeito = mean(efeito)) %>%
arrange(-efeito) %>%
mutate(efeito = scales::percent(efeito)) %>%
knitr::kable(digits = 2,format = "html") %>%
kableExtra::kable_styling()| loss_cross | epoch15 | epoch20 | actrelu | lact_soft | efeito |
|---|---|---|---|---|---|
| 1 | 0 | 0 | 0 | 0 | 37.4% |
| 1 | 1 | 0 | 0 | 0 | 25.1% |
| 1 | 0 | 1 | 0 | 0 | 18.9% |
| 1 | 0 | 0 | 1 | 0 | 9.7% |
| 1 | 0 | 1 | 1 | 0 | 7.7% |
| 1 | 0 | 0 | 0 | 1 | 7.2% |
| 1 | 1 | 0 | 0 | 1 | 5.7% |
| 1 | 0 | 1 | 0 | 1 | 2.5% |
| 1 | 1 | 0 | 1 | 0 | 0.47% |
| 0 | 0 | 0 | 0 | 0 | 0% |
| 1 | 0 | 0 | 1 | 1 | -0.9% |
| 1 | 1 | 0 | 1 | 1 | -0.96% |
| 1 | 0 | 1 | 1 | 1 | -4.2% |
Observando o efeito da função de perda de entropia cruzada, o que podemos ver é que ela funciona extremamente bem para poucas épocas. Além disso quando a função de ativação para última camada é a softmax, também existe um ganho maior em comparação quando se usa a softplus.
Note também que a função elu apresenta melhores resultados para o efeito da entropia cruzada. Um menor número de épocas apresenta o melhor resultado, contudo, este não é o maior determinante para o efeito positivo da função de perda. Observe que os efeitos negativos são quando temos a função de ativação para primeira camada sendo a relu e a da última camada sendo a softplus, e , quanto maior o número de épocas, pior o desempenho.
Logo, podemos chegar a conclusão de que a entropia cruzada funciona bem para poucas épocas e função de ativação para primeira camada sendo elu e e para última camada sendo softmax.
Função de ativação para primeira camada relu
act1 <- function(x){
b5 <- mod$mu.coefficients[5] # act1 relu
b10 <- mod$mu.coefficients[10] # epoch15
b11 <- mod$mu.coefficients[11] # epoch20
b12 <- mod$mu.coefficients[12] # cross
b14 <- mod$mu.coefficients[14] # act2 relu
b15 <- mod$mu.coefficients[15] # soft_plus
c1 <- (b5 + b10*de$`epochs15:activation1relu` +
b11*de$`epochs20:activation1relu` +
b12*de$`losscategorical_crossentropy:activation1relu` +
b14*de$`activation1relu:activation2relu` +
b15*de$`activation1relu:last_activationsoftplus`)*de$activation1relu
c2 <- exp(-rowSums(mod$mu.coefficients*de))
res <- c1*c2*pred
return(as.numeric(res))
}
data.frame(act1relu = de$activation1relu,
epoch15 = de$`epochs15:activation1relu`,
epoch20 = de$`epochs20:activation1relu`,
loss_cross = de$`losscategorical_crossentropy:activation1relu`,
act2 = de$`activation1relu:activation2relu`,
lact_soft = de$`activation1relu:last_activationsoftplus`,
efeito = act1()) %>%
group_by(act1relu,epoch15,epoch20,loss_cross,act2,lact_soft) %>%
summarise(efeito = mean(efeito)) %>%
arrange(-efeito) %>%
mutate(efeito = scales::percent(efeito)) %>%
knitr::kable(digits = 2,format = "html") %>%
kableExtra::kable_styling()| act1relu | epoch15 | epoch20 | loss_cross | act2 | lact_soft | efeito |
|---|---|---|---|---|---|---|
| 1 | 1 | 0 | 0 | 0 | 0 | 38.1% |
| 1 | 0 | 0 | 0 | 0 | 0 | 29.32% |
| 1 | 0 | 0 | 1 | 0 | 0 | 24.41% |
| 1 | 0 | 0 | 0 | 0 | 1 | 23.93% |
| 1 | 1 | 0 | 0 | 0 | 1 | 22.9% |
| 1 | 0 | 1 | 0 | 0 | 1 | 19.71% |
| 1 | 0 | 0 | 1 | 0 | 1 | 15.47% |
| 1 | 0 | 1 | 1 | 0 | 0 | 14.80% |
| 1 | 0 | 0 | 0 | 1 | 1 | 14.1% |
| 1 | 1 | 0 | 0 | 1 | 1 | 12.8% |
| 1 | 0 | 1 | 0 | 0 | 0 | 12.37% |
| 1 | 0 | 0 | 1 | 1 | 1 | 12.3% |
| 1 | 0 | 1 | 1 | 0 | 1 | 11.88% |
| 1 | 1 | 0 | 1 | 0 | 1 | 8.86% |
| 1 | 0 | 1 | 0 | 1 | 1 | 8.45% |
| 1 | 0 | 1 | 1 | 1 | 1 | 7.13% |
| 1 | 1 | 0 | 1 | 1 | 1 | 4.26% |
| 1 | 0 | 1 | 1 | 1 | 0 | 3.09% |
| 1 | 0 | 0 | 0 | 1 | 0 | 0.9% |
| 1 | 1 | 0 | 0 | 1 | 0 | 0.8% |
| 1 | 0 | 1 | 0 | 1 | 0 | 0.76% |
| 1 | 0 | 0 | 1 | 1 | 0 | 0.7% |
| 1 | 1 | 0 | 1 | 0 | 0 | 0.48% |
| 1 | 1 | 0 | 1 | 1 | 0 | 0.34% |
| 0 | 0 | 0 | 0 | 0 | 0 | 0% |
Analisando o efeito marginal para primeira camada, vemos que a função relu funciona melhor com 15 épocas, ou seja, um valor intermédiario, sendo melhorada com função de perda hinge e função de ativação da segunda camada sendo elu e função de ativação para última camada sendo softmax.
Logo, fazer uma alteração na função de ativação para segunda camada é muito benefico para o treinamento. Também é importante usar a função softmax para última camada caso você utilize a relu para primeira, e função de perda também influencia mas de forma não muito acentuada.
Função de ativação para segunda camada relu
# Act2
act2 <- function(x){
b6 <- mod$mu.coefficients[6] # act2 relu
b14 <- mod$mu.coefficients[14] # act2 relu
b16 <- mod$mu.coefficients[16] # soft_plus
c1 <- (b6 + b14*de$`activation1relu:activation2relu` +
b16*de$`activation2relu:last_activationsoftplus`)*de$activation2relu
c2 <- exp(-rowSums(mod$mu.coefficients*de))
res <- c1*c2*pred
return(as.numeric(res))
}
data.frame(act2relu = de$activation2relu,
act1relu = de$`activation1relu:activation2relu`,
lact_soft = de$`activation2relu:last_activationsoftplus`,
efeito = act2()) %>%
group_by(act2relu,act1relu,lact_soft) %>%
summarise(efeito = mean(efeito)) %>%
arrange(-efeito) %>%
mutate(efeito = scales::percent(efeito)) %>%
knitr::kable(digits = 2,format = "html") %>%
kableExtra::kable_styling()| act2relu | act1relu | lact_soft | efeito |
|---|---|---|---|
| 1 | 0 | 1 | 7.17% |
| 1 | 0 | 0 | 5.16% |
| 1 | 1 | 1 | 0.98% |
| 0 | 0 | 0 | 0% |
| 1 | 1 | 0 | -0.04% |
Investigando o efeito da camada de ativação intermediária, vemos que o seu efeito não é mt intenso, e que alternar a função de ativação, como vimos anteriormente é uma ótima estratégia.
Camada de ativação da saída
# lact soft_plus
softplus <- function(x){
b7 <- mod$mu.coefficients[7] # softplus
b13 <- mod$mu.coefficients[13] # losscategorical_crossentropy:last_activationsoftplus
b15 <- mod$mu.coefficients[15] # activation1relu:last_activationsoftplus
b16 <- mod$mu.coefficients[16] # activation2relu:last_activationsoftplus
c1 <- (b7 + b13*de$`losscategorical_crossentropy:last_activationsoftplus` +
b15*de$`activation1relu:last_activationsoftplus` +
b16*de$`activation2relu:last_activationsoftplus`)*de$last_activationsoftplus
c2 <- exp(-rowSums(mod$mu.coefficients*de))
res <- c1*c2*pred
return(as.numeric(res))
}
data.frame(la_softplus = de$last_activationsoftplus,
loss_cross = de$`losscategorical_crossentropy:last_activationsoftplus`,
act1relu = de$`activation1relu:last_activationsoftplus`,
act2relu = de$`activation2relu:last_activationsoftplus`,
efeito = softplus()) %>%
group_by(la_softplus,loss_cross,act1relu,act2relu) %>%
summarise(efeito = mean(efeito)) %>%
arrange(-efeito) %>%
mutate(efeito = scales::percent(efeito)) %>%
knitr::kable(digits = 2,format = "html") %>%
kableExtra::kable_styling()| la_softplus | loss_cross | act1relu | act2relu | efeito |
|---|---|---|---|---|
| 1 | 0 | 0 | 1 | 19.66% |
| 1 | 0 | 0 | 0 | 15.43% |
| 1 | 0 | 1 | 0 | 14.28% |
| 1 | 0 | 1 | 1 | 11.71% |
| 1 | 1 | 0 | 1 | 1.54% |
| 0 | 0 | 0 | 0 | 0% |
| 1 | 1 | 0 | 0 | -0.07% |
| 1 | 1 | 1 | 1 | -1.20% |
| 1 | 1 | 1 | 0 | -2.50% |
O efeito marginal da função de ativação para camada final softplus é interessante quando usamos a função de perda hinge. Note também que alternar as funções de ativação das demais camadas continua sendo interessante.
Interpretação do parâmetro de precisão \(\phi\)
O parâmetro \(\phi\) na regressão beta influência na variabilidade das estimativas. Por definição o modelo beta já é heterocedástico, contudo, ainda podemos modelar explicitamente essa variabilidade através do parâmetro \(\phi\).
A variância das estimativas é dada por:
\[ Var(y) = \frac{Var(\mu)}{1 + \phi} \]
Isto é, quão menor for a estimativa de \(\phi\) no modelo, maior será seu logit (função de ligação para \(\phi\)), e consequentemente, menor a variância. Para interpreta-lo, podemos usar a odds ratio, sendo que agora, a odds irá expressar o quão maior \(\phi\) é em relação ao \(\phi\) da referência para cada variável, o que implica que a odds ratio representa o quão maior é o \(\phi\) atual em relação ao \(\phi\) da referência para a taxa de acerto do modelo.
data.frame(Parametro = names(mod$sigma.coefficients[-1]),
OddsRatio = exp(mod$sigma.coefficients[-1]),
row.names = NULL) %>%
knitr::kable(digits = 2,format = "html") %>%
kableExtra::kable_styling()| Parametro | OddsRatio |
|---|---|
| epochs15 | 0.92 |
| epochs20 | 0.87 |
| losscategorical_crossentropy | 0.89 |
| activation1relu | 0.73 |
Sendo assim, temos que quanto maior o número de épocas, menor a variância (13% em relação a refência que são 10 épocas). Utilizar a função de perda de entropia cruzada também ajuda a minimizar a variância (em 11,5% em relação a função hige). O que mais impressiona é que, utilizar a função relu na primeira camada diminui muito a variabilidade da acúracia (17% em relação a elu).
Conclusão do estudo
Para este conjunto de dados e para o tipo de rede neural treinada, podemos notar que:
Aumentar o número de épocas realmente melhora a acúracia do modelo, contudo, devemos ter algumas precauções quanto a função de perda.
É preferível utilizar a função de perda de entropia cruzada para poucas epócas e além disso, utilizando ativação relu e softmax, para a primeira e última camada, respectivamente.
Alternar a função de ativação entre a primeira e segunda camada é altamente útil, independente da configuração utilizada.
O otmizador não influência na acúracia do modelo. O otmizador irá influenciar na convergência e no seu respectivo tempo para treinamento.
O dropout para esta configuração não muda nada. Esta característica provavelmente só irá mudar algo em modelos de deep learning.
A função relu na primeira camada (consequentemente a elu na segunda de acordo com os outros itens), irá diminuir bastante a chance de errar, pois a variância irá reduzir consideravelmente.
Logo, a melhor combinação é utilizando de 10 a 15 épocas com relu na primeira camada, elu na segunda e softmax na última. Além disso, usar a função de perda de entropia cruzada. Utilizar esta configuração irá máximar a acúracia e diminuir em muito as chances de erro pois a variância utilizando relu na camada 1 e a função de perda de entropia cruzada reduzem bastante a variabilidade, mesmo o número de épocas não sendo o que dimuni mais as chances de erro.