Resultados do TCC2

library(DT);library(dplyr);library(caret)

## 
## 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

## Loading required package: lattice

## Loading required package: ggplot2

load("dados_estudo.Rdata")
load("resultados.Rdata")
base = dados_estudo
rm(dados_estudo)

Base de dados tratada

base %>%
  head() %>% 
    DT::datatable(
    extensions = 'FixedColumns',
    options = list(
      dom = 't',
      scrollX = TRUE,
      columnDefs = list(list(
        className = 'dt-center', targets = "_all"
      ))
    ),
    rownames = FALSE
  ) %>%
  DT::formatStyle(0, lineHeight = '50%')

## Distribuição da base em Anomalia

base %>% 
  group_by(IDANOMAL) %>% 
  summarise(Frequencia_Abs = n(),
            Frequencia_Rel = round(n()/nrow(.),3)) %>% 
  knitr::kable()

IDANOMAL	Frequencia_Abs	Frequencia_Rel
0	4958048	0.991
1	44840	0.009

Tabulações das variáveis explicativas com o desfecho

library(expss)
base_teste = apply_labels(base,
                          GESTACAO = "Prematuridade",
                          RACACOR = "Raça/Cor",
                          SEXO = "Sexo",
                          LOCNASC = "Local de nascimento",
                          PARTO = "Tipo de parto",
                          ESCMAE2010 = "Escolaridade da mãe",
                          IDADEMAE = "Idade da mãe",
                          GRAVIDEZ = "Tipo de gravidez",
                          CONSPRENAT = "Quantidade de consultas de pre-natal",
                          APGAR5 = "Índice de Apgar no 5º minuto",
                          IDANOMAL = "Anomalia congenita (%)",
                          IDANOMAL = c("Possui anomalia" = 1,
                                       "Não possui anomalia" = 0),
                          PESO = "Peso ao nascer",
                          PARIDADE = "Paridade",
                          REGIAO = "Região do nascimento")



nomes = base_teste %>%names() %>% .[-11]
tabela_cont = function(base, nomes){
  d = NULL
  for(nome in nomes){
    a = cro_cases(base %>% select(nome),list(total(),base$IDANOMAL),total_row_position = "none")
    porcentagem_Nanomal = a$`Anomalia congenita (%)|Não possui anomalia`/a$`#Total`
a$`Anomalia congenita (%)|Não possui anomalia` = porcentagem_Nanomal*100
a$`Anomalia congenita (%)|Possui anomalia`= (1 - porcentagem_Nanomal)*100
a$`#Total` = round(a$`#Total`/sum(a$`#Total`),3)*100
names(a)[2] = "Porcentagem de recém-nascidos(%) \n (n=5.002.888)"

   d = rbind(d,a)
  }
  names(d)[1] = "Variáveis explicativas"
  return(d)
}

tabela = tabela_cont(base_teste,nomes)

tabela %>% 
  set_caption("Tabela das medidas")

	Porcentagem de recém-nascidos(%) (n=5.002.888)	Anomalia congenita (%)
Tabela das medidas
Variáveis explicativas		Não possui anomalia	Possui anomalia
Prematuridade
Sim	11.0	98.0	2.0
Não	89.0	99.2	0.8
Raça/Cor
Branca	38.1	99.0	1.0
Não branca	61.9	99.1	0.9
Sexo
Masculino	51.2	99.0	1.0
Feminino	48.8	99.2	0.8
Local de nascimento
Hospital/Est.saúde	99.7	99.1	0.9
Outro	0.3	99.3	0.7
Tipo de parto
Vaginal	43.2	99.3	0.7
Cesaria	56.8	99.0	1.0
Escolaridade da mãe
Não tem ensino superior	84.1	99.1	0.9
Tem ensino superior	15.9	99.0	1.0
Idade da mãe
Menor de 18 ou maior de 35	19.2	98.9	1.1
De 18 a 35	80.8	99.2	0.8
Tipo de gravidez
Única	97.8	99.1	0.9
Múltipla	2.2	98.7	1.3
Quantidade de consultas de pre-natal
Até 5 consultas	17.6	99.0	1.0
6 ou mais consultas	82.4	99.1	0.9
Índice de Apgar no 5º minuto
Menor que 7	1.0	91.9	8.1
Maior ou igual 7	99.0	99.2	0.8
Peso ao nascer
Baixo	8.4	97.3	2.7
Não baixo	91.6	99.3	0.7
Paridade
Nulipara	38.6	99.1	0.9
Não nulipara	61.4	99.1	0.9
Região do nascimento
Centro Oeste	7.8	99.3	0.7
Nordeste	24.8	99.2	0.8
Norte	9.8	99.4	0.6
Sudeste	42.5	98.9	1.1
Sul	15.2	99.2	0.8

Função auxiliar para modelagem

Funções Auxiliares criadas para apoio ao ajuste dos modelos

# Aplica o teste de wald ind. e geral.
teste_wald = function(modelo,reposta,p){
  names =   names(modelo$data)[names(modelo$data)!= reposta]
  
  # print("")
  # print("-------Teste Geral Wald-------")
  # print("")
  # 
  # print(survey::regTermTest(modelo,names, method= "Wald"))
  # 
  # print("-------Teste Individual Wald---------")
  nomes = c()
  for(name in names){
    # print("")
    # print(survey::regTermTest(modelo,name, method= "Wald"))
    # print("")
    x = survey::regTermTest(modelo,name, method= "Wald")
    if(x$p > p){
      nomes[length(nomes)+1] = x$test.terms
    }
  }
  return(nomes)
}

#Constroi a curva roc com ggplot.

roc_graph = function(prediction, obs, titulo,AUC = FALSE){
  prediction = ROCR::prediction(prediction, obs)
  performance = ROCR::performance(prediction, "tpr", "fpr")
  auc = ROCR::performance(prediction, measure = "auc")@y.values[[1]]
  df = data.frame(xvalues = performance@x.values[[1]], 
                  yvalues = performance@y.values[[1]],
                  alpha_ = performance@alpha.values[[1]])
  
  if(AUC == FALSE){
  print(
    df %>% 
      ggplot(aes(x = xvalues, y = yvalues)) +
      geom_line(size = 2, col = "royalblue") +
      geom_abline(slope=1, alpha = 0.5) +
      geom_text(x = .75, y = .15, label = paste("AUC =", round(auc,3)), size = 10) +
      scale_color_gradient(low="blue", 
                           high="green", 
                           breaks=c(0, .25, .5, .75, 1), 
                           limits=c(0,1)) +
      coord_cartesian(clip = 'off') +
      ylab('Verdadeiro Positivo (Sensibilidade)')+
      xlab('Falso Positivo (1 - Especificidade)')+
      ggtitle(titulo)
  )
  }
  if(AUC)return(auc)
}


#Faz a conta do ponto de corte otimizador.

otimizador<-function(predicao,resposta){
  require(ROCR)
  predicao2 = prediction(predicao, resposta)
  performance = performance(predicao2,"tpr","fpr")
  funcao <- attr(performance, "y.values")[[1]] -
    (attr(performance, "x.values")[[1]])
  c <-  performance@alpha.values[[1]][which.max(funcao)]
  return(c)
}

Definindo funções de reamostragem

Estou utilizando as técnicas de kfold e bootstrap na base toda. As técnicas consistem em separar a base em treino e teste. No final irei gerar a média das métricas das reamostragem e tirar conclusão do melhor modelo.

