02 EDA

Author

Sergio Uribe

Modified

August 15, 2024

Dataset

Table by ceo

EDA

Q: ¿Cual es la correlacion que existe entre la lactancia e incidencia de caries en la población de 0 - 4 años?

How many attendances per id?

Remove children with one attendance, because there is no follow up

All children
total_attendance	n	percent
1	6365	34.8%
2	5725	31.3%
3	3320	18.2%
4	1674	9.2%
5	701	3.8%
6	274	1.5%
7	109	0.6%
8	56	0.3%
9	19	0.1%
10	15	0.1%
11	7	0.0%

Children with > attendance
total_attendance	n	percent
2	5725	48.1%
3	3320	27.9%
4	1674	14.1%
5	701	5.9%
6	274	2.3%
7	109	0.9%
8	56	0.5%
9	19	0.2%
10	15	0.1%
11	7	0.1%

Cuantos ninos?

[1] 6174

Hay niños que tengan datos repetidos, o sea, el mismo ID y la misma fecha?

# A tibble: 860 × 23
        id fecha_cuestionario_ceo dupe_count  edad establecimiento         sexo 
     <dbl> <date>                      <int> <dbl> <chr>                   <chr>
 1 5012931 2019-05-09                      4    45 CESFAM La Floresta      Mujer
 2 5012931 2019-05-09                      4    45 CESFAM La Floresta      Mujer
 3 5012931 2019-05-09                      4    45 CESFAM La Floresta      Mujer
 4 5012931 2019-05-09                      4    45 CESFAM La Floresta      Mujer
 5 5058145 2018-03-26                      4    25 CESFAM Paulina Avendañ… Mujer
 6 5058145 2018-03-26                      4    25 CESFAM Paulina Avendañ… Mujer
 7 5058145 2018-03-26                      4    25 CESFAM Paulina Avendañ… Mujer
 8 5058145 2018-03-26                      4    25 CESFAM Paulina Avendañ… Mujer
 9 5091671 2018-05-03                      4    21 CESFAM La Floresta      Homb…
10 5091671 2018-05-03                      4    21 CESFAM La Floresta      Homb…
# ℹ 850 more rows
# ℹ 17 more variables: fecha_cuestionario_nutricionista <date>,
#   fecha_cuestionario_enfermera <date>, fecha_cuestionario_cero <date>,
#   historia_de_caries <chr>, cantidad_de_momentos_de_azucar_al_dia <chr>,
#   oportunidad_de_momentos_de_azucar <chr>,
#   cantidad_de_veces_que_se_duerme_con_mamadera <chr>,
#   frecuencia_de_cepillado <chr>, cepillado_nocturno <chr>, …

Filtrar aquellas que tengan distinto id y fecha_cuestionario_ceo

Cuantos niños tienen examen ceo en distintas fechas?

[1] 3734

                          tipo_de_alimentacion_infantil_final    n percent
                                  Formula Lactea Predominante 1225   28.8%
                                  Lactancia Materna Exclusiva 1107   26.0%
                               Lactancia Materna Predominante 1031   24.2%
                                     Formula Lactea Exclusiva  865   20.3%
       Formula Lactea Predominante - Formula Lactea Exclusiva    7    0.2%
 Lactancia Materna Predominante - Lactancia Materna Exclusiva    5    0.1%
 Formula Lactea Predominante - Lactancia Materna Predominante    3    0.1%
       Lactancia Materna Exclusiva - Formula Lactea Exclusiva    3    0.1%
 Lactancia Materna Exclusiva - Lactancia Materna Predominante    3    0.1%
       Formula Lactea Exclusiva - Formula Lactea Predominante    2    0.0%
 Lactancia Materna Predominante - Formula Lactea Predominante    2    0.0%
       Formula Lactea Exclusiva - Lactancia Materna Exclusiva    1    0.0%
    Lactancia Materna Exclusiva - Formula Lactea Predominante    1    0.0%

