Projeto - Figuras DP
Luis Anunciacao, PhD
29 July, 2021
`
Note This is an R markdown document and refers to the data processing of the psychological test FIGURAS - MIG. Data and codes are availabe at https://osf.io/492et/.
Feel free to contact me at luisfca@puc-rio.br
Last update: 29 July, 2021 Thank you.
Packages
pacman::p_load(
tidyverse,
janitor,
DataExplorer,
summarytools,
caret,
compareGroups,
flextable,
psych,
mirt,
semPlot,
semTools)Dataset
get original datasets
library(readxl)
ds_modelos <- read_excel("C:/Users/luisf/Dropbox/Puc-Rio/Projeto - Ivan Figuras/Figuras versao 2020 - ANTIGO/Base de Dados coletados Figuras/FIGURAS 2020 base para novo satepsi com Luis e Anna 2020.xlsx")
ds_clinico <- read_excel("C:/Users/luisf/Dropbox/Puc-Rio/Projeto - Ivan Figuras/Figuras versao 2020 - ANTIGO/Base de Dados coletados Figuras/Figuras 28 BASE DE DADOS grupo clinico depressao e ansiedade.xls")backup_ds_modelos <- ds_modelos
backup_ds_clinicos <- ds_clinicoClean names
ds_modelos <- clean_names(ds_modelos)
ds_clinico <- clean_names(ds_clinico)Function to check inconsistencies
bind_rows(
ds_modelos %>% names %>% data.frame %>% mutate(base="modelos"), #first dataset
ds_clinico %>% names %>% data.frame %>% mutate(base="clinico") #second dataset
) %>% setNames(c("var","base")) %>% group_by(var) %>% #agrupar
mutate(n = n()) %>% #count
arrange(var) %>% #arrange by var
filter(n==1) %>% #if is unique
print(n=nrow(.)) #then report## # A tibble: 143 x 3
## # Groups: var [143]
## var base n
## <chr> <chr> <int>
## 1 aa_acerto modelos 1
## 2 aa_erro modelos 1
## 3 aa_omi modelos 1
## 4 ac_acerto modelos 1
## 5 ac_erro modelos 1
## 6 ac_omis modelos 1
## 7 ad_acerto modelos 1
## 8 ad_erro modelos 1
## 9 ad_omis modelos 1
## 10 ano_aplicacao modelos 1
## 11 armas modelos 1
## 12 beta_cod_id modelos 1
## 13 beta_cod_pb modelos 1
## 14 categoria_cnh modelos 1
## 15 cidade_de_nascimento clinico 1
## 16 cidadedenascimento modelos 1
## 17 easv_acerto modelos 1
## 18 escolarid_n modelos 1
## 19 estado_de_nascimento clinico 1
## 20 exame_cnh modelos 1
## 21 figura01 clinico 1
## 22 figura02 clinico 1
## 23 figura03 clinico 1
## 24 figura04 clinico 1
## 25 figura05 clinico 1
## 26 figura06 clinico 1
## 27 figura07 clinico 1
## 28 figura08 clinico 1
## 29 figura09 clinico 1
## 30 figura10 clinico 1
## 31 figura11 clinico 1
## 32 figura12 clinico 1
## 33 figura13 clinico 1
## 34 figura14 clinico 1
## 35 figura15 clinico 1
## 36 figura16 clinico 1
## 37 figura17 clinico 1
## 38 figura18 clinico 1
## 39 figura19 clinico 1
## 40 figura20 clinico 1
## 41 figura21 clinico 1
## 42 figura22 clinico 1
## 43 figura23 clinico 1
## 44 figura24 clinico 1
## 45 figura25 clinico 1
## 46 figura26 clinico 1
## 47 figura27 clinico 1
## 48 figura28 clinico 1
## 49 figuras1 modelos 1
## 50 figuras10 modelos 1
## 51 figuras11 modelos 1
## 52 figuras12 modelos 1
## 53 figuras13 modelos 1
## 54 figuras14 modelos 1
## 55 figuras15 modelos 1
## 56 figuras16 modelos 1
## 57 figuras17 modelos 1
## 58 figuras18 modelos 1
## 59 figuras19 modelos 1
## 60 figuras2 modelos 1
## 61 figuras20 modelos 1
## 62 figuras21 modelos 1
## 63 figuras22 modelos 1
## 64 figuras23 modelos 1
## 65 figuras24 modelos 1
## 66 figuras25 modelos 1
## 67 figuras26 modelos 1
## 68 figuras27 modelos 1
## 69 figuras28 modelos 1
## 70 figuras3 modelos 1
## 71 figuras4 modelos 1
## 72 figuras5 modelos 1
## 73 figuras6 modelos 1
## 74 figuras7 modelos 1
## 75 figuras8 modelos 1
## 76 figuras9 modelos 1
## 77 instituicao clinico 1
## 78 lateralidade clinico 1
## 79 medicacao modelos 1
## 80 medicacao_e_outras_observacoes clinico 1
## 81 motoristaprofissional modelos 1
## 82 mvt_acertos modelos 1
## 83 particular modelos 1
## 84 pb_beta_rm modelos 1
## 85 polic_pm modelos 1
## 86 profissao modelos 1
## 87 r1_1 modelos 1
## 88 r1_10 modelos 1
## 89 r1_11 modelos 1
## 90 r1_12 modelos 1
## 91 r1_13 modelos 1
## 92 r1_14 modelos 1
## 93 r1_15 modelos 1
## 94 r1_16 modelos 1
## 95 r1_17 modelos 1
## 96 r1_18 modelos 1
## 97 r1_19 modelos 1
## 98 r1_2 modelos 1
## 99 r1_20 modelos 1
## 100 r1_21 modelos 1
## 101 r1_22 modelos 1
## 102 r1_23 modelos 1
## 103 r1_24 modelos 1
## 104 r1_25 modelos 1
## 105 r1_26 modelos 1
## 106 r1_27 modelos 1
## 107 r1_28 modelos 1
## 108 r1_29 modelos 1
## 109 r1_3 modelos 1
## 110 r1_30 modelos 1
## 111 r1_31 modelos 1
## 112 r1_32 modelos 1
## 113 r1_33 modelos 1
## 114 r1_34 modelos 1
## 115 r1_35 modelos 1
## 116 r1_36 modelos 1
## 117 r1_37 modelos 1
## 118 r1_38 modelos 1
## 119 r1_39 modelos 1
## 120 r1_4 modelos 1
## 121 r1_40 modelos 1
## 122 r1_5 modelos 1
## 123 r1_6 modelos 1
## 124 r1_7 modelos 1
## 125 r1_8 modelos 1
## 126 r1_9 modelos 1
## 127 r1_pb modelos 1
## 128 sexo_n modelos 1
## 129 teaco_acerto modelos 1
## 130 teaco_erros modelos 1
## 131 teaco_omiss modelos 1
## 132 teaco_pb modelos 1
## 133 teadi_acerto modelos 1
## 134 teadi_erros modelos 1
## 135 teadi_omiss modelos 1
## 136 teadi_pb modelos 1
## 137 tem_r_ac modelos 1
## 138 tem_r_erro modelos 1
## 139 teste_reteste modelos 1
## 140 trap_10_minutos modelos 1
## 141 trilhas_medida_de_interferencia clinico 1
## 142 trilhas_medida_interf modelos 1
## 143 uf modelos 1Fixes
First change. Names of figuras
ds_clinico <- ds_clinico %>%
rename_at(vars(figura01:figura28), ~paste0("figuras",01:28))Second change. Names of “trilhas”
ds_clinico <- ds_clinico %>%
rename(trilhas_medida_interf = "trilhas_medida_de_interferencia")Third change. Cidade nascimento
ds_clinico <- ds_clinico %>%
rename(cidadedenascimento = "cidade_de_nascimento")Fourth change. Estado de nascimento
ds_clinico <- ds_clinico %>%
rename(uf = "estado_de_nascimento")Merge
ds <- bind_rows(ds_modelos,ds_clinico)Dataset processes
This step fixes the merged dataset to make the independent variables suiatbles for data analysis.
unique number
ds <- ds %>%
mutate(id_unique = row_number()) %>%
select(id_unique, everything())sex
ds <- ds %>%
mutate(sex = factor(sexo))Schooling
ds <- ds %>%
mutate(schooling = factor(case_when(
escolarid_n == 1 ~ "fundamental",
escolarid_n == 2 ~ "medio",
escolarid_n > 2 ~ "superior"), levels = c("fundamental","medio","superior")))Age interval
ds <- ds %>%
mutate(age_interval = cut_width(idade, 10))Region
ds <- ds %>%
mutate(region = case_when(
uf == "BA" ~ "ne",
uf == "MG" ~ "se",
uf == "PR" ~ "su",
uf == "RJ" ~ "se",
uf == "SC" ~ "su",
uf == "SP" ~ "se") %>% as.factor)Detran
ds <- ds %>%
mutate(traffic = if_else(!is.na(exame_cnh), "yes","no") %>% as.factor)clinico
ds <- ds %>%
mutate(clinical = if_else(!is.na(grupo_clinico), "yes","no") %>% as.factor)Rotas
ds <- ds %>%
mutate(rota_c_total = rota_c_acerto-(rota_c_erro+rota_c_omissao)) %>%
mutate(rota_a_total = rota_a_acerto-(rota_a_erro+rota_a_omissao)) %>%
mutate(rota_d_total = rota_d_acerto-(rota_d_erro+rota_d_omissao))Memore
ds <- ds %>%
mutate(resp_1 = if_else(memore1 == 0,"VN","FP")) %>%
mutate(resp_2 = if_else(memore2 == 1,"VP","FN")) %>%
mutate(resp_3 = if_else(memore3 == 1,"VP","FN")) %>%
mutate(resp_4 = if_else(memore4 == 1,"VP","FN")) %>%
mutate(resp_5 = if_else(memore5 == 0,"VN","FP")) %>%
mutate(resp_6 = if_else(memore6 == 1,"VP","FN")) %>%
mutate(resp_7 = if_else(memore7 == 0,"VN","FP")) %>%
mutate(resp_8 = if_else(memore8 == 1,"VP","FN")) %>%
mutate(resp_9 = if_else(memore9 == 0,"VN","FP")) %>%
mutate(resp_10 = if_else(memore10 == 1,"VP","FN")) %>%
mutate(resp_11 = if_else(memore11 == 0,"VN","FP")) %>%
mutate(resp_12 = if_else(memore12 == 1,"VP","FN")) %>%
mutate(resp_13 = if_else(memore13 == 0,"VN","FP")) %>%
mutate(resp_14 = if_else(memore14 == 1,"VP","FN")) %>%
mutate(resp_15 = if_else(memore15 == 1,"VP","FN")) %>%
mutate(resp_16 = if_else(memore16 == 0,"VN","FP")) %>%
mutate(resp_17 = if_else(memore17 == 0,"VN","FP")) %>%
mutate(resp_18 = if_else(memore18 == 1,"VP","FN")) %>%
mutate(resp_19 = if_else(memore19 == 0,"VN","FP")) %>%
mutate(resp_20 = if_else(memore20 == 1,"VP","FN")) %>%
mutate(resp_21 = if_else(memore21 == 0,"VN","FP")) %>%
mutate(resp_22 = if_else(memore22 == 1,"VP","FN")) %>%
mutate(resp_23 = if_else(memore23 == 0,"VN","FP")) %>%
mutate(resp_24 = if_else(memore24 == 0,"VN","FP"))
ds <- ds %>%
mutate(vp_total = rowSums(select(., resp_1:resp_24) == "VP", na.rm = TRUE) * NA ^ (rowSums(!is.na(select(., resp_1:resp_24))) == 0)) %>%
mutate(fn_total = rowSums(select(., resp_1:resp_24) == "FN", na.rm = TRUE) * NA ^ (rowSums(!is.na(select(., resp_1:resp_24))) == 0)) %>%
mutate(fp_total = rowSums(select(., resp_1:resp_24) == "FP", na.rm = TRUE) * NA ^ (rowSums(!is.na(select(., resp_1:resp_24))) == 0)) %>%
mutate(vn_total = rowSums(select(., resp_1:resp_24) == "VN", na.rm = TRUE) * NA ^ (rowSums(!is.na(select(., resp_1:resp_24))) == 0))
ds <- ds %>%
mutate(memore_total = (vp_total+vn_total) - (fp_total + fn_total))CNH - primeira vs renovacao
ds <- ds %>%
mutate(cnh = factor(case_when(
exame_cnh == "MUDANÇA DE CATEGORIA" ~ "renovacao",
exame_cnh == "RENOVAÇÃO" ~ "renovacao",
exame_cnh == "PRIMEIRA HABILITAÇÃO" ~ "primeira"))) Policiais militares
ds <- ds %>%
mutate(pm = factor(if_else(profissao == "PM","sim", "nao")))
ds <- ds %>% mutate(pm = replace_na(pm,"nao"))
ds <- ds %>% mutate(gun = pm)Checking
ds %>% count(pm)## # A tibble: 2 x 2
## pm n
## <fct> <int>
## 1 nao 1223
## 2 sim 103#just checking
ds %>% select(starts_with("memore")) %>% plot_missing()
ds %>% select(starts_with("resp_")) %>% plot_missing()
ds %>% select(starts_with("memore_total")) %>% plot_missing()
Motorista profissional
ds <- ds %>%
mutate(prof_driver = factor(if_else(motoristaprofissional == "1","sim", "nao")))
ds <- ds %>% mutate(prof_driver = replace_na(prof_driver,"nao"))check
ds %>% count(motoristaprofissional,prof_driver)## # A tibble: 3 x 3
## motoristaprofissional prof_driver n
## <dbl> <fct> <int>
## 1 1 sim 173
## 2 2 nao 249
## 3 NA nao 904Crivo
ds <- ds %>%
mutate(fig_1 = if_else(figuras1 == "C",1,0),
fig_2 = if_else(figuras2 == "D",1,0),
fig_3 = if_else(figuras3 == "A",1,0),
fig_4 = if_else(figuras4 == "B",1,0),
fig_5 = if_else(figuras5 == "C",1,0),
fig_6 = if_else(figuras6 == "D",1,0),
fig_7 = if_else(figuras7 == "C",1,0),
fig_8 = if_else(figuras8 == "B",1,0),
fig_9 = if_else(figuras9 == "D",1,0),
fig_10 = if_else(figuras10 == "B",1,0),
fig_11 = if_else(figuras11 == "C",1,0),
fig_12 = if_else(figuras12 == "B",1,0),
fig_13 = if_else(figuras13 == "A",1,0),
fig_14 = if_else(figuras14 == "D",1,0),
fig_15 = if_else(figuras15 == "B",1,0),
fig_16 = if_else(figuras16 == "B",1,0),
fig_17 = if_else(figuras17 == "D",1,0),
fig_18 = if_else(figuras18 == "C",1,0),
fig_19 = if_else(figuras19 == "A",1,0),
fig_20 = if_else(figuras20 == "D",1,0),
fig_21 = if_else(figuras21 == "B",1,0),
fig_22 = if_else(figuras22 == "D",1,0),
fig_23 = if_else(figuras23 == "C",1,0),
fig_24 = if_else(figuras24 == "A",1,0),
fig_25 = if_else(figuras25 == "A",1,0),
fig_26 = if_else(figuras26 == "C",1,0),
fig_27 = if_else(figuras27 == "A",1,0),
fig_28 = if_else(figuras28 == "B",1,0)) %>%
mutate_at(vars(fig_1:fig_28), ~replace_na(., 0)) %>% #<- replace na with 0
mutate(figuras_pontos = rowSums(select(.,fig_1:fig_28), na.rm=T)) #get totalssum(is.na(ds %>% select(fig_1:fig_28)))## [1] 0plot_missing(ds %>% select(fig_1:fig_28))
Export ds
ds %>% write.table(.,"ds_figuras.csv", sep=",", col.names=T, row.names = F)
ds %>% select(fig_1:fig_28) %>% write.table(.,"figuras_itens_sem_header.csv", sep=",", col.names=FALSE, row.names = F)
ds %>% select(fig_1:fig_28) %>% write.table(.,"figuras_itens.csv", sep=",", col.names=T, row.names = F)If you are here, dowloaded the two original datasets (ds_modelos and ds_clinico), and ran the above code, you have exactly the same dataset as the original ds.
Done