kfold = function(base,link,k){
  set.seed(2021)
  metricas = tibble("Acuracia",
                    "Sensibilidade",
                    "Especificidade",
                    "Valor Corte",
                    "AUC Treino",
                    "AUC Teste",
                    "Remove")
  metricas = metricas[-1,]
  
  folds = createFolds(base$IDANOMAL,
                      k = k,
                      list = T,
                      returnTrain = T)

  for(fold in folds){
    treino = base[fold,]
    teste = base[-fold,]
    
    modelo = glm(IDANOMAL~ .,
                 data = treino,
                 family = binomial(link))
    
    
    verifica = teste_wald(modelo, "IDANOMAL",0.05)
    
    nomes = c()
    
    while(length(verifica) > 0){
      treino = treino %>% 
        select(-verifica)
      teste = teste %>% 
        select(-verifica)
      
      nomes = c(nomes,verifica)
      
      modelo = glm(IDANOMAL~ .,
                 data = treino,
                 family = binomial(link))
      
      verifica = teste_wald(modelo, "IDANOMAL",0.05)
    }
    
    #print(nomes)
    
    predicao_treino = predict(modelo,
                              treino,
                              type = 'response')
    
    valor_corte = otimizador(predicao_treino,treino$IDANOMAL)
    
    predicao_teste = predict(modelo,
                             teste,
                             type = 'response')
    
    auc_treino = roc_graph(predicao_treino,treino$IDANOMAL," ",AUC = TRUE)
    auc_teste = roc_graph(predicao_teste,teste$IDANOMAL," ",AUC = TRUE)
    
    predicao_teste = ifelse(predicao_teste>= valor_corte,1,0) %>% as.factor(.)
    
    teste = teste %>% 
      mutate(IDANOMAL = as.factor(IDANOMAL))
    
    info = confusionMatrix(data = predicao_teste,
                           reference = teste$IDANOMAL,
                           positive = "1")
    
    lista = tibble(Acuracia = info$overall[[1]],
                   Sensibilidade = info$byClass[[1]],
                   Especificidade = info$byClass[[2]],
                   `Valor Corte` = valor_corte,
                   `AUC Treino` = auc_treino,
                   `AUC Teste` = auc_teste,
                   Remove = paste(nomes,collapse = " "))
    
    
    metricas = metricas %>% 
      rbind(lista)
  }
  return(metricas)
}

bootstrap = function(base,link,k,p){
  set.seed(2021)
  metricas = tibble("Acuracia",
                    "Sensibilidade",
                    "Especificidade",
                    "Valor Corte",
                    "AUC Treino",
                    "AUC Teste",
                    "Remove")
  metricas = metricas[-1,]
  
  folds = createResample(base$IDANOMAL,
                         times = k,
                         list = T)
  
  for(fold in folds){
    
    base_fold = base[fold,]
    
    index = createDataPartition(y = base_fold$IDANOMAL,
                                p = 0.7,
                                list = F)
    
    treino = base[index,]
    teste = base[-index,]
    
    modelo = glm(IDANOMAL~ .,
                 data = treino,
                 family = binomial(link))
    
    verifica = teste_wald(modelo, "IDANOMAL",0.05)
    
    nomes = c()
    
    while(length(verifica) > 0){
      treino = treino %>% 
        select(-verifica)
      teste = teste %>% 
        select(-verifica)
      
      nomes = c(nomes,verifica)
      
      modelo = glm(IDANOMAL~ .,
                 data = treino,
                 family = binomial(link))
      
      verifica = teste_wald(modelo, "IDANOMAL",0.05)
    }
    
    #print(nomes)
    
    predicao_treino = predict(modelo,
                              treino,
                              type = 'response')
    
    valor_corte = otimizador(predicao_treino,treino$IDANOMAL)
    
    predicao_teste = predict(modelo,
                             teste,
                             type = 'response')
    
    auc_treino = roc_graph(predicao_treino,treino$IDANOMAL," ",AUC = TRUE)
    auc_teste = roc_graph(predicao_teste,teste$IDANOMAL," ",AUC = TRUE)
    
    predicao_teste = ifelse(predicao_teste>= valor_corte,1,0) %>% as.factor(.)
    
    teste = teste %>% 
      mutate(IDANOMAL = as.factor(IDANOMAL))
    
    info = confusionMatrix(data = predicao_teste,
                           reference = teste$IDANOMAL,
                           positive = "1")
    
    lista = tibble(Acuracia = info$overall[[1]],
                   Sensibilidade = info$byClass[[1]],
                   Especificidade = info$byClass[[2]],
                   `Valor Corte` = valor_corte,
                   `AUC Teste` = auc_teste,
                   `AUC Treino` = auc_treino,
                   Remove = paste(nomes,collapse = " "))
    
    
    metricas = metricas %>% 
      rbind(lista)
    
  }
  return(metricas)
}

Definir bases

set.seed(2021)
index = createDataPartition(base$IDANOMAL,p = 0.7, list = F)
base_treino = base[index,]
base_teste = base[-index,]

Modelagem por logit

Modelagem utilizando reamostragens

tempoLogit_kfold = Sys.time()
resultadosLogit_kfold = kfold(base_treino,link = "logit",k = 10)
tempoLogit_kfold = Sys.time() - tempoLogit_kfold

tempoLogit_bootstrap = Sys.time()
resultadosLogit_bootstrap = bootstrap(base_treino, link = "logit",k = 50,p = 0.7)
tempoLogit_bootstrap = Sys.time() - tempoLogit_bootstrap

Resultados por kfold

resultadosLogit_kfold %>% 
  knitr::kable()

Acuracia	Sensibilidade	Especificidade	Valor Corte	AUC Treino	AUC Teste	Remove
0.7349815	0.7373131	0.4780952	0.0090554	0.6555438	0.6490455	RACACOR LOCNASC
0.7273802	0.7294764	0.4919094	0.0088321	0.6550142	0.6538557	RACACOR LOCNASC
0.7260838	0.7280551	0.5057952	0.0087215	0.6540705	0.6616074	RACACOR
0.7384195	0.7406081	0.4907075	0.0090960	0.6543448	0.6591510	RACACOR LOCNASC
0.7268234	0.7290873	0.4785082	0.0087542	0.6558846	0.6451948	RACACOR LOCNASC ESCMAE2010
0.7261817	0.7280906	0.5110390	0.0087201	0.6541695	0.6601084	RACACOR LOCNASC ESCMAE2010
0.7251366	0.7273482	0.4853125	0.0087190	0.6551945	0.6509948	RACACOR LOCNASC ESCMAE2010
0.7255441	0.7275992	0.5023474	0.0085664	0.6546123	0.6574753	RACACOR LOCNASC
0.7274002	0.7295348	0.4967300	0.0087494	0.6547631	0.6560230	RACACOR LOCNASC ESCMAE2010
0.7373287	0.7397214	0.4795031	0.0090699	0.6549530	0.6521591	RACACOR

#Medias
apply(resultadosLogit_kfold[,-7],2,mean) %>% knitr::kable()

	x
Acuracia	0.7295280
Sensibilidade	0.7316834
Especificidade	0.4919948
Valor Corte	0.0088284
AUC Treino	0.6548550
AUC Teste	0.6545615

Resultados por bootstrap

resultadosLogit_bootstrap %>% 
  knitr::kable()

