Rede Neural

library(tidymodels)
library(nnet)
library(vip)
library(recipes)
library(rsample)
library(parsnip)
library(workflows)
library(dials)
library(tune)
library(yardstick)
library(readr)
library(tidyverse)
library(nnet)
library(vip)

Juntar dados

#SSEH44 <- readRDS("D:/danilo.dantas/Weeberb/Dataframes/dados/SSEH/2_RDS/SSEH44.rds")
#SSEH44$CODIGO_ESCOLA<-as.character(SSEH44$CODIGO_ESCOLA)
#SSEH44$Ano <-SSEH44$Ano %>% as.numeric()
#df2 %>% group_by(NU_ANO,CO_ESCOLA) %>% 
  summarise(Nota_Red=mean(Nota_Red),
            Nota_objetiva=mean(Nota_objetiva))->t
#t<-inner_join(SSEH44,t,by=c("Ano"="NU_ANO","CODIGO_ESCOLA"="CO_ESCOLA"))
# Instale se necessário
#rm(df2,SSEH44)
#write.csv(t,"test_nn.csv")
#dados <- read_csv("test_nn.csv")

1) Limpar dados

t$homicidio %>% str_replace(",",".") %>% as.numeric()->t$homicidio
t$idade_90_94 %>% str_replace(",",".") %>% as.numeric()->t$idade_90_94
t$idade_90_94[is.na(t$idade_90_94)]<-0
t$idade_95_99 %>% str_replace(",",".") %>% as.numeric()->t$idade_95_99
t$idade_95_99[is.na(t$idade_95_99)]<-0
t$idade_100 %>% str_replace(",",".") %>% as.numeric()->t$idade_100
t$idade_100[is.na(t$idade_100)]<-0
homem_90_94
t$homem_85_89 %>% str_replace(",",".") %>% as.numeric()->t$homem_85_89
t$homem_85_89[is.na(t$homem_85_89)]#<-0
t$homem_90_94 %>% str_replace(",",".") %>% as.numeric()->t$homem_90_94
t$homem_90_94[is.na(t$homem_90_94)]<-0
t$homem_95_99 %>% str_replace(",",".") %>% as.numeric()->t$homem_95_99
t$homem_95_99[is.na(t$homem_95_99)]<-0
t$mulher_85_89 %>% str_replace(",",".") %>% as.numeric()->t$mulher_85_89
t$mulher_85_89[is.na(t$mulher_85_89)]<-0
t$mulher_90_94 %>% str_replace(",",".") %>% as.numeric()->t$mulher_90_94
t$mulher_90_94[is.na(t$mulher_90_94)]<-0
         
t$homem_100 %>% str_replace(",",".") %>% as.numeric()->t$homem_100
t$homem_100[is.na(t$homem_100)]<-0

t$mulher_95_99 %>% str_replace(",",".") %>% as.numeric()->t$mulher_95_99
t$mulher_95_99[is.na(t$mulher_95_99)]<-0
t$mulher_100 %>% str_replace(",",".") %>% as.numeric()->t$mulher_100
t$mulher_100[is.na(t$mulher_100)]<-0
t$pop_amarela %>% str_replace(",",".") %>% as.numeric()->t$pop_amarela
t$pop_amarela[is.na(t$pop_amarela)]<-0
t$pop_indigena %>% str_replace(",",".") %>% as.numeric()->t$pop_indigena
t$pop_indigena[is.na(t$pop_indigena)]<-0






t$CODIGO_ESCOLA
dados_limpos <- t %>%
  mutate()
  mutate(across(where(is.character), as.factor)) %>%
  mutate(across(where(is.factor), ~fct_na_value_to_level(.))) %>%
  mutate(across(where(is.numeric), ~ifelse(is.na(.), mean(., na.rm = TRUE), .))) %>% 
  select(-CODIGO_ESCOLA,-id_municipio)

2) Padronizar numéricos com scale (e dummies para categorias?)

dummy não deu muito certo, preciso melhorar a limpeza

receita <- recipe(Nota_objetiva ~ ., data = dados_limpos) %>%
  #update_role(...1, CODIGO_ESCOLA, id_municipio, new_role = "ID") %>%
  #step_rm(...1, CODIGO_ESCOLA, id_municipio) %>%
  step_zv(all_predictors()) %>%      # remove colunas com variância zero
  step_impute_mean(all_numeric(), -all_outcomes()) %>%
  #step_dummy(all_nominal(), one_hot = TRUE) %>%
  step_normalize(all_numeric(), -all_outcomes())

# Separar treino/teste
set.seed(123)
split <- initial_split(dados_limpos, prop = 0.8, strata = Nota_objetiva)
train <- training(split)
test <- testing(split)

3) Grid search

modelo_nn <- mlp(hidden_units = tune(), penalty = tune(), epochs = 100) %>%
  set_engine("nnet") %>%
  set_mode("regression")

wf <- workflow() %>%
  add_recipe(receita) %>%
  add_model(modelo_nn)

grid <- grid_regular(
  hidden_units(range = c(1, 5)),
  penalty(range = c(-4, -1)),
  levels = 3
)

cv_folds <- vfold_cv(train, v = 5)

ajuste <- tune_grid(
  wf,
  resamples = cv_folds,
  grid = grid,
  metrics = metric_set(rmse, rsq)
)

Salvar Resultados

#seleção de modelos

melhor <- select_best(ajuste, metric = "rmse")

# 4) Rodar o modelo final
modelo_final <- finalize_workflow(wf, melhor) %>%
  fit(data = train)

5) Ranking das variáveis

#library(DALEX)

# Preparar os dados de entrada
#dados_juice <- juice(prep(recipe(Nota_objetiva ~ ., data = dados_limpos)))

# Criar o explicador para o modelo
#explainer_nn <- explain(
#  model = modelo_final$fit$fit,         # objeto de classe nnet
#  data = select(dados_juice, -Nota_objetiva),
#  y = dados_juice$Nota_objetiva,
#  label = "Rede Neural nnet"
#)
#importancia <- model_parts(explainer_nn, loss_function = loss_root_mean_square)

# Visualizar
#importancia %>% data.frame %>% arrange(dropout_loss) %>% filter(!permutation==0) %>%  plot() 
vip(modelo_final$fit$fit, num_features = 40)

NA
NA

6) Cross-validação final