04 Models Epidemiology Latvia 2023

Published

Aug 15, 2023, 00:00

Modified

Aug 29, 2023, 15:18

PACKAGES & DATASETS

Dataset for EPi

Load data for Epidemiological Analysis

Cross-sectional Risk Model

Factors explaining caries severity in all 3 levels (d1mfs, d3mfs, d5mfs)

Demographics Gender, Age,

Fixed “Place of living”, Region, “Language spoken iat home”,

Potential “Smoking”, “Toothbrushing frequency” , “Toothpaste”, “Daily sugary drinks”, “Annual dental / dental hygiene visits” , “Daily sweets” , “Toothbrushing frequency”

Models

Regression tables Caries

Characteristic	D1MFS			D3MFS			D5MFS
Characteristic	IRR¹	95% CI¹	p-value	IRR¹	95% CI¹	p-value	IRR¹	95% CI¹	p-value
Gender
Meitene	—	—		—	—		—	—
Zēns	0.87	0.85, 0.88	<0.001	0.82	0.80, 0.85	<0.001	0.83	0.81, 0.86	<0.001
Age	1.18	1.17, 1.19	<0.001	1.28	1.27, 1.29	<0.001	1.31	1.29, 1.32	<0.001
Place of living
Rīga	—	—		—	—		—	—
Pierīga	1.11	1.07, 1.15	<0.001	1.03	0.98, 1.09	0.3	0.98	0.92, 1.04	0.5
DGP-JKP-JGA-JMA-LPJ-RZN-VMA-VSL	1.45	1.41, 1.50	<0.001	1.32	1.27, 1.38	<0.001	1.22	1.17, 1.28	<0.001
Cita pilsēta	1.31	1.27, 1.35	<0.001	1.22	1.17, 1.27	<0.001	1.17	1.11, 1.22	<0.001
Lauki	1.64	1.59, 1.69	<0.001	1.62	1.54, 1.69	<0.001	1.55	1.47, 1.63	<0.001
Toothbrushing frequency
Divas un vairākas reizes dienā	—	—		—	—		—	—
Reizi dienā - vakaros	1.06	1.04, 1.09	<0.001	1.08	1.05, 1.13	<0.001	1.07	1.03, 1.12	<0.001
Reizi dienā no rīta vai retāk nekā reizi dienā	1.13	1.10, 1.16	<0.001	1.08	1.04, 1.12	<0.001	1.04	1.00, 1.09	0.036
Netīra	1.34	1.29, 1.40	<0.001	1.45	1.37, 1.55	<0.001	1.47	1.37, 1.57	<0.001
Visible plaque
No	—	—		—	—		—	—
Yes	1.66	1.63, 1.69	<0.001	1.49	1.45, 1.53	<0.001	1.39	1.35, 1.44	<0.001
Toothpaste
Fluorīdi vismaz 1000 ppm	—	—		—	—		—	—
Fluorīdi līdz 1000 ppm	1.21	1.14, 1.28	<0.001	1.00	0.92, 1.09	>0.9	0.87	0.78, 0.96	0.009
Nezina	1.16	1.14, 1.19	<0.001	1.16	1.12, 1.19	<0.001	1.14	1.10, 1.17	<0.001
Fluorīdu nav	1.18	1.09, 1.27	<0.001	1.09	0.97, 1.21	0.13	1.03	0.91, 1.16	0.6
Daily sugary drinks
No	—	—		—	—		—	—
Yes	1.09	1.06, 1.11	<0.001	1.09	1.05, 1.12	<0.001	1.08	1.04, 1.12	<0.001
Annual dental / dental hygiene visits
Yes	—	—		—	—		—	—
No	0.99	0.96, 1.01	0.3	0.86	0.83, 0.89	<0.001	0.76	0.73, 0.80	<0.001
Daily sweets
No	—	—		—	—		—	—
Yes	0.99	0.97, 1.01	0.5	0.96	0.93, 0.99	0.020	1.01	0.97, 1.05	0.6
¹ IRR = Incidence Rate Ratio, CI = Confidence Interval

Plotting

Periodontal Risk Model

Factors explaining periodontal health (dependent variable binominal: bpe health / ill)

Characteristic	OR¹	95% CI¹	p-value
Gender
Meitene	—	—
Zēns	1.14	0.97, 1.33	0.11
Age	1.07	1.02, 1.13	0.008
Smoking
No	—	—
Yes	1.05	0.76, 1.48	0.8
Toothbrushing frequency
Divas un vairākas reizes dienā	—	—
Reizi dienā - vakaros	0.80	0.66, 0.97	0.024
Reizi dienā no rīta vai retāk nekā reizi dienā	1.15	0.93, 1.42	0.2
Netīra	0.80	0.53, 1.25	0.3
Visible plaque
No	—	—
Yes	6.17	5.14, 7.45	<0.001
Daily sugary drinks
No	—	—
Yes	1.03	0.87, 1.22	0.7
Annual dental / dental hygiene visits
Yes	—	—
No	1.26	1.01, 1.58	0.041
Daily sweets
No	—	—
Yes	1.33	1.12, 1.58	0.001
¹ OR = Odds Ratio, CI = Confidence Interval