Acuracia	Sensibilidade	Especificidade	Valor Corte	AUC Teste	AUC Treino	Remove
0.7279180	0.7300531	0.4924804	0.0088337	0.6531274	0.6552235	RACACOR LOCNASC ESCMAE2010
0.7278818	0.7300271	0.4919730	0.0087668	0.6516083	0.6560088	RACACOR LOCNASC ESCMAE2010
0.7360190	0.7382874	0.4892906	0.0090407	0.6550847	0.6547154	RACACOR LOCNASC ESCMAE2010
0.7243239	0.7264075	0.4937287	0.0087435	0.6502063	0.6561733	RACACOR LOCNASC ESCMAE2010
0.7283063	0.7305220	0.4866422	0.0087396	0.6510360	0.6563172	RACACOR LOCNASC
0.7455402	0.7480163	0.4743873	0.0091741	0.6533349	0.6552264	RACACOR LOCNASC ESCMAE2010
0.7168272	0.7187591	0.5055672	0.0084298	0.6560167	0.6542026	RACACOR
0.7458743	0.7483515	0.4751758	0.0092570	0.6576479	0.6536117	RACACOR LOCNASC ESCMAE2010
0.7339107	0.7361559	0.4900897	0.0090241	0.6570148	0.6540965	RACACOR LOCNASC ESCMAE2010
0.7327761	0.7349566	0.4921022	0.0089399	0.6541232	0.6551782	RACACOR LOCNASC
0.7387746	0.7410763	0.4820013	0.0091065	0.6519388	0.6558440	RACACOR LOCNASC ESCMAE2010
0.7383367	0.7406171	0.4865868	0.0091848	0.6570535	0.6533544	RACACOR ESCMAE2010
0.7339060	0.7361730	0.4837308	0.0090266	0.6528182	0.6557374	RACACOR LOCNASC ESCMAE2010
0.7259058	0.7279986	0.4971123	0.0086672	0.6569639	0.6537501	RACACOR LOCNASC ESCMAE2010
0.7265959	0.7287289	0.4892048	0.0088473	0.6524367	0.6556113	RACACOR LOCNASC ESCMAE2010
0.7288555	0.7310275	0.4936011	0.0085924	0.6545296	0.6543599	RACACOR ESCMAE2010
0.7357658	0.7381564	0.4782699	0.0089343	0.6480960	0.6575259	RACACOR ESCMAE2010
0.7236328	0.7256998	0.4967313	0.0086960	0.6541071	0.6544613	RACACOR LOCNASC ESCMAE2010
0.7370927	0.7394060	0.4810799	0.0091213	0.6500883	0.6565599	RACACOR LOCNASC ESCMAE2010
0.7244743	0.7264690	0.5041375	0.0087173	0.6575649	0.6539672	RACACOR LOCNASC
0.7282549	0.7304263	0.4906454	0.0086420	0.6525327	0.6555635	RACACOR LOCNASC ESCMAE2010
0.7249721	0.7270289	0.4991035	0.0086853	0.6576378	0.6533446	RACACOR LOCNASC ESCMAE2010
0.7375315	0.7397882	0.4889994	0.0091684	0.6548779	0.6548478	RACACOR
0.7264864	0.7285862	0.4923983	0.0086467	0.6538956	0.6552929	RACACOR LOCNASC
0.7260086	0.7280960	0.4967830	0.0088525	0.6526223	0.6559598	RACACOR LOCNASC
0.7280265	0.7301837	0.4930417	0.0088744	0.6529793	0.6554634	RACACOR LOCNASC ESCMAE2010
0.7226886	0.7247513	0.4974300	0.0084056	0.6533064	0.6553361	RACACOR LOCNASC ESCMAE2010
0.7271042	0.7292392	0.4939152	0.0086580	0.6560534	0.6539634	RACACOR LOCNASC ESCMAE2010
0.7356964	0.7380841	0.4740554	0.0090805	0.6504944	0.6564820	RACACOR LOCNASC ESCMAE2010
0.7323716	0.7346520	0.4836005	0.0088374	0.6498282	0.6565467	RACACOR LOCNASC
0.7241240	0.7261264	0.5054034	0.0085088	0.6604524	0.6524314	RACACOR LOCNASC ESCMAE2010
0.7451004	0.7475213	0.4775502	0.0093416	0.6565529	0.6540445	RACACOR LOCNASC ESCMAE2010
0.7261095	0.7281504	0.4988235	0.0086906	0.6549398	0.6548469	RACACOR LOCNASC
0.7327904	0.7350089	0.4867945	0.0090060	0.6546610	0.6551094	RACACOR LOCNASC
0.7345570	0.7368691	0.4825131	0.0088702	0.6507458	0.6565809	RACACOR LOCNASC
0.7189622	0.7209495	0.5001058	0.0086789	0.6528204	0.6553599	RACACOR LOCNASC
0.7246218	0.7267586	0.4923784	0.0086751	0.6505187	0.6564346	RACACOR ESCMAE2010
0.7157003	0.7175152	0.5152737	0.0085084	0.6576026	0.6529628	RACACOR LOCNASC
0.7257326	0.7278613	0.4923660	0.0086341	0.6538972	0.6553168	RACACOR LOCNASC
0.7240916	0.7261057	0.5021695	0.0084637	0.6546660	0.6544083	RACACOR LOCNASC ESCMAE2010
0.7272879	0.7294015	0.4953626	0.0087652	0.6551849	0.6544636	RACACOR LOCNASC ESCMAE2010
0.7191992	0.7211000	0.5085161	0.0085794	0.6562549	0.6541925	RACACOR
0.7283111	0.7304092	0.4963364	0.0088828	0.6541913	0.6550722	RACACOR LOCNASC ESCMAE2010
0.7276600	0.7297545	0.4956919	0.0088741	0.6585291	0.6533362	RACACOR LOCNASC ESCMAE2010
0.7278818	0.7299289	0.5012758	0.0089873	0.6564137	0.6539732	RACACOR LOCNASC ESCMAE2010
0.7271698	0.7292698	0.4941929	0.0088139	0.6576489	0.6537062	RACACOR ESCMAE2010
0.7271993	0.7293897	0.4846874	0.0087162	0.6498981	0.6566848	RACACOR LOCNASC ESCMAE2010
0.7459419	0.7483618	0.4776962	0.0093966	0.6561625	0.6539847	RACACOR LOCNASC
0.7358429	0.7382737	0.4731652	0.0088229	0.6498403	0.6566104	RACACOR LOCNASC ESCMAE2010
0.7271460	0.7291870	0.5020655	0.0087171	0.6589793	0.6528792	RACACOR LOCNASC

#Medias
apply(resultadosLogit_bootstrap[,-7],2,mean) %>% knitr::kable()

	x
Acuracia	0.7297458
Sensibilidade	0.7319133
Especificidade	0.4915247
Valor Corte	0.0088325
AUC Teste	0.6541797
AUC Treino	0.6549425

Modelagem por probit

Modelagem utilizando reamostragens

tempoProbit_kfold = Sys.time()
resultadosProbit_kfold = kfold(base_treino,link = "probit",k = 10)
tempoProbit_kfold = Sys.time() - tempoProbit_kfold

tempoProbit_bootstrap = Sys.time()
resultadosProbit_bootstrap = bootstrap(base_treino, link = "probit",k = 50,p = 0.7)
tempoProbit_bootstrap = Sys.time() - tempoProbit_bootstrap

Resultados por kfold

resultadosProbit_kfold %>% 
  knitr::kable()

Acuracia	Sensibilidade	Especificidade	Valor Corte	AUC Treino	AUC Teste	Remove
0.7400529	0.7424795	0.4726984	0.0095351	0.6560102	0.6494513	RACACOR LOCNASC
0.7375886	0.7398419	0.4844660	0.0093060	0.6555112	0.6543283	RACACOR LOCNASC
0.7361923	0.7383260	0.4977463	0.0093669	0.6545774	0.6620283	RACACOR
0.7394504	0.7416481	0.4907075	0.0094183	0.6547169	0.6600852	RACACOR LOCNASC
0.7434623	0.7460134	0.4636536	0.0096325	0.6563394	0.6457393	RACACOR LOCNASC ESCMAE2010
0.7435402	0.7457818	0.4909091	0.0095820	0.6545518	0.6605373	RACACOR LOCNASC ESCMAE2010
0.7340171	0.7363712	0.4787500	0.0093062	0.6555974	0.6510831	RACACOR LOCNASC ESCMAE2010
0.7394133	0.7417458	0.4860720	0.0094423	0.6550226	0.6578689	RACACOR LOCNASC
0.7380540	0.7403794	0.4867642	0.0094521	0.6554678	0.6565763	RACACOR LOCNASC CONSPRENAT
0.7415520	0.7439982	0.4779503	0.0094049	0.6554110	0.6524745	RACACOR

