# A tibble: 0 × 34
# ℹ 34 variables: Count <dbl>, Timestamp <dttm>, Operator <chr>,
# Patient ID <dbl>, Group <chr>, Examination date <date>, Birth date <date>,
# Age <dbl>, Sex <chr>, Age2 <dbl>,
# Nr of dental visits (no GA, no sedation) <dbl>,
# Nr of treatment sessions with sedation <dbl>, Nr of emergency GA <dbl>,
# Nr of planned GA <dbl>, Nr of SDF applications (sessions) <dbl>,
# Nr of GIC sealants (primary teeth) <dbl>, …
REMOVE ID 218 & 279
EDA
Baseline of groups
Characteristic
control, N = 521
treatment, N = 1281
Sex
Female
25 (48%)
58 (45%)
Male
27 (52%)
70 (55%)
Age2
Mean (SD)
7.88 (1.65)
7.01 (1.40)
Nr of dental visits (no GA, no sedation)
Mean (SD)
6.3 (3.5)
7.8 (3.4)
Nr of treatment sessions with sedation
Mean (SD)
0.0192 (0.1387)
0.0078 (0.0884)
Nr of emergency GA
Mean (SD)
0.40 (0.63)
0.23 (0.51)
Nr of planned GA
Mean (SD)
0.83 (0.62)
0.05 (0.23)
Nr of SDF applications (sessions)
Mean (SD)
0.48 (1.06)
2.94 (2.07)
Nr of GIC sealants (primary teeth)
Mean (SD)
0.0192 (0.1387)
0.0391 (0.2917)
Nr of GIC sealants (permanent teeth)
Mean (SD)
0.10 (0.57)
0.30 (0.89)
Nr of resin sealants (primary teeth)
Mean (SD)
0.10 (0.45)
0.23 (0.76)
Nr of resin sealants (permanent teeth)
Mean (SD)
0.44 (1.24)
0.72 (1.52)
Nr of GIC fillings (primary teeth)
Mean (SD)
1.88 (1.93)
1.72 (2.09)
Nr of GIC fillings (permanent teeth)
Mean (SD)
0.13 (0.44)
0.12 (0.64)
Nr of resin fillings (primary teeth)
Mean (SD)
2.38 (2.34)
1.63 (2.24)
Nr of resin fillings (permanent teeth)
Mean (SD)
0.48 (1.06)
0.06 (0.37)
Nr of Hall crowns
Mean (SD)
0.17 (0.51)
0.63 (1.07)
Nr of traditional crowns
Mean (SD)
1.96 (2.02)
0.25 (0.69)
Nr of pulp treatments (primary teeth)
Mean (SD)
2.50 (2.09)
0.42 (0.89)
Nr of pulp treatments (permanent teeth)
Mean (SD)
0.1923 (0.8174)
0.0156 (0.1768)
Nr of extractions (primary teeth)
Mean (SD)
1.69 (1.79)
0.58 (0.99)
Nr of extractions (permanent teeth)
Mean (SD)
0.0192 (0.1387)
0.0078 (0.0884)
Compliance/adherence to the cohort group
All treatments done as needed
37 (71%)
94 (73%)
Partially, not all treatments were done as planned
15 (29%)
34 (27%)
How would you rate the success of your child's dental treatment?
1
1 (1.9%)
0 (0%)
2
0 (0%)
1 (0.8%)
3
5 (9.6%)
3 (2.3%)
4
11 (21%)
25 (20%)
5
35 (67%)
99 (77%)
How willing would you be to continue the same treatment approach received during the last two years?
1
3 (5.8%)
0 (0%)
2
1 (1.9%)
0 (0%)
3
3 (5.8%)
1 (0.8%)
4
12 (23%)
12 (9.4%)
5
33 (63%)
115 (90%)
Wong-Baker scale
0
16 (34%)
66 (56%)
2
12 (26%)
28 (24%)
4
9 (19%)
15 (13%)
6
3 (6.4%)
4 (3.4%)
8
2 (4.3%)
2 (1.7%)
10
5 (11%)
3 (2.5%)
Unknown
5
10
1 n (%)
Costs estimations
Costs per year
Cost Estimates per child/year
n
Mean Cost per Year (€)
SD (€)
25th Percentile Total Cost (€)
Median Total Cost (€)
75th Percentile Total Cost (€)
128 €
100 €
52 €
60 €
88 €
129 €
Characteristic
N = 1281
Cost_per_Year
88 (60, 129)
1 Median (IQR)
95%CI
# A tibble: 1 × 6
mean_cost_per_year sd_cost_per_year n se lower_ci upper_ci
<dbl> <dbl> <int> <dbl> <dbl> <dbl>
1 99.7 51.8 128 4.58 90.6 109.
Assuming 65000 requireng dental treatment (45% of children between 0-6 years old), and a cost
Cost Estimates for Treating 65,000 Children Based on 95% CI
Lower Total Cost (€)
Mean Total Cost (€)
Upper Total Cost (€)
5888129 €
6477285 €
7066440 €
Source Code
---title: "2025_RSU_Olga_research_week_economic_analysis"author: "SU"date: 2024-05-29date-modified: last-modifiedlanguage: title-block-published: "CREATED" title-block-modified: "UPDATED"format: html: toc: truetoc-expand: 3code-fold: truecode-tools: trueeditor: visualexecute: echo: false cache: true warning: false message: false---# Packages```{r}# Load required libraries with pacman; installs them if not already installedpacman::p_load(tidyverse, # tools for data science visdat, #NAs hrbrthemes, # nice ggplot themes janitor, # for data cleaning and tables here, # for reproducible research gtsummary, # for tables explore, # for EDA, check https://rolkra.github.io/explore/ countrycode, # to normalize country data ggeasy, # to use variable labels in ggplot, then easy_labs() easystats, # check https://easystats.github.io/easystats/ scales, lubridate )``````{r}theme_set(theme_minimal())```# Data```{r}df <-read_csv(here::here("data", "2025_rsu_olga.csv"))```## Add the age to all the children```{r}df <- df |>mutate(Age2 =as.numeric(difftime(ymd(`Examination date`), ymd(`Birth date`), units ="days")) /365.25 ) |>relocate(Age2, .after ="Sex")``````{r}df |>filter(is.na(Age2))``````{r}df |>ggplot(aes(x = Age2)) +geom_histogram(bins =10)```## REMOVE ID 218 & 279```{r}df <- df |>filter(Age2 >2)```# EDA```{r}# glimpse(df)```## Baseline of groups```{r}df |>select(-c(Count, Timestamp, Operator, `Patient ID`, `Examination date`, `Birth date`, Costs, Age)) |> gtsummary::tbl_summary(by ="Group", type =list(Age2 ~"continuous2", contains("Nr of") ~"continuous2"), # Specify variable typesstatistic =all_continuous() ~"{mean} ({sd})"# Customize statistics ) |>modify_table_body(~ .x %>%mutate(across(where(is.numeric), ~round(., 2))) # Round numeric values in the summary table )```# Costs estimations```{r}# df |> # ggplot(aes(x = Group, # y = Costs, # color = Group)) + # geom_violin() + # geom_jitter(alpha = 0.2, width = 0.3) + # geom_boxplot(width = 0.1, alpha = 0.2) +# labs(# title = "Comparison of *TOTAL* Costs by Group",# subtitle = "Violin, jitter, and box plots for treatment and control groups",# x = "Group",# y = "Costs (EUR)",# color = "Group"# ) ``````{r}# df |> # with(glm(Costs ~# Group + # Sex + Age + `How would you rate the success of your child's dental treatment?` )) |> # gtsummary::tbl_regression()```## ## Costs per year```{r}df |>filter(Group =="treatment") |>mutate(Cost_per_Year = Costs / Age2) |>summarise(n =n(), # Number of observationsmean =mean(Cost_per_Year, na.rm =TRUE), # Average cost per yearsd =sd(Cost_per_Year, na.rm =TRUE), # Standard deviationq25 =quantile(Cost_per_Year, 0.25, na.rm =TRUE), # 25th percentileq50 =median(Cost_per_Year, na.rm =TRUE), # Median (50th percentile)q75 =quantile(Cost_per_Year, 0.75, na.rm =TRUE) # 75th percentile ) |>mutate(across(where(is.numeric), ~paste0(round(., 0), " €"))) |># Add euro sign and round to 2 decimals knitr::kable(col.names =c("n", "Mean Cost per Year (€)", "SD (€)", "25th Percentile Total Cost (€)", "Median Total Cost (€)", "75th Percentile Total Cost (€)"),caption ="Cost Estimates per child/year" )``````{r}df |>filter(Group =="treatment") |>mutate(Cost_per_Year = Costs / Age2) |>select(Cost_per_Year) |>ggplot(aes(x = Cost_per_Year)) +# geom_histogram(bins = 8) +geom_histogram(bins =8, fill ="Grey 50", color ="Grey 50", alpha =0.7) +# Customize the histogram appearancelabs(title ="Distribution of Cost per Year for Treatment Group",x ="Cost per Year (EUR)",y ="Frequency" ) ``````{r}df |>filter(Group =="treatment") |>mutate(Cost_per_Year = Costs / Age2) |>select(Cost_per_Year) |> gtsummary::tbl_summary()```## 95%CI```{r}df |>filter(Group =="treatment", !is.na(Age2), Age2 >0) |># Filter valid Age2 valuesmutate(Cost_per_Year = Costs / Age2) |>summarise(mean_cost_per_year =mean(Cost_per_Year, na.rm =TRUE), # Mean cost per yearsd_cost_per_year =sd(Cost_per_Year, na.rm =TRUE), # Standard deviationn =n(), # Number of observationsse = sd_cost_per_year /sqrt(n), # Standard errorlower_ci = mean_cost_per_year -qt(0.975, df = n -1) * se, # Lower bound of 95% CIupper_ci = mean_cost_per_year +qt(0.975, df = n -1) * se # Upper bound of 95% CI ) |>mutate(across(c(mean_cost_per_year, lower_ci, upper_ci), ~round(., 1))) # Round to 2 decimals```## Assuming 65000 requireng dental treatment (45% of children between 0-6 years old), and a cost```{r}df |>filter(Group =="treatment") |>mutate(Cost_per_Year = Costs / Age2) |>summarise(mean_cost_per_year =mean(Cost_per_Year, na.rm =TRUE), # Mean cost per yearsd_cost_per_year =sd(Cost_per_Year, na.rm =TRUE), # Standard deviationn =n(), # Number of observationsse = sd_cost_per_year /sqrt(n), # Standard errorlower_ci = mean_cost_per_year -qt(0.975, df = n -1) * se, # Lower bound of 95% CIupper_ci = mean_cost_per_year +qt(0.975, df = n -1) * se # Upper bound of 95% CI ) |>summarise(lower_total_cost = lower_ci *65000, # Total cost using lower boundmean_total_cost = mean_cost_per_year *65000, # Total cost using meanupper_total_cost = upper_ci *65000# Total cost using upper bound ) |>mutate(across(where(is.numeric), ~paste0(round(., 0), " €"))) |># Add euro sign and round to 0 decimals knitr::kable(col.names =c("Lower Total Cost (€)", "Mean Total Cost (€)", "Upper Total Cost (€)"),caption ="Cost Estimates for Treating 65,000 Children Based on 95% CI" )``````{r}```
