Fatores perinatais e desenvolvimento de transtorno bipolar
Bruno Montezano
2022-08-06
Introdução
O presente trabalho almeja observar os efeitos de fatores perinatais e do aleitamento materno no desenvolvimento de transtorno bipolar (TB) aos 18 e 22 anos de idade. Os dados utilizados para tal foram coletados em uma coorte de nascimento coordenada pelo Centro de Epidemiologia da Universidade Federal de Pelotas intitulada “Coorte de 1993”.
# Seed para reprodutibilidade dos resultados
set.seed(1)
# Carrega dados da Coorte de 1993
dados_coorte <- haven::read_sav("data/banco_QI_15_07.sav",
user_na = FALSE)Transtorno bipolar
O diagnóstico de transtorno bipolar será calculado pela MINI (Mini International Neuropsychiatric Interview) por meio dos critérios diagnósticos do DSM-IV. Serão calculados diagnósticos de transtorno bipolar tipo I e transtorno bipolar tipo II.
# Número de sujeitos incluídos
dados_coorte |>
dplyr::filter((!is.na(MDD_BD1_2_notmood)) |
(!is.na(TB1_18anos)) |
(!is.na(TBII.p1_18anos))) |>
nrow()## [1] 3794# Quem foi avaliado em cada tempo?
#dados_coorte |>
# dplyr::filter((!is.na(MDD_BD1_2_notmood)) |
# (!is.na(TB1_18anos)) |
# (!is.na(TBII.p1_18anos))) |>
# dplyr::mutate(
# av18 = dplyr::if_else(!is.na(MDD_BD1_2_notmood), "Sim", "Não"),
# av22 = dplyr::if_else(!is.na(kmini1), "Sim", "Não"),
# av_quais = dplyr::case_when(
# av18 == "Sim" & av22 == "Sim" ~ "Avaliado em ambos os tempos",
# av18 == "Sim" & av22 == "Não" ~ "Avaliado aos 18 anos apenas",
# av18 == "Não" & av22 == "Sim" ~ "Avaliado aos 22 anos apenas"
# )
# ) |>
# dplyr::count(av_quais)
# Criar variável de desfecho, além de uma variável com os subtipos de TB
dados_com_desfecho <- dados_coorte |>
haven::as_factor() |>
dplyr::mutate(
tb1_22 = dplyr::if_else(
MDD_BD1_2_notmood == "Bipolar Disorder 1",
"Sim", "Não"
),
tb2_22 = dplyr::if_else(
MDD_BD1_2_notmood == "Bipolar Disorder 2",
"Sim", "Não"
),
tb1_18 = dplyr::if_else(
TB1_18anos == 1,
"Sim", "Não"
),
tb2_18 = dplyr::if_else(
TBII.p1_18anos == 1,
"Sim", "Não"
),
outcome_subtypes = dplyr::case_when(
tb1_22 == "Sim" ~ "TB I aos 22 anos",
tb1_18 == "Sim" ~ "TB I aos 18 anos",
tb2_22 == "Sim" ~ "TB II aos 22 anos",
tb2_18 == "Sim" ~ "TB II aos 18 anos",
tb1_22 == "Não" |
tb2_22 == "Não" |
tb1_18 == "Não" |
tb2_18 == "Não" ~ "Sem TB",
TRUE ~ NA_character_
),
outcome = dplyr::case_when(
tb1_22 == "Sim" |
tb2_22 == "Sim" |
tb1_18 == "Sim" |
tb2_18 == "Sim" ~ "Sim",
tb1_22 == "Não" |
tb2_22 == "Não" |
tb1_18 == "Não" |
tb2_18 == "Não" ~ "Não",
TRUE ~ NA_character_
)
) |>
dplyr::filter(!is.na(outcome))Criação das variáveis de episódio de humor e filtragem para reter variáveis perinatais
# Vetor com as variáveis perinatais indicadas pela pesquisadora para
# construção de novas features
vars_vanessa <- c("apartip", "ainduz", "aprobrn", "aerrado",
"aprobrn", "aprobrn1", "aprobrn2", "aprobrn3",
"aprobrn", "aprobrn1", "aprobrn2", "aprobrn3",
"aprobrn", "aprobrn1", "aprobrn2", "aprobrn3",
"aprobrn", "aprobrn1", "aprobrn2", "aprobrn3",
"ahipert", "adiabet", "ainfecur", "aoutinf",
"aanemia", "amotcesa", "apartind", "afumou",
"acompfum", "abebalc", "aalcool", "avivmar",
"asexrn", "apesorn", "acompr", "apcrn", "aescol3",
"aescpai", "aescmae", "aparidad", "aapoio", "aidadmae",
"aidadpai", "apretama", "aapgar1", "aapgar5",
"arenfam")
# Filtrar base para manter subamostra da avaliação aos 22 anos
# Transformar variáveis com rótulos em variáveis tipo fator
# Criar subconjunto com variável diagnóstico e variáveis perinatais
da <- dados_com_desfecho |>
dplyr::select(outcome, dplyr::any_of(vars_vanessa))Criação do diagnóstico de TB
Além da manutenção de variável de TB, a base de dados foi filtrada para manter somente os sujeitos avaliados aos 18 ou 22 anos (através da filtragem por meio de uma variável de diagnóstico da doença da avaliação em 2015).
Abaixo, segue um gráfico de barras com a proporção de bipolares e não-bipolares na amostra:
da |>
dplyr::count(outcome) |>
ggplot2::ggplot(ggplot2::aes(x = outcome, y = n)) +
ggplot2::geom_col(fill = "royalblue") +
ggplot2::geom_text(ggplot2::aes(label = n), vjust = -0.5, size = 7) +
ggplot2::theme_minimal(base_size = 20) +
ggplot2::labs(x = "\nDiagnóstico",
y = "Número de sujeitos\n",
title = "Distribuição de sujeitos com diagnóstico e sem diagnóstico de transtorno bipolar",
subtitle = "Avaliações aos 18 e 22 anos") +
ggplot2::theme(
axis.text.x = ggplot2::element_text(size = 20),
axis.text.y = ggplot2::element_text(size = 20)
)
E mais um gráfico, agora para demonstrar a distribuição dos subtipos de transtorno bipolar (tipo I e tipo II) e o momento em que o diagnóstico foi concretizado:
dados_com_desfecho |>
dplyr::count(outcome_subtypes) |>
ggplot2::ggplot(ggplot2::aes(x = outcome_subtypes, y = n)) +
ggplot2::geom_col(fill = "darkorange") +
ggplot2::geom_text(ggplot2::aes(label = n), vjust = -0.5, size = 7) +
ggplot2::theme_minimal(base_size = 20) +
ggplot2::labs(x = "\nSubtipo e idade de diagnóstico",
y = "Número de sujeitos\n",
title = "Distribuição dos subtipos de transtorno bipolar (TB) e idade de diagnóstico",
subtitle = "Avaliação do desfecho aos 18 e 22 anos") +
ggplot2::theme(
axis.text.x = ggplot2::element_text(size = 20),
axis.text.y = ggplot2::element_text(size = 20)
)
Fatores perinatais e transtorno bipolar
Construção de variáveis e técnicas de imputação
As seguintes variáveis foram construídas:
tb_dic: Diagnóstico de TB tipo I ou TB tipo II (dicotômica)complicacoes: Variáveis de prematuridade, traumatismo no parto, disfunção respiratória no parto, malformação no parto e sofrimento fetal agrupadas (através do operador OU)cesarea: O parto foi cesária?parto_induzido: A bolsa rompeu, foi utilizado soro ou ambas as coisas?uti_neo: O recém-nascido foi para UTI?hipert_materna: Hipertensão arterial maternadm_materna: Diabetes maternainfec_gest: Infecção gestacionalanemia_gest: Anemia gestacionalhemorr_parto: Apresentou hemorragia no partotab_gest: Contato com tabagismo na gestação (ativo ou passivo)etil_pesado_gest: Etilismo pesado na gestaçãorup_famil: Ruptura familiarbaixo_peso: Baixo peso ao nascerbaixo_comp: Baixo comprimento ao nascerper_cef: Perímetro cefálico (numérico)escol_paterna: Escolaridade paternaescol_materna: Escolaridade maternaparidade: Paridade (dicotômica) [4 ou mais e menos que 4]apoio_familiar: Teve apoio da famíla/vizinhos/amigos?idade_mae_num: Idade da mãe (numérica)pretende_amamentar: Mãe pretende amamentarapgar_1: Apgar no minuto 1 (escore bruto)apgar_5: Apgar no minuto 5 (escore bruto)renda_familiar: Renda familiar (em salários mínimos)
As variáveis de idade materna foram utilizadas através das três codificações pois os autores consideraram a hipótese da relação da idade com o desfecho não ser puramente linear. Dessa forma, esta foi uma forma na qual se pensou uma maneira de considerar possível associação.
da_proc <- da |>
dplyr::transmute(
# Desfecho: transtorno bipolar aos 18 ou 22 anos de idade
tb_dic = factor(dplyr::if_else(outcome == "Sim",
"Sim",
"Não"
),
levels = c("Não", "Sim")
),
# Cesárea ou parto normal
cesarea = as.factor(dplyr::if_else(apartip == "normal",
"Não",
"Sim"
)
),
# Parto induzido
parto_induzido = as.factor(dplyr::if_else(
ainduz %in% c("rompeu bolsa", "soro", "ambos"),
"Sim",
"Não"
)),
# Ida a UTI
uti_neo = as.factor(dplyr::if_else(
aprobrn %in% c("bercario", "aloj.conjunto"),
"Não",
dplyr::if_else(aprobrn == "uti", "Sim",
NA_character_
)
)),
# Nascimento prematuro
prematuro = as.factor(
dplyr::if_else(aerrado != "prematuro" | is.na(aerrado),
"Não",
"Sim"
)
),
# Traumatismo no parto
traumatismo = as.factor(
dplyr::if_else(
aprobrn1 == "traumatismo" | aprobrn2 == "traumatismo" |
aprobrn3 == "traumatismo",
"Sim",
"Não",
missing = "Não"
)
),
# Estresse respiratório no parto
disf_resp = as.factor(
dplyr::if_else(
aprobrn1 == "stress resp" | aprobrn2 == "stress resp" |
aprobrn3 == "stress resp",
"Sim",
"Não",
missing = "Não"
)
),
# Malformação
malform = as.factor(
dplyr::if_else(
aprobrn1 == "malformacao" | aprobrn2 == "malformacao" |
aprobrn3 == "malformacao",
"Sim",
"Não",
missing = "Não"
)
),
# Sofrimento fetal
sofrfetal = as.factor(
dplyr::if_else(
aprobrn1 == "sofrim fetal" | aprobrn2 == "sofrim fetal" |
aprobrn3 == "sofrim fetal",
"Sim",
"Não",
missing = "Não"
)
),
# Hipertensão materna
hipert_materna = relevel(
as.factor(
dplyr::case_when(
as.character(ahipert) == "nao sabe" ~ NA_character_,
TRUE ~ as.character(ahipert)
)
), ref = "nao"),
# Diabetes materna
dm_materna = as.factor(dplyr::if_else(
adiabet %in% c("tratado", "nao tratado"),
"Sim",
"Não"
)),
# Infecção gestacional
infec_gest = as.factor(
dplyr::if_else(
ainfecur %in% c("tratado", "nao tratado") |
aoutinf %in% c("tratado", "nao tratado"),
"Sim",
"Não"
)
),
# Anemia gestacional
anemia_gest = as.factor(dplyr::if_else(
aanemia %in% c("tratado", "nao tratado"),
"Sim",
"Não"
)),
# Hemorragia no parto
hemorr_parto = as.factor(
dplyr::if_else(
amotcesa == "hemorragia materna" | apartind == "sangramento",
"Sim",
"Não"
)
),
# Tabagismo gestacional
tab_gest = as.factor(
dplyr::if_else(afumou == "sim" | acompfum == "sim",
"Sim",
"Não"
)
),
# Etilismo pesado na gestação
etil_pesado_gest = as.factor(
dplyr::if_else(aalcool == "sim",
"Sim",
"Não"
)
),
# Ruptura familiar
rup_famil = as.factor(
dplyr::if_else(avivmar == "sim",
"Não",
"Sim"
)
),
# Baixo peso ao nascer
baixo_peso = as.factor(
dplyr::if_else(apesorn < 2500,
"Sim",
"Não"
)
),
# Baixo comprimento ao nascer
baixo_comp = as.factor(
dplyr::if_else(acompr < 47,
"Sim",
"Não"
)
),
# Perímetro cefálico
per_cef = apcrn,
# Escolaridade paterna (em anos)
escol_paterna = aescpai,
# Escolaridade materna (em anos)
escol_materna = aescmae,
# Paridade (número de filhos)
paridade = relevel(as.factor(dplyr::if_else(
aparidad %in% c("0", "1", "2", "3"),
"Menor que 4",
"Maior ou igual a 4")
), ref = "Menor que 4"),
# Apoio familiar
apoio_familiar = as.factor(
dplyr::if_else(
aapoio == "sim",
"Sim",
"Não"
)
),
# Idade da mãe
idade_mae_num = aidadmae,
# Pretende amamentar
pretende_amamentar = as.factor(
dplyr::if_else(
apretama == "sim",
"Sim",
"Não"
)
),
# Apgar no primeiro minuto
apgar_1 = aapgar1,
# Apgar no minuto 5
apgar_5 = aapgar5,
# Renda familiar em salários mínimos (SM)
renda_familiar = arenfam
)Nesta etapa abaixo, realizou-se uma checagem em relação aos valores ausentes em cada uma das variáveis. Posteriormente, elaborou-se um pequeno fluxo para realizar a imputação das variáveis por meio de mediana (variáveis numéricas) e moda (variáveis categóricas).
# Checar valores ausentes após criação das variáveis propostas
da_proc |>
purrr::map_if(is.factor, \(x) table(x, useNA = "always"), .else = summary)## $tb_dic
## x
## Não Sim <NA>
## 3526 268 0
##
## $cesarea
## x
## Não Sim <NA>
## 2613 1181 0
##
## $parto_induzido
## x
## Não Sim <NA>
## 2599 1195 0
##
## $uti_neo
## x
## Não Sim <NA>
## 3705 88 1
##
## $prematuro
## x
## Não Sim <NA>
## 3791 3 0
##
## $traumatismo
## x
## Não Sim <NA>
## 3790 4 0
##
## $disf_resp
## x
## Não Sim <NA>
## 3717 77 0
##
## $malform
## x
## Não Sim <NA>
## 3791 3 0
##
## $sofrfetal
## x
## Não Sim <NA>
## 3779 15 0
##
## $hipert_materna
## x
## nao nao tratado tratado <NA>
## 3152 143 433 66
##
## $dm_materna
## x
## Não Sim <NA>
## 3692 102 0
##
## $infec_gest
## x
## Não Sim <NA>
## 2240 1554 0
##
## $anemia_gest
## x
## Não Sim <NA>
## 2077 1717 0
##
## $hemorr_parto
## x
## Não Sim <NA>
## 1122 37 2635
##
## $tab_gest
## x
## Não Sim <NA>
## 1613 2178 3
##
## $etil_pesado_gest
## x
## Não Sim <NA>
## 3756 38 0
##
## $rup_famil
## x
## Não Sim <NA>
## 3338 456 0
##
## $baixo_peso
## x
## Não Sim <NA>
## 3452 337 5
##
## $baixo_comp
## x
## Não Sim <NA>
## 3208 553 33
##
## $per_cef
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 24.00 34.00 35.00 34.66 36.00 40.50 29
##
## $escol_paterna
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.000 5.000 6.000 6.906 9.000 19.000 260
##
## $escol_materna
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.000 4.000 6.000 6.849 9.000 23.000 6
##
## $paridade
## x
## Menor que 4 Maior ou igual a 4 <NA>
## 3378 416 0
##
## $apoio_familiar
## x
## Não Sim <NA>
## 379 3415 0
##
## $idade_mae_num
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 13.00 21.00 26.00 26.05 31.00 47.00
##
## $pretende_amamentar
## x
## Não Sim <NA>
## 21 3756 17
##
## $apgar_1
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.000 8.000 9.000 8.416 9.000 10.000 1047
##
## $apgar_5
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.00 9.00 10.00 9.56 10.00 10.00 1044
##
## $renda_familiar
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 0.000 1.500 2.700 4.378 4.800 88.200 69# Agrupar variáveis de complicações perinatais
# O argumento .keep da função dplyr::mutate permite
# que somente as variáveis não utilizadas nas operações
# sejam mantidas na base de dados resultante
da_proc <- da_proc |>
dplyr::mutate(
complicacoes = as.factor(
dplyr::if_else(
prematuro == "Sim" | traumatismo == "Sim" |
disf_resp == "Sim" | malform == "Sim" |
sofrfetal == "Sim",
"Sim", "Não"
)
),
.keep = "unused"
)
# Criar base com variáveis imputadas pela moda e mediana
da_imp <- da_proc |>
recipes::recipe(tb_dic ~ .) |>
recipes::step_filter_missing(recipes::all_predictors(), threshold = 0.1) |>
recipes::step_impute_mode(recipes::all_nominal_predictors()) |>
recipes::step_impute_median(recipes::all_numeric_predictors()) |>
recipes::step_nzv(recipes::all_predictors()) |>
recipes::prep() |>
recipes::bake(new_data = NULL)
# Checar que a imputação funcionou
da_imp |>
purrr::map_if(is.factor, \(x) table(x, useNA = "always"), .else = summary)## $cesarea
## x
## Não Sim <NA>
## 2613 1181 0
##
## $parto_induzido
## x
## Não Sim <NA>
## 2599 1195 0
##
## $hipert_materna
## x
## nao nao tratado tratado <NA>
## 3218 143 433 0
##
## $infec_gest
## x
## Não Sim <NA>
## 2240 1554 0
##
## $anemia_gest
## x
## Não Sim <NA>
## 2077 1717 0
##
## $tab_gest
## x
## Não Sim <NA>
## 1613 2181 0
##
## $rup_famil
## x
## Não Sim <NA>
## 3338 456 0
##
## $baixo_peso
## x
## Não Sim <NA>
## 3457 337 0
##
## $baixo_comp
## x
## Não Sim <NA>
## 3241 553 0
##
## $per_cef
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 24.00 34.00 35.00 34.66 36.00 40.50
##
## $escol_paterna
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 5.000 6.000 6.844 8.000 19.000
##
## $escol_materna
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 4.000 6.000 6.847 9.000 23.000
##
## $paridade
## x
## Menor que 4 Maior ou igual a 4 <NA>
## 3378 416 0
##
## $apoio_familiar
## x
## Não Sim <NA>
## 379 3415 0
##
## $idade_mae_num
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 13.00 21.00 26.00 26.05 31.00 47.00
##
## $renda_familiar
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 1.500 2.700 4.348 4.800 88.200
##
## $tb_dic
## x
## Não Sim <NA>
## 3526 268 0# A função abaixo foi criada para verificar a frequência absoluta de
# uma variável independente qualquer estratificada pelo desfecho
ver_freq <- function(var) {
da_imp |>
dplyr::group_by(tb_dic) |>
dplyr::count({{ var }})
}
# Checar frequência agrupada pelo desfecho
da_imp |>
purrr::map_if(is.factor, ver_freq, .else = summary)## $cesarea
## # A tibble: 4 × 3
## # Groups: tb_dic [2]
## tb_dic `<fct>` n
## <fct> <fct> <int>
## 1 Não Não 2415
## 2 Não Sim 1111
## 3 Sim Não 198
## 4 Sim Sim 70
##
## $parto_induzido
## # A tibble: 4 × 3
## # Groups: tb_dic [2]
## tb_dic `<fct>` n
## <fct> <fct> <int>
## 1 Não Não 2411
## 2 Não Sim 1115
## 3 Sim Não 188
## 4 Sim Sim 80
##
## $hipert_materna
## # A tibble: 6 × 3
## # Groups: tb_dic [2]
## tb_dic `<fct>` n
## <fct> <fct> <int>
## 1 Não nao 2982
## 2 Não nao tratado 135
## 3 Não tratado 409
## 4 Sim nao 236
## 5 Sim nao tratado 8
## 6 Sim tratado 24
##
## $infec_gest
## # A tibble: 4 × 3
## # Groups: tb_dic [2]
## tb_dic `<fct>` n
## <fct> <fct> <int>
## 1 Não Não 2083
## 2 Não Sim 1443
## 3 Sim Não 157
## 4 Sim Sim 111
##
## $anemia_gest
## # A tibble: 4 × 3
## # Groups: tb_dic [2]
## tb_dic `<fct>` n
## <fct> <fct> <int>
## 1 Não Não 1939
## 2 Não Sim 1587
## 3 Sim Não 138
## 4 Sim Sim 130
##
## $tab_gest
## # A tibble: 4 × 3
## # Groups: tb_dic [2]
## tb_dic `<fct>` n
## <fct> <fct> <int>
## 1 Não Não 1531
## 2 Não Sim 1995
## 3 Sim Não 82
## 4 Sim Sim 186
##
## $rup_famil
## # A tibble: 4 × 3
## # Groups: tb_dic [2]
## tb_dic `<fct>` n
## <fct> <fct> <int>
## 1 Não Não 3109
## 2 Não Sim 417
## 3 Sim Não 229
## 4 Sim Sim 39
##
## $baixo_peso
## # A tibble: 4 × 3
## # Groups: tb_dic [2]
## tb_dic `<fct>` n
## <fct> <fct> <int>
## 1 Não Não 3220
## 2 Não Sim 306
## 3 Sim Não 237
## 4 Sim Sim 31
##
## $baixo_comp
## # A tibble: 4 × 3
## # Groups: tb_dic [2]
## tb_dic `<fct>` n
## <fct> <fct> <int>
## 1 Não Não 3022
## 2 Não Sim 504
## 3 Sim Não 219
## 4 Sim Sim 49
##
## $per_cef
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 24.00 34.00 35.00 34.66 36.00 40.50
##
## $escol_paterna
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 5.000 6.000 6.844 8.000 19.000
##
## $escol_materna
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 4.000 6.000 6.847 9.000 23.000
##
## $paridade
## # A tibble: 4 × 3
## # Groups: tb_dic [2]
## tb_dic `<fct>` n
## <fct> <fct> <int>
## 1 Não Menor que 4 3156
## 2 Não Maior ou igual a 4 370
## 3 Sim Menor que 4 222
## 4 Sim Maior ou igual a 4 46
##
## $apoio_familiar
## # A tibble: 4 × 3
## # Groups: tb_dic [2]
## tb_dic `<fct>` n
## <fct> <fct> <int>
## 1 Não Não 350
## 2 Não Sim 3176
## 3 Sim Não 29
## 4 Sim Sim 239
##
## $idade_mae_num
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 13.00 21.00 26.00 26.05 31.00 47.00
##
## $renda_familiar
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 1.500 2.700 4.348 4.800 88.200
##
## $tb_dic
## # A tibble: 2 × 3
## # Groups: tb_dic [2]
## tb_dic `<fct>` n
## <fct> <fct> <int>
## 1 Não Não 3526
## 2 Sim Sim 268Quais variáveis foram excluídas e quando?
Na etapa de remoçao de variáveis com mais de 10% de missing, exclui-se a variável de hemorragia no parto, apgar no primeiro minuto e apgar no quinto minuto.
Na etapa de retirada de variáveis com pouca ou nenhuma variabilidade, foram excluídas as seguintes variáveis: UTI neonatal, diabetes materna, etilismo pesado na gestação, se a mãe pretende amamentar e complicações no parto.
da_prep <- da_proc |>
recipes::recipe(tb_dic ~ .) |>
recipes::step_filter_missing(recipes::all_predictors(), threshold = 0.1) |>
recipes::step_impute_mode(recipes::all_nominal_predictors()) |>
recipes::step_impute_median(recipes::all_numeric_predictors()) |>
recipes::step_nzv(recipes::all_predictors()) |>
recipes::prep()
da_prep$steps |> View()Análise bivariada com variáveis categóricas
# Carregar o pacote magrittr para utilizar o placeholder "." na função
# do teste qui-quadrado abaixo
library(magrittr, include.only = "%>%")
cat_biv <- da_imp |>
purrr::keep(is.factor) |>
tidyr::pivot_longer(names_to = "variable", values_to = "value", -tb_dic) |>
dplyr::group_by(variable) %>%
dplyr::do(chisq.test(.$tb_dic, .$value, simulate.p.value = TRUE) |>
broom::tidy()) |>
dplyr::select(-c(parameter, method)) |>
dplyr::ungroup()
knitr::kable(cat_biv,
digits = 3,
col.names = c("Variável",
"Estatística",
"p-valor"))| Variável | Estatística | p-valor |
|---|---|---|
| anemia_gest | 1.231 | 0.279 |
| apoio_familiar | 0.222 | 0.664 |
| baixo_comp | 3.184 | 0.094 |
| baixo_peso | 2.568 | 0.128 |
| cesarea | 3.374 | 0.074 |
| hipert_materna | 2.354 | 0.312 |
| infec_gest | 0.025 | 0.910 |
| paridade | 11.353 | 0.002 |
| parto_induzido | 0.362 | 0.600 |
| rup_famil | 1.750 | 0.203 |
| tab_gest | 16.758 | 0.000 |
Análise bivariada com variáveis numéricas
# Realiza análise bivariada com as variáveis numéricas através de teste t
num_biv <- da_imp |>
dplyr::select(tb_dic, where(is.numeric)) |>
tidyr::pivot_longer(names_to = "variable", values_to = "value", -tb_dic) |>
dplyr::group_by(variable) %>%
dplyr::do(t.test(.$value ~ .$tb_dic) |>
broom::tidy()) |>
dplyr::ungroup() |>
dplyr::select(-method, -alternative)
knitr::kable(num_biv,
digits = 3)| variable | estimate | estimate1 | estimate2 | statistic | p.value | parameter | conf.low | conf.high |
|---|---|---|---|---|---|---|---|---|
| escol_materna | 1.105 | 6.925 | 5.821 | 5.862 | 0.000 | 331.829 | 0.734 | 1.475 |
| escol_paterna | 0.912 | 6.908 | 5.996 | 4.612 | 0.000 | 318.672 | 0.523 | 1.301 |
| idade_mae_num | 0.929 | 26.119 | 25.190 | 2.322 | 0.021 | 310.228 | 0.142 | 1.717 |
| per_cef | 0.279 | 34.678 | 34.400 | 2.864 | 0.004 | 311.075 | 0.087 | 0.470 |
| renda_familiar | 1.356 | 4.443 | 3.087 | 6.518 | 0.000 | 462.018 | 0.947 | 1.765 |
Análise multivariada
A imputação foi realizada nos passos anteriores para a análise bivariada, logo, o objeto da base de dados imputada (pré-processada) será usada para o ajuste do modelo de regressão logística binomial.
Um modelo contendo somente as variáveis com valor p menor que 0,2 na análise bivariada foi construído.
Os valores de odds ratio foram estimados a partir da equação \(e^{\beta}\).
Modelo de regressão logística binomial
Neste modelo, foram incluídas somente as variáveis independentes que apresentaram um valor de p menor que 0,2 na análise bivariada (bruta).
# Pegar nomes das variáveis que apresentaram p-value menor que 0,2 na análise
# bruta
vars_multivar <- cat_biv |>
dplyr::bind_rows(num_biv |> dplyr::select(variable, statistic, p.value)) |>
dplyr::ungroup() |>
dplyr::filter(p.value < 0.2) |>
dplyr::pull(variable)
# Adicionar desfecho na fórmula juntamente aos preditores que forem incluídos
# como argumento da função
add_outcome <- function(predictors) {
reg_mod <- paste0("tb_dic", " ~ ", predictors)
return(reg_mod)
}
# Juntar os preditores separados por + (para sintaxe de fórmula) e ao final,
# adicionar o desfecho
mod_filtrado <- vars_multivar |>
paste(collapse = " + ") |>
add_outcome()
# Especificar modelo a ser ajustado
mod <- parsnip::logistic_reg() |>
parsnip::set_mode("classification") |>
parsnip::set_engine("glm")
# Ajustar a partir da fórmula construída previamente
mod_filtrado_fit <- mod |>
parsnip::fit(as.formula(mod_filtrado), data = da_imp)
# Mostrar resultados tidy
mod_filtrado_fit |>
broom::tidy() |>
knitr::kable(
col.names = c("Variável",
"Beta",
"Erro Padrão",
"Estatística",
"p-valor"),
digits = 3,
caption = "Resumo do modelo final com variáveis que apresentaram p-valor menor que 0,2 na análise bruta."
)| Variável | Beta | Erro Padrão | Estatística | p-valor |
|---|---|---|---|---|
| (Intercept) | 0.590 | 1.693 | 0.348 | 0.728 |
| baixo_compSim | 0.087 | 0.207 | 0.421 | 0.674 |
| baixo_pesoSim | 0.014 | 0.258 | 0.054 | 0.957 |
| cesareaSim | -0.003 | 0.149 | -0.021 | 0.983 |
| paridadeMaior ou igual a 4 | 0.630 | 0.205 | 3.079 | 0.002 |
| tab_gestSim | 0.409 | 0.142 | 2.882 | 0.004 |
| escol_materna | -0.033 | 0.025 | -1.312 | 0.190 |
| escol_paterna | -0.023 | 0.025 | -0.906 | 0.365 |
| idade_mae_num | -0.033 | 0.012 | -2.749 | 0.006 |
| per_cef | -0.064 | 0.049 | -1.318 | 0.188 |
| renda_familiar | -0.033 | 0.022 | -1.485 | 0.138 |
Plot com OR do modelo com p < 0,2 na análise bivariada
Como pode ser observado na tabela acima, traumatismo no parto se mostrou como um fator de risco para o desenvolvimento de TB aos 18 ou aos 22 anos, porém não está presente na figura abaixo por ter apresentado um odds ratio que ficaria muito fora dos limites do gráfico.
Além disso, a variável de traumatismo no parto, como pode ser observado na tabela abaixo, apresentou um intervalo de confiança superior na razão de chances de 74,8.
# Seed para reprodutibilidade
set.seed(1)
# Criação dos intervalos de confiança para os parâmetros do modelo ajustado
intervalos <- exp(confint(mod_filtrado_fit$fit)) |>
tibble::as_tibble(rownames = "term") |>
janitor::clean_names()## Waiting for profiling to be done...# Mostrar odds ratio com os respectivos intervalos de confiança
or_table <- mod_filtrado_fit |>
broom::tidy() |>
dplyr::left_join(intervalos, by = "term") |>
dplyr::transmute(
variavel = term,
or = exp(estimate),
lower_int = x2_5_percent,
upper_int = x97_5_percent,
pvalue = p.value
)
or_table |>
knitr::kable(
col.names = c("Variável",
"Odds Ratio",
"Intervalo Inferior",
"Intervalo Superior",
"p-valor"),
caption = "Razão de chances para cada variável incluída no modelo final.",
digits = 3
)| Variável | Odds Ratio | Intervalo Inferior | Intervalo Superior | p-valor |
|---|---|---|---|---|
| (Intercept) | 1.804 | 0.065 | 49.321 | 0.728 |
| baixo_compSim | 1.091 | 0.719 | 1.623 | 0.674 |
| baixo_pesoSim | 1.014 | 0.605 | 1.667 | 0.957 |
| cesareaSim | 0.997 | 0.740 | 1.330 | 0.983 |
| paridadeMaior ou igual a 4 | 1.877 | 1.249 | 2.789 | 0.002 |
| tab_gestSim | 1.505 | 1.143 | 1.995 | 0.004 |
| escol_materna | 0.967 | 0.921 | 1.016 | 0.190 |
| escol_paterna | 0.977 | 0.929 | 1.027 | 0.365 |
| idade_mae_num | 0.968 | 0.945 | 0.990 | 0.006 |
| per_cef | 0.938 | 0.853 | 1.032 | 0.188 |
| renda_familiar | 0.967 | 0.922 | 1.006 | 0.138 |
# Criar plot com odds ratio listados acima
or_table |>
dplyr::filter(variavel != "(Intercept)") |>
ggplot2::ggplot() +
ggplot2::aes(x = or, y = variavel) +
ggplot2::geom_point(size = 5, color = "royalblue") +
ggplot2::geom_linerange(
ggplot2::aes(xmin = lower_int, xmax = upper_int),
color = "royalblue",
size = 0.8) +
ggplot2::geom_vline(xintercept = 1) +
ggplot2::scale_x_continuous(limits = c(0, 3)) +
ggplot2::scale_y_discrete(labels = c("Baixo comprimento (sim)",
"Baixo peso ao nascer (sim)",
"Cesária (sim)",
"Escolaridade materna (em anos)",
"Escolaridade paterna (em anos)",
"Idade da mãe",
"Paridade (maior ou igual a 4)",
"Perímetro cefálico",
"Renda familiar (em SM)",
"Tabagismo gestacional (ativo ou passivo)")) +
ggplot2::labs(x = expression(paste("Razão de chances (", italic("odds ratio"), ")")),
y = "Variável") +
ggplot2::theme_minimal(base_size = 20) +
ggplot2::theme(
axis.text.x = ggplot2::element_text(size = 20),
axis.text.y = ggplot2::element_text(size = 20)
)
# Tabela de odds ratio processada
processed_or_table <- or_table |>
dplyr::filter(variavel %in% c("paridadeMaior ou igual a 4", "tab_gestSim",
"escol_materna", "escol_paterna",
"idade_mae_num", "per_cef",
"renda_familiar")) |>
dplyr::mutate(
dplyr::across(dplyr::ends_with("int"), \(x) as.character(format(x, digits = 2))),
intervals = stringr::str_glue("({lower_int}-{upper_int})"),
variavel = dplyr::case_when(
variavel == "paridadeMaior ou igual a 4" ~ "Parity",
variavel == "tab_gestSim" ~ "Tobbaco in pregnancy",
variavel == "escol_materna" ~ "Maternal years of education",
variavel == "escol_paterna" ~ "Paternal years of education",
variavel == "idade_mae_num" ~ "Maternal age",
variavel == "per_cef" ~ "Head circumference",
variavel == "renda_familiar" ~ "Family income"
),
pvalue = format(pvalue, digits = 3)
) |>
dplyr::select(-dplyr::ends_with("int")) |>
dplyr::select(variable = variavel, adjusted_or = or, intervals, pvalue)
# Exportar tabela para Word
processed_or_table |>
flextable::flextable() |>
flextable::save_as_docx(path = "output/tabela_or.docx")# Criar plot com odds ratio, porém apenas variáveis significativas da bivariada
plot_apenas_sig <- or_table |>
dplyr::filter(variavel %in% c("paridadeMaior ou igual a 4", "tab_gestSim",
"escol_materna", "escol_paterna",
"idade_mae_num", "per_cef",
"renda_familiar")) |>
ggplot2::ggplot() +
ggplot2::aes(x = or, y = variavel) +
ggplot2::geom_point(size = 5, color = "royalblue") +
ggplot2::geom_linerange(
ggplot2::aes(xmin = lower_int, xmax = upper_int),
color = "royalblue",
size = 0.8) +
ggplot2::geom_vline(xintercept = 1) +
ggplot2::scale_x_continuous(limits = c(0, 3)) +
ggplot2::scale_y_discrete(labels = c("Maternal education level",
"Paternal education level",
"Maternal age",
"Multiparity",
"Head circumference",
"Family income",
"Tobacco in pregnancy")) +
ggplot2::labs(x = "Adjusted OR",
y = "Exposure") +
ggplot2::theme_minimal(base_size = 20) +
ggplot2::theme(
axis.text.x = ggplot2::element_text(size = 20),
axis.text.y = ggplot2::element_text(size = 20)
)
ggplot2::ggsave(plot = plot_apenas_sig,
filename = "output/or_plot.png",
dpi = 300)
ggplot2::ggsave(plot = plot_apenas_sig,
filename = "output/or_plot.pdf",
dpi = 300)Tabela descritiva com dados perinatais
pvalue <- function(x, ...) {
# Construir vetores com y (desfecho), e grupos (estratificação) chamado g
y <- unlist(x)
g <- factor(rep(1:length(x), times=sapply(x, length)))
if (is.numeric(y)) {
# Para variáveis numéricas, performar um teste t de duas amostras
p <- t.test(y ~ g)$p.value
} else {
# For categorical variables, perform a chi-squared test of independence
# Para variáveis categóricas, performar um teste qui-quadrado de independência
p <- chisq.test(table(y, g))$p.value
}
# Formatar o p-valor usando sintaxe em HTML para o símbolo de "menor que"
# A string vazia coloca o output do p-valor na linha abaixo do rótulo da variável
c("", sub("<", "<", format.pval(p, digits=3, eps=0.001)))
}
# Gerar objeto da tabela com dados perinatais
# O underscore (_) indica o placeholder do pipe nativo do R
tabela_peri <- da_proc |>
table1::table1(~ cesarea + parto_induzido + uti_neo + hipert_materna +
dm_materna + infec_gest + anemia_gest + hemorr_parto +
tab_gest + etil_pesado_gest + rup_famil + baixo_peso +
baixo_comp + per_cef + escol_paterna + escol_materna +
paridade + apoio_familiar + idade_mae_num +
pretende_amamentar + apgar_1 + apgar_5 + renda_familiar +
complicacoes | tb_dic, data = _,
extra.col = list("p-value" = pvalue),
overall = FALSE)
# Transformar para formato kable para melhor visualização
tabela_peri |>
table1::t1kable()| Não | Sim | p-value | |
|---|---|---|---|
| (N=3526) | (N=268) | ||
| cesarea | |||
| Não | 2415 (68.5%) | 198 (73.9%) | 0.077 |
| Sim | 1111 (31.5%) | 70 (26.1%) | |
| parto_induzido | |||
| Não | 2411 (68.4%) | 188 (70.1%) | 0.594 |
| Sim | 1115 (31.6%) | 80 (29.9%) | |
| uti_neo | |||
| Não | 3446 (97.7%) | 259 (96.6%) | 0.337 |
| Sim | 79 (2.2%) | 9 (3.4%) | |
| Missing | 1 (0.0%) | 0 (0%) | |
| hipert_materna | |||
| nao | 2928 (83.0%) | 224 (83.6%) | 0.4 |
| nao tratado | 135 (3.8%) | 8 (3.0%) | |
| tratado | 409 (11.6%) | 24 (9.0%) | |
| Missing | 54 (1.5%) | 12 (4.5%) | |
| dm_materna | |||
| Não | 3432 (97.3%) | 260 (97.0%) | 0.908 |
| Sim | 94 (2.7%) | 8 (3.0%) | |
| infec_gest | |||
| Não | 2083 (59.1%) | 157 (58.6%) | 0.925 |
| Sim | 1443 (40.9%) | 111 (41.4%) | |
| anemia_gest | |||
| Não | 1939 (55.0%) | 138 (51.5%) | 0.296 |
| Sim | 1587 (45.0%) | 130 (48.5%) | |
| hemorr_parto | |||
| Não | 1057 (30.0%) | 65 (24.3%) | 0.36 |
| Sim | 33 (0.9%) | 4 (1.5%) | |
| Missing | 2436 (69.1%) | 199 (74.3%) | |
| tab_gest | |||
| Não | 1531 (43.4%) | 82 (30.6%) | <0.001 |
| Sim | 1992 (56.5%) | 186 (69.4%) | |
| Missing | 3 (0.1%) | 0 (0%) | |
| etil_pesado_gest | |||
| Não | 3490 (99.0%) | 266 (99.3%) | 0.907 |
| Sim | 36 (1.0%) | 2 (0.7%) | |
| rup_famil | |||
| Não | 3109 (88.2%) | 229 (85.4%) | 0.22 |
| Sim | 417 (11.8%) | 39 (14.6%) | |
| baixo_peso | |||
| Não | 3215 (91.2%) | 237 (88.4%) | 0.138 |
| Sim | 306 (8.7%) | 31 (11.6%) | |
| Missing | 5 (0.1%) | 0 (0%) | |
| baixo_comp | |||
| Não | 2992 (84.9%) | 216 (80.6%) | 0.0862 |
| Sim | 504 (14.3%) | 49 (18.3%) | |
| Missing | 30 (0.9%) | 3 (1.1%) | |
| perimetro cefalico | |||
| Mean (SD) | 34.7 (1.58) | 34.4 (1.53) | 0.00488 |
| Median [Min, Max] | 35.0 [24.0, 40.5] | 34.5 [29.0, 40.0] | |
| Missing | 29 (0.8%) | 0 (0%) | |
| escolaridade paterna em anos | |||
| Mean (SD) | 6.98 (3.54) | 6.00 (3.21) | <0.001 |
| Median [Min, Max] | 6.00 [0, 19.0] | 5.00 [0, 16.0] | |
| Missing | 242 (6.9%) | 18 (6.7%) | |
| escolaridade materna em anos | |||
| Mean (SD) | 6.93 (3.60) | 5.82 (2.92) | <0.001 |
| Median [Min, Max] | 6.00 [0, 23.0] | 5.00 [0, 16.0] | |
| Missing | 6 (0.2%) | 0 (0%) | |
| paridade | |||
| Menor que 4 | 3156 (89.5%) | 222 (82.8%) | 0.00108 |
| Maior ou igual a 4 | 370 (10.5%) | 46 (17.2%) | |
| apoio_familiar | |||
| Não | 350 (9.9%) | 29 (10.8%) | 0.715 |
| Sim | 3176 (90.1%) | 239 (89.2%) | |
| idade materna (anos) | |||
| Mean (SD) | 26.1 (6.40) | 25.2 (6.31) | 0.0209 |
| Median [Min, Max] | 26.0 [13.0, 47.0] | 25.0 [14.0, 40.0] | |
| pretende_amamentar | |||
| Não | 21 (0.6%) | 0 (0%) | 0.399 |
| Sim | 3488 (98.9%) | 268 (100%) | |
| Missing | 17 (0.5%) | 0 (0%) | |
| apgar no minuto 1 | |||
| Mean (SD) | 8.41 (1.40) | 8.45 (1.24) | 0.734 |
| Median [Min, Max] | 9.00 [0, 10.0] | 9.00 [1.00, 10.0] | |
| Missing | 965 (27.4%) | 82 (30.6%) | |
| apgar no minuto 5 | |||
| Mean (SD) | 9.56 (0.847) | 9.60 (0.684) | 0.433 |
| Median [Min, Max] | 10.0 [0, 10.0] | 10.0 [7.00, 10.0] | |
| Missing | 963 (27.3%) | 81 (30.2%) | |
| renda familiar | |||
| Mean (SD) | 4.47 (6.14) | 3.10 (3.00) | <0.001 |
| Median [Min, Max] | 3.00 [0, 88.2] | 2.00 [0.100, 20.0] | |
| Missing | 62 (1.8%) | 7 (2.6%) | |
| complicacoes | |||
| Não | 3438 (97.5%) | 258 (96.3%) | 0.303 |
| Sim | 88 (2.5%) | 10 (3.7%) | |
# Exportar tabela para Word
tabela_peri |>
table1::t1flex() |>
flextable::save_as_docx(path = "output/tabela_peri.docx")Tabela descritiva com dados do follow-up
# ld023a = estado civil
#lescoljovemano = anos de estudo
# Gerar tabela descritiva com dados do follow-up
tabela_follow <- dados_com_desfecho |>
dplyr::rename(
cocaina_lifetime = ldc007, # Necessita recode
maconha_lifetime = ldc006, # Necessita recode
status_socio = labep3,
trabalha_atualmente = ld011,
sexo = sexonovo,
estado_civil = ld023a,
anos_de_estudo = lescoljovemano) |>
dplyr::mutate(
dplyr::across(dplyr::ends_with("lifetime"),
\(x) as.factor(dplyr::if_else(
as.character(x) == "Nunca usei",
"Não", "Sim"
)))
) |>
table1::table1(~ sexo + status_socio + estado_civil + anos_de_estudo + trabalha_atualmente + maconha_lifetime + cocaina_lifetime | outcome,
data = _, # Placeholder do pipe nativo
extra.col = list("p-value" = pvalue),
overall = FALSE)
# Transformar tabela em formato kable para melhor visualização no Rmd compilado
tabela_follow |>
table1::t1kable()| Não | Sim | p-value | |
|---|---|---|---|
| (N=3526) | (N=268) | ||
| sexo do recem-nascido - arrumada em agosto 2015 | |||
| masculino | 1690 (47.9%) | 109 (40.7%) | 0.0257 |
| feminino | 1836 (52.1%) | 159 (59.3%) | |
| classe economica abep em 3 categorias | |||
| A/B | 1386 (39.3%) | 51 (19.0%) | <0.001 |
| C | 1761 (49.9%) | 148 (55.2%) | |
| D/E | 330 (9.4%) | 45 (16.8%) | |
| Missing | 49 (1.4%) | 24 (9.0%) | |
| Qual e o teu estado civil? | |||
| Casado(a)/Uniao estavel | 534 (15.1%) | 45 (16.8%) | 0.664 |
| Divorciado(a)/Separado(a) | 18 (0.5%) | 1 (0.4%) | |
| Solteiro(a) | 2946 (83.6%) | 202 (75.4%) | |
| Viuvo(a) | 1 (0.0%) | 0 (0%) | |
| Missing | 27 (0.8%) | 20 (7.5%) | |
| Variavel continua - anos de estudo do jovem | |||
| Mean (SD) | 9.86 (2.43) | 8.67 (2.50) | <0.001 |
| Median [Min, Max] | 11.0 [0, 12.0] | 8.50 [4.00, 12.0] | |
| Missing | 30 (0.9%) | 20 (7.5%) | |
| Tu estas trabalhando atualmente? | |||
| Nao | 1045 (29.6%) | 92 (34.3%) | 0.0571 |
| Sim | 2220 (63.0%) | 149 (55.6%) | |
| Missing | 261 (7.4%) | 27 (10.1%) | |
| maconha_lifetime | |||
| Não | 2103 (59.6%) | 123 (45.9%) | <0.001 |
| Sim | 1200 (34.0%) | 116 (43.3%) | |
| Missing | 223 (6.3%) | 29 (10.8%) | |
| cocaina_lifetime | |||
| Não | 2794 (79.2%) | 168 (62.7%) | <0.001 |
| Sim | 500 (14.2%) | 72 (26.9%) | |
| Missing | 232 (6.6%) | 28 (10.4%) | |
# Exportar tabela para Word
tabela_follow |>
table1::t1flex() |>
flextable::save_as_docx(path = "output/tabela_follow.docx")Ocitocina e TB
# ainduz = parto foi induzido (rompeu bolsa, soro, ambos, nao)
dados_oci <- dados_com_desfecho |>
dplyr::mutate(ocitocina = dplyr::if_else(
ainduz == "soro", "Sim", "Não"
))
janitor::tabyl(
dat = dados_oci,
var1 = ocitocina,
var2 = outcome,
show_na = TRUE
)## ocitocina Não Sim
## Não 3182 241
## Sim 344 27chi_oci <- chisq.test(x = dados_oci$ocitocina,
y = dados_oci$outcome,
correct = TRUE)O p-valor do teste qui-quadrado entre ocitocina e o desfecho de TB no início da vida adulta foi de 0.9500999
Possível mediação da renda familiar no efeito da paridade
Abaixo, cria-se um modelo de modelagem de equações estruturais para verificar a possível mediação da renda familiar no efeito da paridade (número de filhos) no desfecho de desenvolvimento de transtorno bipolar na idade adulta.
set.seed(1)
da_med <- da_imp |>
dplyr::select(tb_dic, paridade, renda_familiar) |>
dplyr::mutate(
paridade = dplyr::if_else(
paridade == "Menor que 4", 0, 1
)
)
med_mod <- "# Mediação da renda para paridade como preditor de TB
renda_familiar ~ a*paridade
tb_dic ~ b*renda_familiar + c*paridade
# Efeito indireto
indireto := a * b
# Efeito direto
direto := c
# Efeito total
total := c + (a * b)"
med_fit <- lavaan::sem(
med_mod,
data = da_med,
ordered = "tb_dic"
)
mc_mediation_ci <- semTools::monteCarloCI(med_fit, nRep = 20000)
mc_mediation_ci |>
tibble::rownames_to_column("Efeito") |>
dplyr::rename("Beta" = est,
"IC 2.5%" = ci.lower,
"IC 97.5%" = ci.upper) |>
knitr::kable(caption = "Beta e intervalos de confiança de cada efeito do modelo de mediação baseado no método Monte Carlo com 20.000 amostras.",
digits = 3)| Efeito | Beta | IC 2.5% | IC 97.5% |
|---|---|---|---|
| indireto | 0.049 | 0.014 | 0.093 |
| direto | 0.236 | 0.060 | 0.413 |
| total | 0.285 | 0.111 | 0.459 |
broom::tidy(med_fit, conf.int = TRUE) |>
dplyr::select("Termo" = term,
"Rótulo" = label,
"Beta" = estimate,
"Erro" = std.error,
"p-valor" = p.value,
"IC 2.5%" = conf.low,
"IC 97.5%" = conf.high,
"Beta_std" = std.all) |>
knitr::kable(caption = "Tabela com parâmetros do modelo de modelagem de equações estruturais e respectivos rótulos.", digits = 3, format = "html")| Termo | Rótulo | Beta | Erro | p-valor | IC 2.5% | IC 97.5% | Beta_std |
|---|---|---|---|---|---|---|---|
| renda_familiar ~ paridade | a | -1.430 | 0.471 | 0.002 | -2.352 | -0.507 | -0.075 |
| tb_dic ~ renda_familiar | b | -0.034 | 0.008 | 0.000 | -0.051 | -0.018 | -0.201 |
| tb_dic ~ paridade | c | 0.236 | 0.090 | 0.009 | 0.060 | 0.412 | 0.074 |
| tb_dic | t1 | 1.355 | 0.051 | 0.000 | 1.254 | 1.456 | 1.350 | |
| renda_familiar ~~ renda_familiar | 34.980 | 0.262 | 0.000 | 34.468 | 35.493 | 0.994 | |
| tb_dic ~~ tb_dic | 0.959 | 0.000 | NA | 0.959 | 0.959 | 0.952 | |
| paridade ~~ paridade | 0.098 | 0.000 | NA | 0.098 | 0.098 | 1.000 | |
| tb_dic ~*~ tb_dic | 1.000 | 0.000 | NA | 1.000 | 1.000 | 1.000 | |
| renda_familiar ~1 | 4.504 | 0.161 | 0.000 | 4.189 | 4.819 | 0.759 | |
| tb_dic ~1 | 0.000 | 0.000 | NA | 0.000 | 0.000 | 0.000 | |
| paridade ~1 | 0.110 | 0.000 | NA | 0.110 | 0.110 | 0.351 | |
| indireto := a*b | indireto | 0.049 | 0.020 | 0.014 | 0.010 | 0.088 | 0.015 |
| direto := c | direto | 0.236 | 0.090 | 0.009 | 0.060 | 0.412 | 0.074 |
| total := c+(a*b) | total | 0.285 | 0.088 | 0.001 | 0.112 | 0.458 | 0.089 |
resumo_mediacao <- broom::tidy(med_fit, conf.int = TRUE) |>
dplyr::select("Termo" = term,
"Rótulo" = label,
"Beta" = estimate,
"Erro" = std.error,
"p-valor" = p.value,
"IC 2.5%" = conf.low,
"IC 97.5%" = conf.high,
"Beta_std" = std.all)
resumo_mediacao |>
dplyr::filter(Rótulo %in% c("indireto", "direto", "total")) |>
dplyr::select(-Termo) |>
dplyr::rename(B = Beta,
"SE B" = Erro,
pvalue = `p-valor`,
beta = Beta_std,
ic_lower = `IC 2.5%`,
ic_upper = `IC 97.5%`
) |>
dplyr::mutate(
dplyr::across(c(dplyr::starts_with("ic"), pvalue, B, beta, `SE B`),
\(x) as.character(format(x, digits = 2))),
intervals = stringr::str_glue("({ic_lower}-{ic_upper})"),
) |>
dplyr::select(
Effect = Rótulo,
B,
intervals,
`SE B`,
beta,
pvalue
) |>
flextable::flextable() |>
flextable::save_as_docx(path = "output/tabela_mediacao.docx")