#Medias
apply(resultadosProbit_kfold[,-7],2,mean) %>% knitr::kable()

	x
Acuracia	0.7393323
Sensibilidade	0.7416585
Especificidade	0.4829718
Valor Corte	0.0094446
AUC Treino	0.6553206
AUC Teste	0.6550172

Resultados por bootstrap

resultadosProbit_bootstrap %>% 
  knitr::kable()

Acuracia	Sensibilidade	Especificidade	Valor Corte	AUC Teste	AUC Treino	Remove
0.7365806	0.7388759	0.4834781	0.0094728	0.6537530	0.6557151	RACACOR LOCNASC ESCMAE2010 CONSPRENAT
0.7371936	0.7395043	0.4831010	0.0093138	0.6517793	0.6564601	RACACOR LOCNASC ESCMAE2010
0.7395141	0.7418338	0.4872009	0.0095829	0.6554739	0.6554224	RACACOR LOCNASC ESCMAE2010 CONSPRENAT
0.7405659	0.7429317	0.4787415	0.0095462	0.6506826	0.6565949	RACACOR LOCNASC ESCMAE2010
0.7405878	0.7430141	0.4759560	0.0094422	0.6515552	0.6567947	RACACOR LOCNASC
0.7445884	0.7470510	0.4749132	0.0095958	0.6535920	0.6557052	RACACOR LOCNASC ESCMAE2010
0.7386899	0.7410012	0.4859244	0.0094017	0.6564498	0.6548044	RACACOR CONSPRENAT
0.7383739	0.7406979	0.4844127	0.0095363	0.6580331	0.6546386	RACACOR LOCNASC ESCMAE2010 CONSPRENAT
0.7378418	0.7401462	0.4875861	0.0095121	0.6569996	0.6546819	RACACOR LOCNASC ESCMAE2010 CONSPRENAT
0.7369594	0.7392086	0.4887098	0.0092781	0.6545099	0.6556787	RACACOR LOCNASC
0.7323830	0.7345612	0.4893936	0.0092331	0.6523504	0.6561897	RACACOR LOCNASC ESCMAE2010
0.7415977	0.7439162	0.4856325	0.0095803	0.6574289	0.6541865	RACACOR LOCNASC ESCMAE2010 CONSPRENAT
0.7356773	0.7379729	0.4823529	0.0093485	0.6532478	0.6565908	RACACOR LOCNASC ESCMAE2010
0.7459057	0.7483668	0.4768455	0.0095303	0.6574190	0.6540728	RACACOR LOCNASC ESCMAE2010
0.7439754	0.7464259	0.4712484	0.0096571	0.6528996	0.6560396	RACACOR LOCNASC ESCMAE2010
0.7279332	0.7300842	0.4949537	0.0090026	0.6553082	0.6549676	RACACOR LOCNASC
0.7416862	0.7441904	0.4719578	0.0094614	0.6484070	0.6581628	RACACOR LOCNASC ESCMAE2010 CONSPRENAT
0.7362084	0.7384946	0.4852383	0.0095302	0.6547391	0.6549278	RACACOR LOCNASC ESCMAE2010
0.7390782	0.7414094	0.4810799	0.0094641	0.6504587	0.6569201	RACACOR LOCNASC ESCMAE2010
0.7367091	0.7389020	0.4944833	0.0093597	0.6577595	0.6547445	RACACOR LOCNASC CONSPRENAT
0.7283692	0.7305416	0.4906454	0.0090999	0.6530394	0.6562154	RACACOR LOCNASC ESCMAE2010
0.7389459	0.7412511	0.4858137	0.0094662	0.6582138	0.6538371	RACACOR LOCNASC ESCMAE2010
0.7382882	0.7405384	0.4904802	0.0095093	0.6550014	0.6553773	RACACOR LOCNASC CONSPRENAT
0.7400653	0.7424059	0.4791221	0.0096274	0.6544034	0.6565112	RACACOR LOCNASC CONSPRENAT
0.7324573	0.7346543	0.4911929	0.0093421	0.6529569	0.6567034	RACACOR LOCNASC CONSPRENAT
0.7317891	0.7340135	0.4894841	0.0093648	0.6537729	0.6563052	RACACOR LOCNASC ESCMAE2010
0.7441962	0.7466441	0.4768698	0.0095109	0.6538232	0.6559535	RACACOR LOCNASC ESCMAE2010
0.7387384	0.7410770	0.4833193	0.0093710	0.6566562	0.6544753	RACACOR LOCNASC ESCMAE2010
0.7392629	0.7417081	0.4713188	0.0093952	0.6509991	0.6569272	RACACOR LOCNASC ESCMAE2010
0.7434014	0.7458915	0.4717594	0.0094147	0.6506106	0.6570606	RACACOR LOCNASC
0.7385366	0.7407862	0.4928129	0.0093711	0.6607326	0.6530306	RACACOR LOCNASC ESCMAE2010 CONSPRENAT
0.7405412	0.7428728	0.4828574	0.0094629	0.6571052	0.6546542	RACACOR LOCNASC ESCMAE2010
0.7366425	0.7388586	0.4898396	0.0093312	0.6553831	0.6552524	RACACOR LOCNASC
0.7365187	0.7388064	0.4828541	0.0095990	0.6554867	0.6558140	RACACOR LOCNASC CONSPRENAT
0.7415891	0.7440320	0.4752880	0.0094422	0.6514118	0.6570168	RACACOR LOCNASC
0.7384662	0.7407766	0.4840279	0.0092780	0.6538842	0.6567312	RACACOR LOCNASC
0.7353642	0.7376881	0.4827730	0.0093832	0.6507658	0.6569210	RACACOR ESCMAE2010
0.7377333	0.7399426	0.4937420	0.0093068	0.6583888	0.6536849	RACACOR LOCNASC
0.7370746	0.7394000	0.4821523	0.0092606	0.6546833	0.6557147	RACACOR LOCNASC CONSPRENAT
0.7441029	0.7464676	0.4835432	0.0095200	0.6552100	0.6550836	RACACOR LOCNASC ESCMAE2010
0.7396522	0.7419793	0.4842960	0.0095547	0.6555803	0.6549334	RACACOR LOCNASC ESCMAE2010
0.7395246	0.7417721	0.4904194	0.0093300	0.6569493	0.6550570	RACACOR LOCNASC
0.7275953	0.7296783	0.4972921	0.0092577	0.6546652	0.6559324	RACACOR LOCNASC ESCMAE2010
0.7381844	0.7404709	0.4849484	0.0094552	0.6591400	0.6541090	RACACOR LOCNASC ESCMAE2010
0.7408496	0.7431243	0.4890495	0.0097126	0.6569255	0.6546205	RACACOR LOCNASC ESCMAE2010 CONSPRENAT
0.7378018	0.7400850	0.4844965	0.0094693	0.6580370	0.6542968	RACACOR LOCNASC ESCMAE2010 CONSPRENAT
0.7355859	0.7379116	0.4780944	0.0093751	0.6504873	0.6573221	RACACOR LOCNASC
0.7392048	0.7414756	0.4874907	0.0094962	0.6568504	0.6547559	RACACOR LOCNASC CONSPRENAT
0.7320794	0.7344244	0.4786671	0.0091235	0.6504432	0.6569878	RACACOR LOCNASC ESCMAE2010
0.7363702	0.7385736	0.4933799	0.0093137	0.6593964	0.6537275	RACACOR LOCNASC CONSPRENAT

#Medias
apply(resultadosProbit_bootstrap[,-7],2,mean) %>% knitr::kable()

	x