--- title: "04 Models Epidemiology Latvia 2023" date: 2023-08-15 date-modified: last-modified date-format: "MMM D, YYYY, HH:mm" theme: default format: # docx: default # pdf: default html: toc: true toc-location: left toc-expand: 1 code-fold: true code-tools: true editor: visual execute: echo: false # cache: true warning: false message: false --- # PACKAGES & DATASETS ```{r} pacman::p_load(tidyverse, performance, # Assessment of Regression Models Performance purrr, gt, knitr, tidymodels, sjPlot, scales, gtsummary, irr, # for agreement calculations patchwork, # for several plots viridis, # colour palette janitor, here) ``` ```{r} theme_set(theme_minimal()) ``` ## Dataset for EPi Load data for Epidemiological Analysis ```{r} df <- read_rds(here("data", "df.rds")) # the rds file with the correct levels ``` # Cross-sectional Risk Model ## Factors explaining caries severity in all 3 levels (d1mfs, d3mfs, d5mfs) **Demographics** Gender, Age, **Fixed** "Place of living", Region, "Language spoken iat home", **Potential** "Smoking", "Toothbrushing frequency" , "Toothpaste", "Daily sugary drinks", "Annual dental / dental hygiene visits" , "Daily sweets" , "Toothbrushing frequency" ### Models ```{r} # Transform data with zeros # df$transformed_D1MFS <- log(df$D1MFS + 1) # df$transformed_D1MFS <- sqrt(df$D1MFS) # also try with log(df$D1MFS + 1) but the results are mainly the same # also tried gaussian and poisson and the later fits best ``` ```{r, warning=FALSE} model_D1MFS <- glm( D1MFS ~ Gender + Age + `Place of living` + # Region + # `Language spoken iat home` + # `Smoking` + `Toothbrushing frequency` + `Visible plaque` + Toothpaste + `Daily sugary drinks` + `Annual dental / dental hygiene visits` + `Daily sweets`, data = df, family = "poisson" ) model_D3MFS <- glm( D3MFS ~ Gender + Age + `Place of living` + # Region + # `Language spoken iat home` + # `Smoking` + `Toothbrushing frequency` + `Visible plaque` + Toothpaste + `Daily sugary drinks` + `Annual dental / dental hygiene visits` + `Daily sweets`, data = df, family = "poisson" ) model_D5MFS <- glm( D5MFS ~ Gender + Age + `Place of living` + # Region + # `Language spoken iat home` + # `Smoking` + `Toothbrushing frequency` + `Visible plaque` + Toothpaste + `Daily sugary drinks` + `Annual dental / dental hygiene visits` + `Daily sweets`, data = df, family = "poisson" ) ``` ```{r} # check_model(model_D1MFS) ``` ```{r, eval = FALSE} # check equidispersion residuals <- residuals(model_D1MFS, type = "pearson") var_res <- var(residuals) mean_res <- mean(residuals^2) print(var_res) ``` ```{r, eval = FALSE} print(mean_res) ``` ```{r} rm(var_res, mean_res) ``` ## Regression tables Caries ```{r} d1_table <- gtsummary::tbl_regression(model_D1MFS, exponentiate = TRUE) d3_table <- gtsummary::tbl_regression(model_D3MFS, exponentiate = TRUE) d5_table <- gtsummary::tbl_regression(model_D5MFS, exponentiate = TRUE) ``` ```{r} tbl_merge( tbls = list(d1_table, d3_table, d5_table), tab_spanner = c("**D1MFS**", "**D3MFS**","**D5MFS**") ) ``` ## Plotting ```{r} # Extract coefficients coefs <- coef(model_D1MFS) # Create color vector color_vector <- ifelse(coefs > 1, "red", "blue") ``` ```{r} plot_model(model_D1MFS, vline.color = "red", show.values = TRUE, value.offset = .3, title = "D1MFS Risk Indicators Model", colors = "Set2") ``` ```{r} plot_model(model_D3MFS, vline.color = "red", show.values = TRUE, value.offset = .3, title = "D3MFS Risk Indicators Model", colors = "Set2") ``` ```{r} plot_model(model_D3MFS, vline.color = "red", show.values = TRUE, value.offset = .3, title = "D5MFS Risk Indicators Model", colors = "Set2") ``` ```{r} # rm(model_D1MFS, # model_D3MFS, # model_D5MFS, # d1_table, # d3_table, # d5_table, # residuals) ``` ```{r} # Create a new variable with health/ill BPE df <- df |> mutate(BPE_binomial = case_when( BPE_total == "0" ~ "0", TRUE ~ "1" )) # convert to numeric for the regrsssion analysis df <- df |> mutate(BPE_binomial = as.numeric(BPE_binomial)) ``` # Periodontal Risk Model Factors explaining periodontal health (dependent variable binominal: bpe health / ill) ```{r} model_BPE_binomial <- glm( BPE_binomial ~ Gender + Age + # `Place of living` + # Region + # `Language spoken iat home` + `Smoking` + `Toothbrushing frequency` + `Visible plaque` + # Toothpaste + `Daily sugary drinks` + `Annual dental / dental hygiene visits` + `Daily sweets`, data = df, family = "binomial" ) ``` ```{r} gtsummary::tbl_regression(model_BPE_binomial, exponentiate = TRUE) ``` ```{r} plot_model(model_BPE_binomial, vline.color = "red", show.values = TRUE, value.offset = .3, colors = "Set2") ``` ```{r} # rm(model_BPE_binomial) ```