ceo by date per id

Claro, porque pocos niños se atendieron durante la pandemia y los pocos, eran casos muy graves

Unir las fechas de evaluación de lactancia y control dental

Ver la cercania de las fechas

Bien, solo nueve niños tienen diferencia

ahora a hacer la tabla 1 de nuevo

Table 1 NEW

Characteristic	Hombre, N = 1,877¹	Mujer, N = 1,827¹
Edad	12 (6, 24)	12 (6, 24)
Establecimiento
CESFAM Alcalde Leocán Portus	148 (7.9%)	157 (8.6%)
CESFAM La Floresta	300 (16%)	282 (15%)
CESFAM Lirquen	259 (14%)	239 (13%)
CESFAM Paulina Avendaño Pereda	204 (11%)	171 (9.4%)
CESFAM Penco	169 (9.0%)	156 (8.5%)
Other	797 (42%)	822 (45%)
¹ Median (IQR); n (%)

Analisis correlación ceo vs tipo de alimentación

reordenar tipo_de_alimentacion_infantil_final

Some modelling strategies

--- title: "02 EDA" author: "Sergio Uribe" date-modified: last-modified format: html: toc: true toc-expand: 3 code-fold: true code-tools: true editor: visual execute: echo: false cache: false warning: false message: false --- ```{r} # Load required libraries with pacman; installs them if not already installed pacman::p_load(tidyverse, # tools for data science visdat, #NAs janitor, # for data cleaning and tables here, # for reproducible research gtsummary, # for tables countrycode, # to normalize country data easystats, # check https://easystats.github.io/easystats/ DataExplorer, scales, kableExtra, lubridate ) # FOR EDA try DataExplorer, SmartEDA o dllokr, check https://www.youtube.com/watch?v=sKrWYE63Vk4&t=7s ``` ```{r} theme_set(theme_minimal()) ``` # Dataset ```{r} df <- read_rds(here("data", "df.rds")) ``` ```{r} df <- df |> janitor::clean_names() |> janitor::remove_empty(which = c("rows", "cols")) |> filter(!is.na(ceo)) # only con ceo ``` Table by ceo ```{r} df |> ggplot(aes(x = ceo)) + geom_histogram(bins = 5) + labs(title = "Distribución ceo") ``` # EDA ```{r} # Count the number of appointments per patient df |> group_by(id) |> summarise(appointment_count = n(), .groups = 'drop') |> filter(appointment_count > 1) |> ggplot(aes(x = appointment_count)) + geom_histogram(bins = 7) + labs(title = "Distribución de citas") ``` ```{r} # DataExplorer::create_report(df) ``` # Q: ¿Cual es la correlacion que existe entre la lactancia e incidencia de caries en la población de 0 - 4 años? ## How many attendances per id? ```{r} df |> pivot_longer(cols = starts_with("fecha_cuestionario"), names_to = "type_of_date", values_to = "date") |> filter(!is.na(date)) |> # Remove rows with NA dates group_by(id) |> summarise(total_attendance = n_distinct(date)) |> ungroup() |> ggplot(aes(x = total_attendance)) + geom_bar() + scale_x_continuous(breaks = 2:9) + # Ensure the x-axis shows the specific numbers labs(title = "Distribution of Total Attendances per ID", x = "Total Attendance", y = "Count") + theme_minimal() ``` ```{r} # Pivot the date columns into a long format df_long <- df |> pivot_longer(cols = starts_with("fecha_cuestionario"), names_to = "type_of_date", values_to = "date") |> filter(!is.na(date)) # Remove rows with NA dates ``` ```{r} # Calculate the total number of unique attendance dates per id df_attendance <- df_long |> group_by(id) |> summarise(total_attendance = n_distinct(date)) |> ungroup() ``` ```{r} # Merge the total attendance back to the original dataframe df <- df |> left_join(df_attendance, by = "id") ``` ```{r} # df <- df |> # rename(total_attendance = total_attendance.x) |> # Rename total_attendance.x to total_attendance # select(-total_attendance.y) # Remove total_attendance.y ``` ```{r} rm(df_long, df_attendance) ``` ## Remove children with one attendance, because there is no follow up ```{r} df |> tabyl(total_attendance) |> adorn_pct_formatting() |> knitr::kable() |> kableExtra::kable_styling() %>% kableExtra::add_header_above(c("All children" = 3)) ``` ```{r} df <- df |> filter(total_attendance > 1) ``` ```{r} df |> tabyl(total_attendance) |> adorn_pct_formatting() |> knitr::kable() |> kableExtra::kable_styling() %>% kableExtra::add_header_above(c("Children with > attendance" = 3)) ``` ## Cuantos ninos? ```{r} n_distinct(df$id) ``` Hay niños que tengan datos repetidos, o sea, el mismo ID y la misma fecha? ```{r} df |> janitor::get_dupes(id, fecha_cuestionario_ceo) ``` Filtrar aquellas que tengan distinto id y fecha_cuestionario_ceo ```{r} df <- df |> distinct(id, fecha_cuestionario_ceo, .keep_all = TRUE) |> mutate(tipo_de_alimentacion_infantil_final = case_when( !is.na(tipo_de_alimentacion_infantil_nutricionista) & is.na(tipo_de_alimentacion_infantil_enfermera) ~ tipo_de_alimentacion_infantil_nutricionista, is.na(tipo_de_alimentacion_infantil_nutricionista) & !is.na(tipo_de_alimentacion_infantil_enfermera) ~ tipo_de_alimentacion_infantil_enfermera, is.na(tipo_de_alimentacion_infantil_nutricionista) & is.na(tipo_de_alimentacion_infantil_enfermera) ~ "", tipo_de_alimentacion_infantil_nutricionista == tipo_de_alimentacion_infantil_enfermera ~ tipo_de_alimentacion_infantil_nutricionista, !is.na(tipo_de_alimentacion_infantil_nutricionista) & !is.na(tipo_de_alimentacion_infantil_enfermera) & tipo_de_alimentacion_infantil_nutricionista != tipo_de_alimentacion_infantil_enfermera ~ paste(tipo_de_alimentacion_infantil_nutricionista, tipo_de_alimentacion_infantil_enfermera, sep = " - ") )) |> filter(!is.na(tipo_de_alimentacion_infantil_final) & tipo_de_alimentacion_infantil_final != "" & !is.na(ceo)) ``` Cuantos niños tienen examen ceo en distintas fechas? ```{r} n_distinct(df$id) ``` ```{r} df |> tabyl(tipo_de_alimentacion_infantil_final) |> adorn_pct_formatting() |> arrange(desc(n)) ``` ```{r} # reshape df |> pivot_longer(cols = starts_with("fecha_cuestionario"), names_to = "type_of_date", values_to = "date") |> filter(!is.na(date)) |> # Remove rows with NA dates # the plot ggplot(aes(x = date, y = as.factor(id), color = type_of_date)) + geom_jitter(width = 0.001, height = 0.001, alpha = 0.1, size = 0.1) + labs(title = "Attendance per ID for Each Date", x = "Date", y = "ID", color = "Type of Date") + theme_minimal() + theme(legend.position = "top", axis.text.y = element_blank(), # Remove y-axis text axis.ticks.y = element_blank()) + # Remove y-axis ticks guides(color = guide_legend(nrow = 2, override.aes = list(size = 2, alpha = 1))) # Break the legend into two rows ``` ## ## ceo by date per id ```{r} df %>% filter(!is.na(fecha_cuestionario_ceo) & !is.na(ceo)) |> # create a new month column mutate(year_month = floor_date(fecha_cuestionario_ceo, "month")) |> # calculate group_by(year_month) %>% summarise( mean_ceo = mean(ceo, na.rm = TRUE), sd_ceo = sd(ceo, na.rm = TRUE), n = n() # number of observations ) %>% mutate(se_ceo = sd_ceo / sqrt(n)) %>% # calculate standard error ungroup() |> # the plot ggplot(aes(x = year_month, y = mean_ceo, color = mean_ceo)) + geom_point(size = 3) + geom_errorbar(aes(ymin = mean_ceo - se_ceo, ymax = mean_ceo + se_ceo), width = 0.2) + labs(title = "Mean CEO by Time Examination", x = "Year-Month", y = "Mean CEO ± SE") + theme_minimal() + scale_color_viridis_c(option = "F") + scale_y_log10() ``` Claro, porque pocos niños se atendieron durante la pandemia y los pocos, eran casos muy graves ## Unir las fechas de evaluación de lactancia y control dental Ver la cercania de las fechas ```{r} df <- df %>% rowwise() %>% mutate( diff_ceo_nurse = ifelse(!is.na(fecha_cuestionario_ceo) & !is.na(fecha_cuestionario_enfermera), abs(interval(fecha_cuestionario_ceo, fecha_cuestionario_enfermera) / months(1)), NA), diff_ceo_nutritionist = ifelse(!is.na(fecha_cuestionario_ceo) & !is.na(fecha_cuestionario_nutricionista), abs(interval(fecha_cuestionario_ceo, fecha_cuestionario_nutricionista) / months(1)), NA) ) %>% filter((!is.na(diff_ceo_nurse) & diff_ceo_nurse <= 6) | (!is.na(diff_ceo_nutritionist) & diff_ceo_nutritionist <= 6)) %>% ungroup() ``` Bien, solo nueve niños tienen diferencia ```{r} # Dejar solo aquellos que tienen un solo tipo de alimentación df <- df |> filter(!str_detect(tipo_de_alimentacion_infantil_final, " - ")) ``` ahora a hacer la tabla 1 de nuevo ## Table 1 NEW ```{r} df |> pivot_longer(cols = starts_with("fecha_cuestionario"), names_to = "type_of_date", values_to = "date") |> filter(!is.na(date)) |> # Remove rows with NA dates # Select the first time the child attended group_by(id) |> slice_min(order_by = date, n = 1, with_ties = FALSE) |> ungroup() |> # Select the columns of interest select(Edad = edad, Sexo = sexo, Establecimiento = establecimiento) |> mutate(Establecimiento = fct_lump(Establecimiento, 5)) |> # Create a summary table gtsummary::tbl_summary(by = Sexo) |> bold_labels() ``` # Analisis correlación ceo vs tipo de alimentación reordenar tipo_de_alimentacion_infantil_final ```{r} df <- df |> mutate(tipo_de_alimentacion_infantil_final = fct_relevel(tipo_de_alimentacion_infantil_final, "Lactancia Materna Exclusiva", "Lactancia Materna Predominante", "Formula Lactea Predominante", "Formula Lactea Exclusiva")) ``` \ ```{r} df |> ggplot(aes(x = fecha_cuestionario_ceo, y = ceo, group = id, color = tipo_de_alimentacion_infantil_final)) + geom_line() + geom_point(size = 1) + labs(title = "Desarrollo de Caries (CEO) por Niño, Fecha y Tipo de Alimentación", x = "Fecha de Cuestionario CEO", y = "CEO", color = "Tipo de Alimentación Infantil Final") + theme_minimal() + theme( legend.position = "bottom", axis.text.y = element_blank(), # Remove y-axis text axis.ticks.y = element_blank() # Remove y-axis ticks ) + guides(color = guide_legend(nrow = 2, override.aes = list(size = 3, alpha = 1))) + facet_grid(tipo_de_alimentacion_infantil_final ~. ) ``` # Some modelling strategies ```{r} saveRDS(df, here("data", "df_for_modelling.rds")) ``` ```{r} rm(df) ```