Acuracia	0.7380196
Sensibilidade	0.7403288
Especificidade	0.4842248
Valor Corte	0.0094199
AUC Teste	0.6546770
AUC Treino	0.6555662

Modelagem por cloglog

Modelagem utilizando reamostragem

tempoCLL_kfold = Sys.time()
resultadosCLL_kfold = kfold(base_treino,link = "cloglog",k = 10)
tempoCLL_kfold = Sys.time() - tempoCLL_kfold

tempoCLL_bootstrap = Sys.time()
resultadosCLL_bootstrap = bootstrap(base_treino, link = "cloglog",k = 50,p = 0.7)
tempoCLL_bootstrap = Sys.time() - tempoCLL_bootstrap

Resultados por kfold

resultadosCLL_kfold %>% 
  knitr::kable()

Acuracia	Sensibilidade	Especificidade	Valor Corte	AUC Treino	AUC Teste	Remove
0.7236709	0.7258077	0.4882540	0.0085878	0.6554500	0.6489529	RACACOR LOCNASC
0.7254813	0.7275462	0.4935275	0.0086128	0.6549371	0.6537662	RACACOR LOCNASC
0.7272745	0.7292651	0.5048294	0.0088024	0.6538440	0.6613623	RACACOR ESCMAE2010
0.7170633	0.7188788	0.5115748	0.0085373	0.6542854	0.6589751	RACACOR LOCNASC
0.7269890	0.7292544	0.4785082	0.0087768	0.6558176	0.6451758	RACACOR LOCNASC ESCMAE2010
0.7264015	0.7283153	0.5107143	0.0087111	0.6541224	0.6601078	RACACOR LOCNASC ESCMAE2010
0.7282976	0.7305585	0.4831250	0.0087573	0.6549996	0.6507506	RACACOR LOCNASC ESCMAE2010
0.7265607	0.7286308	0.5017214	0.0086445	0.6544982	0.6573515	RACACOR LOCNASC
0.7281626	0.7303100	0.4961071	0.0087300	0.6547106	0.6560011	RACACOR LOCNASC ESCMAE2010
0.7372202	0.7396119	0.4795031	0.0089784	0.6548833	0.6520717	RACACOR

#Medias
apply(resultadosCLL_kfold[,-7],2,mean) %>% knitr::kable()

	x
Acuracia	0.7267122
Sensibilidade	0.7288179
Especificidade	0.4947865
Valor Corte	0.0087138
AUC Treino	0.6547548
AUC Teste	0.6544515

Resultados por bootstrap

resultadosLogit_bootstrap %>% 
  knitr::kable()

Acuracia	Sensibilidade	Especificidade	Valor Corte	AUC Teste	AUC Treino	Remove
0.7279180	0.7300531	0.4924804	0.0088337	0.6531274	0.6552235	RACACOR LOCNASC ESCMAE2010
0.7278818	0.7300271	0.4919730	0.0087668	0.6516083	0.6560088	RACACOR LOCNASC ESCMAE2010
0.7360190	0.7382874	0.4892906	0.0090407	0.6550847	0.6547154	RACACOR LOCNASC ESCMAE2010
0.7243239	0.7264075	0.4937287	0.0087435	0.6502063	0.6561733	RACACOR LOCNASC ESCMAE2010
0.7283063	0.7305220	0.4866422	0.0087396	0.6510360	0.6563172	RACACOR LOCNASC
0.7455402	0.7480163	0.4743873	0.0091741	0.6533349	0.6552264	RACACOR LOCNASC ESCMAE2010
0.7168272	0.7187591	0.5055672	0.0084298	0.6560167	0.6542026	RACACOR
0.7458743	0.7483515	0.4751758	0.0092570	0.6576479	0.6536117	RACACOR LOCNASC ESCMAE2010
0.7339107	0.7361559	0.4900897	0.0090241	0.6570148	0.6540965	RACACOR LOCNASC ESCMAE2010
0.7327761	0.7349566	0.4921022	0.0089399	0.6541232	0.6551782	RACACOR LOCNASC
0.7387746	0.7410763	0.4820013	0.0091065	0.6519388	0.6558440	RACACOR LOCNASC ESCMAE2010
0.7383367	0.7406171	0.4865868	0.0091848	0.6570535	0.6533544	RACACOR ESCMAE2010
0.7339060	0.7361730	0.4837308	0.0090266	0.6528182	0.6557374	RACACOR LOCNASC ESCMAE2010
0.7259058	0.7279986	0.4971123	0.0086672	0.6569639	0.6537501	RACACOR LOCNASC ESCMAE2010
0.7265959	0.7287289	0.4892048	0.0088473	0.6524367	0.6556113	RACACOR LOCNASC ESCMAE2010
0.7288555	0.7310275	0.4936011	0.0085924	0.6545296	0.6543599	RACACOR ESCMAE2010
0.7357658	0.7381564	0.4782699	0.0089343	0.6480960	0.6575259	RACACOR ESCMAE2010
0.7236328	0.7256998	0.4967313	0.0086960	0.6541071	0.6544613	RACACOR LOCNASC ESCMAE2010
0.7370927	0.7394060	0.4810799	0.0091213	0.6500883	0.6565599	RACACOR LOCNASC ESCMAE2010
0.7244743	0.7264690	0.5041375	0.0087173	0.6575649	0.6539672	RACACOR LOCNASC
0.7282549	0.7304263	0.4906454	0.0086420	0.6525327	0.6555635	RACACOR LOCNASC ESCMAE2010
0.7249721	0.7270289	0.4991035	0.0086853	0.6576378	0.6533446	RACACOR LOCNASC ESCMAE2010
0.7375315	0.7397882	0.4889994	0.0091684	0.6548779	0.6548478	RACACOR
0.7264864	0.7285862	0.4923983	0.0086467	0.6538956	0.6552929	RACACOR LOCNASC
0.7260086	0.7280960	0.4967830	0.0088525	0.6526223	0.6559598	RACACOR LOCNASC
0.7280265	0.7301837	0.4930417	0.0088744	0.6529793	0.6554634	RACACOR LOCNASC ESCMAE2010
0.7226886	0.7247513	0.4974300	0.0084056	0.6533064	0.6553361	RACACOR LOCNASC ESCMAE2010
0.7271042	0.7292392	0.4939152	0.0086580	0.6560534	0.6539634	RACACOR LOCNASC ESCMAE2010
0.7356964	0.7380841	0.4740554	0.0090805	0.6504944	0.6564820	RACACOR LOCNASC ESCMAE2010
0.7323716	0.7346520	0.4836005	0.0088374	0.6498282	0.6565467	RACACOR LOCNASC
0.7241240	0.7261264	0.5054034	0.0085088	0.6604524	0.6524314	RACACOR LOCNASC ESCMAE2010
0.7451004	0.7475213	0.4775502	0.0093416	0.6565529	0.6540445	RACACOR LOCNASC ESCMAE2010
0.7261095	0.7281504	0.4988235	0.0086906	0.6549398	0.6548469	RACACOR LOCNASC
0.7327904	0.7350089	0.4867945	0.0090060	0.6546610	0.6551094	RACACOR LOCNASC
0.7345570	0.7368691	0.4825131	0.0088702	0.6507458	0.6565809	RACACOR LOCNASC
0.7189622	0.7209495	0.5001058	0.0086789	0.6528204	0.6553599	RACACOR LOCNASC
0.7246218	0.7267586	0.4923784	0.0086751	0.6505187	0.6564346	RACACOR ESCMAE2010
0.7157003	0.7175152	0.5152737	0.0085084	0.6576026	0.6529628	RACACOR LOCNASC
0.7257326	0.7278613	0.4923660	0.0086341	0.6538972	0.6553168	RACACOR LOCNASC
0.7240916	0.7261057	0.5021695	0.0084637	0.6546660	0.6544083	RACACOR LOCNASC ESCMAE2010
0.7272879	0.7294015	0.4953626	0.0087652	0.6551849	0.6544636	RACACOR LOCNASC ESCMAE2010
0.7191992	0.7211000	0.5085161	0.0085794	0.6562549	0.6541925	RACACOR
0.7283111	0.7304092	0.4963364	0.0088828	0.6541913	0.6550722	RACACOR LOCNASC ESCMAE2010
0.7276600	0.7297545	0.4956919	0.0088741	0.6585291	0.6533362	RACACOR LOCNASC ESCMAE2010
0.7278818	0.7299289	0.5012758	0.0089873	0.6564137	0.6539732	RACACOR LOCNASC ESCMAE2010
0.7271698	0.7292698	0.4941929	0.0088139	0.6576489	0.6537062	RACACOR ESCMAE2010
0.7271993	0.7293897	0.4846874	0.0087162	0.6498981	0.6566848	RACACOR LOCNASC ESCMAE2010
0.7459419	0.7483618	0.4776962	0.0093966	0.6561625	0.6539847	RACACOR LOCNASC
0.7358429	0.7382737	0.4731652	0.0088229	0.6498403	0.6566104	RACACOR LOCNASC ESCMAE2010
0.7271460	0.7291870	0.5020655	0.0087171	0.6589793	0.6528792	RACACOR LOCNASC

#Medias
apply(resultadosCLL_bootstrap[,-7],2,mean) %>% knitr::kable()

	x
Acuracia	0.7292765
Sensibilidade	0.7314366
Especificidade	0.4918746
Valor Corte	0.0087785
AUC Teste	0.6541136
AUC Treino	0.6548582

Tabela de métricas dos modelos por reamostragem

options(scipen = 999)
tabela = tibble(Reamostragem = c(rep("bootstrap",3),
                                 rep("kfold",3)),
                Modelo = c(rep(c("logit","probit","cll"),2)),
                `Media de Acurácia` = c(mean(resultadosLogit_bootstrap$Acuracia),
                                             mean(resultadosProbit_bootstrap$Acuracia),
                                             mean(resultadosCLL_bootstrap$Acuracia),
                                             mean(resultadosLogit_kfold$Acuracia),
                                             mean(resultadosProbit_kfold$Acuracia),
                                             mean(resultadosCLL_kfold$Acuracia)),
                `Media de Sensibilidade` = c(mean(resultadosLogit_bootstrap$Sensibilidade),
                                             mean(resultadosProbit_bootstrap$Sensibilidade),
                                             mean(resultadosCLL_bootstrap$Sensibilidade),
                                             mean(resultadosLogit_kfold$Sensibilidade),
                                             mean(resultadosProbit_kfold$Sensibilidade),
                                             mean(resultadosCLL_kfold$Sensibilidade)),
                `Media de Especificidade` = c(mean(resultadosLogit_bootstrap$Especificidade),
                                             mean(resultadosProbit_bootstrap$Especificidade),
                                             mean(resultadosCLL_bootstrap$Especificidade),
                                             mean(resultadosLogit_kfold$Especificidade),
                                             mean(resultadosProbit_kfold$Especificidade),
                                             mean(resultadosCLL_kfold$Especificidade)),
                `Media de AUC teste` = c(mean(resultadosLogit_bootstrap$`AUC Teste`),
                                             mean(resultadosProbit_bootstrap$`AUC Teste`),
                                             mean(resultadosCLL_bootstrap$`AUC Teste`),
                                             mean(resultadosLogit_kfold$`AUC Teste`),
                                             mean(resultadosProbit_kfold$`AUC Teste`),
                                             mean(resultadosCLL_kfold$`AUC Teste`)),
                `Desvio de AUC teste` =  c(sd(resultadosLogit_bootstrap$`AUC Teste`),
                                             sd(resultadosProbit_bootstrap$`AUC Teste`),
                                             sd(resultadosCLL_bootstrap$`AUC Teste`),
                                             sd(resultadosLogit_kfold$`AUC Teste`),
                                             sd(resultadosProbit_kfold$`AUC Teste`),
                                             sd(resultadosCLL_kfold$`AUC Teste`)))

tabela = tabela %>% 
  mutate(`Coeficiente de variação do AUC teste (%)` = (tabela$`Desvio de AUC teste`/tabela$`Media de AUC teste`) * 100)

tabela %>% 
  mutate_if(is.numeric,round,4)%>% 
    DT::datatable(
    extensions = 'FixedColumns',
    options = list(
      dom = 't',
      scrollX = TRUE,
      columnDefs = list(list(
        className = 'dt-center', targets = "_all"
      ))
    ),
    rownames = FALSE
  ) %>%
  DT::formatStyle(0, lineHeight = '50%')

Distâncias absolutas em relação a média

# Logit

tabelaLogit_kfold = resultadosLogit_kfold %>% 
  select(Acuracia,
         Sensibilidade,
         Especificidade,
         `AUC Teste`,
         Remove) %>% 
  mutate(`Distancia abs AUC teste` = abs(`AUC Teste` - filter(tabela, Reamostragem == "kfold", Modelo == "logit") %>% select(`Media de AUC teste`) %>% pull()) ) %>% 
  arrange(`Distancia abs AUC teste`) %>% 
  head(5)


tabelaLogit_bootstrap = resultadosLogit_bootstrap %>% 
  select(Acuracia,
         Sensibilidade,
         Especificidade,
         `AUC Teste`,
         Remove) %>% 
  mutate(`Distancia abs AUC teste` = abs(`AUC Teste` - filter(tabela, Reamostragem == "bootstrap", Modelo == "logit") %>% select(`Media de AUC teste`) %>% pull()) ) %>% 
  arrange(`Distancia abs AUC teste`) %>% 
  head(5)

# Probit


tabelaProbit_kfold = resultadosProbit_kfold %>% 
  select(Acuracia,
         Sensibilidade,
         Especificidade,
         `AUC Teste`,
         Remove) %>% 
  mutate(`Distancia abs AUC teste` = abs(`AUC Teste` - filter(tabela, Reamostragem == "kfold", Modelo == "probit") %>% select(`Media de AUC teste`) %>% pull()) ) %>% 
  arrange(`Distancia abs AUC teste`) %>% 
  head(5)


tabelaProbit_bootstrap = resultadosProbit_bootstrap %>% 
  select(Acuracia,
         Sensibilidade,
         Especificidade,
         `AUC Teste`,
         Remove) %>% 
  mutate(`Distancia abs AUC teste` = abs(`AUC Teste` - filter(tabela, Reamostragem == "bootstrap", Modelo == "probit") %>% select(`Media de AUC teste`) %>% pull()) ) %>% 
  arrange(`Distancia abs AUC teste`) %>% 
  head(5)


# CLL

tabelaCLL_kfold = resultadosCLL_kfold %>% 
  select(Acuracia,
         Sensibilidade,
         Especificidade,
         `AUC Teste`,
         Remove) %>% 
  mutate(`Distancia abs AUC teste` = abs(`AUC Teste` - filter(tabela, Reamostragem == "kfold", Modelo == "cll") %>% select(`Media de AUC teste`) %>% pull()) ) %>% 
  arrange(`Distancia abs AUC teste`) %>% 
  head(5)


tabelaCLL_bootstrap = resultadosCLL_bootstrap %>% 
  select(Acuracia,
         Sensibilidade,
         Especificidade,
         `AUC Teste`,
         Remove) %>% 
  mutate(`Distancia abs AUC teste` = abs(`AUC Teste` - filter(tabela, Reamostragem == "bootstrap", Modelo == "cll") %>% select(`Media de AUC teste`) %>% pull()) ) %>% 
  arrange(`Distancia abs AUC teste`) %>% 
  head(5)

print("Distância absoluta da média do AUC teste para cada amostra do Logit utilizando kfold (para os 5 menores)")

## [1] "Distância absoluta da média do AUC teste para cada amostra do Logit utilizando kfold (para os 5 menores)"

tabelaLogit_kfold %>% 
    DT::datatable(
    extensions = 'FixedColumns',
    options = list(
      dom = 't',
      scrollX = TRUE,
      columnDefs = list(list(
        className = 'dt-center', targets = "_all"
      ))
    ),
    rownames = FALSE
  ) %>%
  DT::formatStyle(0, lineHeight = '50%')

print("Distância absoluta da média do AUC teste para cada amostra do Logit utilizando bootstrap (para os 5 menores)")

## [1] "Distância absoluta da média do AUC teste para cada amostra do Logit utilizando bootstrap (para os 5 menores)"

tabelaLogit_bootstrap %>% 
    DT::datatable(
    extensions = 'FixedColumns',
    options = list(
      dom = 't',
      scrollX = TRUE,
      columnDefs = list(list(
        className = 'dt-center', targets = "_all"
      ))
    ),
    rownames = FALSE
  ) %>%
  DT::formatStyle(0, lineHeight = '50%')

print("Distância absoluta da média do AUC teste para cada amostra do Probit utilizando kfold (para os 5 menores)")

## [1] "Distância absoluta da média do AUC teste para cada amostra do Probit utilizando kfold (para os 5 menores)"

tabelaProbit_kfold %>% 
    DT::datatable(
    extensions = 'FixedColumns',
    options = list(
      dom = 't',
      scrollX = TRUE,
      columnDefs = list(list(
        className = 'dt-center', targets = "_all"
      ))
    ),
    rownames = FALSE
  ) %>%
  DT::formatStyle(0, lineHeight = '50%')

print("Distância absoluta da média do AUC teste para cada amostra do Probit utilizando bootstrap (para os 5 menores)")

## [1] "Distância absoluta da média do AUC teste para cada amostra do Probit utilizando bootstrap (para os 5 menores)"

tabelaProbit_bootstrap %>% 
    DT::datatable(
    extensions = 'FixedColumns',
    options = list(
      dom = 't',
      scrollX = TRUE,
      columnDefs = list(list(
        className = 'dt-center', targets = "_all"
      ))
    ),
    rownames = FALSE
  ) %>%
  DT::formatStyle(0, lineHeight = '50%')

print("Distância absoluta da média do AUC teste para cada amostra do CLL utilizando kfold (para os 5 menores)")

## [1] "Distância absoluta da média do AUC teste para cada amostra do CLL utilizando kfold (para os 5 menores)"

tabelaCLL_kfold %>% 
    DT::datatable(
    extensions = 'FixedColumns',
    options = list(
      dom = 't',
      scrollX = TRUE,
      columnDefs = list(list(
        className = 'dt-center', targets = "_all"
      ))
    ),
    rownames = FALSE
  ) %>%
  DT::formatStyle(0, lineHeight = '50%')

print("Distância absoluta da média do AUC teste para cada amostra do CLL utilizando bootstrap (para os 5 menores)")

## [1] "Distância absoluta da média do AUC teste para cada amostra do CLL utilizando bootstrap (para os 5 menores)"

tabelaCLL_bootstrap %>% 
    DT::datatable(
    extensions = 'FixedColumns',
    options = list(
      dom = 't',
      scrollX = TRUE,
      columnDefs = list(list(
        className = 'dt-center', targets = "_all"
      ))
    ),
    rownames = FALSE
  ) %>%
  DT::formatStyle(0, lineHeight = '50%')

Modelo escolhido

A partir dos modelos gerados utilizando técnicas de reamostragem para simular suas métricas de classificação, será escolhido o melhor modelo para ajustar os dados com a metodologia de treino e teste (70%,30%), os betas estimados, curva ROC.

Os modelos escolhidos foram: Probit removendo RACACOR LOCNASC CONSPRENAT -> Por bootstrap Probit removendo RACACOR LOCNASC -> Por kfold

roc_graph = function(prediction, obs, titulo,AUC = FALSE,dados){
  prediction = ROCR::prediction(prediction, obs)
  performance = ROCR::performance(prediction, "tpr", "fpr")
  auc = ROCR::performance(prediction, measure = "auc")@y.values[[1]]
  df = data.frame(xvalues = performance@x.values[[1]], 
                  yvalues = performance@y.values[[1]],
                  alpha_ = performance@alpha.values[[1]])
  
  if(AUC == FALSE){
    graf = 
      df %>%
        ggplot(aes(x = xvalues, y = yvalues)) +
        geom_line(size = 2, col = "royalblue") +
        geom_abline(slope = 1, alpha = 0.5) +
        geom_text(
          x = .85,
          y = .45,
          label = paste("A =", round(dados$Acuracia, 3)),
          size = 5
        ) +
        geom_text(
          x = .85,
          y = .25,
          label = paste("S =", round(dados$Sensibilidade, 3)),
          size = 5
        ) +
        geom_text(
          x = .85,
          y = .35,
          label = paste("E =", round(dados$Especificidade, 3)),
          size = 5
        ) +
        geom_text(
          x = .85,
          y = .15,
          label = paste("Ponto de corte =", round(dados$`Ponto Corte`, 3)),
          size = 5
        ) +
        geom_text(
          x = .85,
          y = .55,
          label = paste("AUC =", round(auc, 3)),
          size = 5
        ) +
      
        scale_color_gradient(
          low = "blue",
          high = "green",
          breaks = c(0, .25, .5, .75, 1),
          limits = c(0, 1)
        ) +
        coord_cartesian(clip = 'off') +
        ylab('Taxa de verdadeiros Positivos (Sensibilidade)') +
        xlab('Taxa de falsos Positivos (1 - Especificidade)') +
        ggtitle(titulo)
    
  }
  return(graf)
}

#Bootstrap
modelo1 = glm(IDANOMAL ~ .,
              data = select(base_treino, -c(RACACOR,
                                            LOCNASC,
                                            CONSPRENAT)),
              family = binomial("probit"))
summary(modelo1)

## 
## Call:
## glm(formula = IDANOMAL ~ ., family = binomial("probit"), data = select(base_treino, 
##     -c(RACACOR, LOCNASC, CONSPRENAT)))
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.6477  -0.1391  -0.1208  -0.1053   3.4944  
## 
## Coefficients:
##                                Estimate Std. Error z value             Pr(>|z|)
## (Intercept)                   -1.196720   0.014390 -83.165 < 0.0000000000000002
## GESTACAONão                   -0.101561   0.006891 -14.739 < 0.0000000000000002
## SEXOFeminino                  -0.091412   0.004311 -21.206 < 0.0000000000000002
## PARTOCesaria                   0.117675   0.004542  25.906 < 0.0000000000000002
## ESCMAE2010Tem ensino superior  0.013669   0.005814   2.351              0.01871
## IDADEMAEDe 18 a 35            -0.090463   0.005104 -17.725 < 0.0000000000000002
## GRAVIDEZMúltipla              -0.207092   0.013321 -15.546 < 0.0000000000000002
## APGAR5Maior ou igual 7        -0.826101   0.010538 -78.394 < 0.0000000000000002
## PESONão baixo                 -0.400793   0.007013 -57.149 < 0.0000000000000002
## PARIDADENão nulipara           0.018151   0.004413   4.113         0.0000389784
## REGIAONordeste                 0.052465   0.009584   5.474         0.0000000439
## REGIAONorte                   -0.030809   0.011577  -2.661              0.00779
## REGIAOSudeste                  0.166481   0.008945  18.611 < 0.0000000000000002
## REGIAOSul                      0.057249   0.010142   5.645         0.0000000165
##                                  
## (Intercept)                   ***
## GESTACAONão                   ***
## SEXOFeminino                  ***
## PARTOCesaria                  ***
## ESCMAE2010Tem ensino superior *  
## IDADEMAEDe 18 a 35            ***
## GRAVIDEZMúltipla              ***
## APGAR5Maior ou igual 7        ***
## PESONão baixo                 ***
## PARIDADENão nulipara          ***
## REGIAONordeste                ***
## REGIAONorte                   ** 
## REGIAOSudeste                 ***
## REGIAOSul                     ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 359356  on 3502021  degrees of freedom
## Residual deviance: 342884  on 3502008  degrees of freedom
## AIC: 342912
## 
## Number of Fisher Scoring iterations: 7

teste_wald(modelo1, "IDANOMAL", 0.05)

## NULL

predicao_treino = predict(modelo1,
                          select(base_treino, -c(RACACOR,
                                                 LOCNASC,
                                                 CONSPRENAT)),
                          type = 'response')

valor_corte = otimizador(predicao_treino, select(base_treino, -c(RACACOR,
                                                                 LOCNASC,
                                                                 CONSPRENAT))$IDANOMAL)

## Loading required package: ROCR

predicao_teste_prob = predict(modelo1,
                              select(base_teste, -c(RACACOR,
                                                    LOCNASC,
                                                    CONSPRENAT)),
                              type = 'response')

predicao_teste_pred = ifelse(predicao_teste_prob >= valor_corte, 1, 0) %>% as.factor(.)

info = confusionMatrix(
  data = predicao_teste_pred,
  reference = base_teste %>%
    select(-c(RACACOR,
              LOCNASC,
              CONSPRENAT)) %>%
    mutate(IDANOMAL = as.factor(IDANOMAL)) %>%
    .$IDANOMAL,
  positive = '1'
  
)

lista = tibble(
  Acuracia = info$overall[[1]],
  Sensibilidade = info$byClass[[1]],
  Especificidade = info$byClass[[2]],
  `Ponto Corte` = valor_corte,
)

options(OutDec = ",")
roc_bootstrap = roc_graph(
  predicao_teste_prob,
  select(base_teste, -c(RACACOR,
                        LOCNASC,
                        CONSPRENAT))$IDANOMAL,
  "",
  AUC = F,
  dados = lista
)

# Kfold
modelo2 = glm(IDANOMAL ~ .,
              data = select(base_treino, -c(RACACOR,
                                            LOCNASC)),
              family = binomial("probit"))

summary(modelo2)

## 
## Call:
## glm(formula = IDANOMAL ~ ., family = binomial("probit"), data = select(base_treino, 
##     -c(RACACOR, LOCNASC)))
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0,6510  -0,1392  -0,1209  -0,1057   3,4919  
## 
## Coefficients:
##                                Estimate Std. Error z value             Pr(>|z|)
## (Intercept)                   -1,203075   0,014573 -82,557 < 0,0000000000000002
## GESTACAONão                   -0,103784   0,006938 -14,958 < 0,0000000000000002
## SEXOFeminino                  -0,091490   0,004311 -21,223 < 0,0000000000000002
## PARTOCesaria                   0,116256   0,004572  25,425 < 0,0000000000000002
## ESCMAE2010Tem ensino superior  0,012217   0,005838   2,093              0,03639
## IDADEMAEDe 18 a 35            -0,090711   0,005105 -17,770 < 0,0000000000000002
## GRAVIDEZMúltipla              -0,208500   0,013334 -15,637 < 0,0000000000000002
## CONSPRENAT6 ou mais consultas  0,015663   0,005855   2,675              0,00747
## APGAR5Maior ou igual 7        -0,828130   0,010570 -78,346 < 0,0000000000000002
## PESONão baixo                 -0,402480   0,007041 -57,161 < 0,0000000000000002
## PARIDADENão nulipara           0,018807   0,004419   4,256         0,0000208319
## REGIAONordeste                 0,052928   0,009585   5,522         0,0000000336
## REGIAONorte                   -0,028865   0,011600  -2,488              0,01283
## REGIAOSudeste                  0,165747   0,008949  18,522 < 0,0000000000000002
## REGIAOSul                      0,056249   0,010148   5,543         0,0000000298
##                                  
## (Intercept)                   ***
## GESTACAONão                   ***
## SEXOFeminino                  ***
## PARTOCesaria                  ***
## ESCMAE2010Tem ensino superior *  
## IDADEMAEDe 18 a 35            ***
## GRAVIDEZMúltipla              ***
## CONSPRENAT6 ou mais consultas ** 
## APGAR5Maior ou igual 7        ***
## PESONão baixo                 ***
## PARIDADENão nulipara          ***
## REGIAONordeste                ***
## REGIAONorte                   *  
## REGIAOSudeste                 ***
## REGIAOSul                     ***
## ---
## Signif. codes:  0 '***' 0,001 '**' 0,01 '*' 0,05 '.' 0,1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 359356  on 3502021  degrees of freedom
## Residual deviance: 342876  on 3502007  degrees of freedom
## AIC: 342906
## 
## Number of Fisher Scoring iterations: 7

teste_wald(modelo2, "IDANOMAL", 0.05)

## NULL

predicao_treino = predict(modelo2,
                          select(base_treino, -c(RACACOR,
                                                 LOCNASC)),
                          type = 'response')

valor_corte = otimizador(predicao_treino, select(base_treino, -c(RACACOR,
                                                                 LOCNASC))$IDANOMAL)

predicao_teste_prob = predict(modelo2,
                              select(base_teste, -c(RACACOR,
                                                    LOCNASC)),
                              type = 'response')

predicao_teste_pred = ifelse(predicao_teste_prob >= valor_corte, 1, 0) %>% as.factor(.)

info = confusionMatrix(
  data = predicao_teste_pred,
  reference = base_teste %>%
    select(-c(RACACOR,
              LOCNASC)) %>%
    mutate(IDANOMAL = as.factor(IDANOMAL)) %>%
    .$IDANOMAL,
  positive = "1"
)

lista = tibble(
  Acuracia = info$overall[[1]],
  Sensibilidade = info$byClass[[1]],
  Especificidade = info$byClass[[2]],
  `Ponto Corte` = valor_corte,
)

options(OutDec = ",")
roc_kfold = roc_graph(
  predicao_teste_prob,
  select(base_teste, -c(RACACOR,
                        LOCNASC))$IDANOMAL,
  "",
  AUC = F,
  dados = lista
)

roc_bootstrap

roc_kfold

Tempo de execução:

tibble(
  Tempo = c(
    tempoLogit_kfold %>% as.numeric(),
    tempoProbit_kfold %>% as.numeric(),
    tempoCLL_kfold %>% as.numeric()
  ),
  Modelos = factor(
    c("Logit",
      "Probit",
      "Complemento log-log")
    ,
    levels = c("Logit",
      "Probit",
      "Complemento log-log")
  )
)  %>%
  ggplot(aes(x = Modelos, y = Tempo)) +
  geom_bar(fill = "royalblue",
           stat = "identity") +
  labs(x = "Modelos",
       y = "Tempo(minutos)") +
  theme_minimal() +
  geom_text(aes(y = Tempo, label = round(Tempo, 3)),
            vjust = -0.5,
            cex = 5) +
  ylim(c(0, 60))

Resultados do TCC2

Lyncoln Sousa de Oliveira

2021-04-22

Base de dados tratada

Tabulações das variáveis explicativas com o desfecho

Função auxiliar para modelagem

Definindo funções de reamostragem

Definir bases

Modelagem por logit

Modelagem por probit

Modelagem por cloglog

Tabela de métricas dos modelos por reamostragem

Distâncias absolutas em relação a média

Modelo escolhido

Tempo de execução: