Show the code
pacman::p_load(tidyverse,
here,
janitor,
kableExtra,
viridis,
DescTools,
gtsummary)02_perio_eadph
Packages
Show the code
theme_set(theme_minimal())Dataset
Show the code
# to later match with the bpe dataset
id <- perio |>
select(id:place_of_living)Show the code
head(perio)# A tibble: 6 × 13
id region school_code gender age place…¹ visib…² x20_b…³ x20_b…⁴ x20_b…⁵
<int> <chr> <fct> <chr> <dbl> <chr> <chr> <dbl> <dbl> <dbl>
1 9 Rīga 60 Meite… 15 Rīga No 0 0 1
2 11 Rīga 60 Zēns 15 Pierīga No 0 0 0
3 13 Rīga 60 Meite… 15 Pierīga No 1 0 0
4 14 Rīga 60 Zēns 15 Rīga No 1 1 1
5 18 Rīga 60 Zēns 15 Rīga No 0 0 0
6 25 Latgale 22 Meite… 12 Lauki No 1 0 1
# … with 3 more variables: x20_bpe_36_37 <dbl>, x20_bpe_31 <dbl>,
# x20_bpe_46_47 <dbl>, and abbreviated variable names ¹place_of_living,
# ²visible_plaque, ³x20_bpe_16_17, ⁴x20_bpe_11, ⁵x20_bpe_26_27Descriptive
Show the code
perio |>
select(region:place_of_living) |>
select(-school_code) |>
gtsummary::tbl_summary(by = age)| Characteristic | 12, N = 1,5571 | 15, N = 1,5721 |
|---|---|---|
| region | ||
| Kurzeme | 286 (18%) | 265 (17%) |
| Latgale | 152 (9.8%) | 160 (10%) |
| Pierīga | 201 (13%) | 245 (16%) |
| Rīga | 446 (29%) | 409 (26%) |
| Vidzeme | 272 (17%) | 254 (16%) |
| Zemgale | 200 (13%) | 239 (15%) |
| gender | ||
| Meitene | 757 (49%) | 749 (48%) |
| Zēns | 800 (51%) | 823 (52%) |
| place_of_living | ||
| Cita pilsēta | 425 (27%) | 390 (25%) |
| Daugavpils, Jēkabpils, Jelgava, Jūrmala, Liepāja, Rēzekne, Valmiera, Ventspils | 324 (21%) | 390 (25%) |
| Lauki | 223 (14%) | 232 (15%) |
| Pierīga | 179 (11%) | 213 (14%) |
| Rīga | 406 (26%) | 347 (22%) |
| 1 n (%) | ||
BPE
| Scoring Codes | Clinical | Criteria |
|---|---|---|
| 0 | Pockets <3.5mm | No calculus/overhangs, no bleeding on probing |
| (black band entirely visible) | ||
| 1 | Pockets <3.5mm | No calculus/overhangs, bleeding on probing |
| (black band entirely visible) | ||
| 2 | Pockets <3.5mm | Supra or subgingival calculus/overhangs |
| (black band entirely visible) | ||
| 3 | Probing depth | 3.5-5.5mm |
| (Black band partially visible, indicating pocket | ||
| of 4-5mm) | ||
| 4 | Probing depth | >5.5mm |
| (Black band disappears, indicating a pocket of | ||
| 6mm or more) | ||
| 5 | Furcation involvement |
Show the code
perio <- perio |>
pivot_longer(cols = starts_with("x"),
names_to = "bpe",
values_to = "bpe_value") |>
mutate(bpe = str_remove(bpe, "x20_")) |>
extract(bpe, into = c("delete", "bpe"), regex = "^(.*?)_(.*)$", remove = FALSE) |>
relocate(bpe_value, .after = "bpe") |>
select(-delete)Show the code
perio |>
head(7)# A tibble: 7 × 9
id region school_code gender age place_of_living visible…¹ bpe bpe_v…²
<int> <chr> <fct> <chr> <dbl> <chr> <chr> <chr> <dbl>
1 9 Rīga 60 Meitene 15 Rīga No 16_17 0
2 9 Rīga 60 Meitene 15 Rīga No 11 0
3 9 Rīga 60 Meitene 15 Rīga No 26_27 1
4 9 Rīga 60 Meitene 15 Rīga No 36_37 0
5 9 Rīga 60 Meitene 15 Rīga No 31 0
6 9 Rīga 60 Meitene 15 Rīga No 46_47 0
7 11 Rīga 60 Zēns 15 Pierīga No 16_17 0
# … with abbreviated variable names ¹visible_plaque, ²bpe_valueShow the code
bpe_per_id <- perio |>
group_by(id, bpe) |>
summarise(max_bpe = max(bpe_value)) |>
pivot_wider(names_from = bpe,
values_from = max_bpe)`summarise()` has grouped output by 'id'. You can override using the `.groups`
argument.Show the code
bpe_per_id <- bpe_per_id |>
mutate(max_bpe = max(across("11":"46_47")))add the demographic information
Show the code
perio <- id |>
# select(id:place_of_living ) |>
left_join(bpe_per_id, by = "id") |>
# select(-(ends_with(".y"))) |>
rename_at(vars(ends_with(".x")), ~ gsub("\\.x", "", .))Show the code
rm(id, bpe_per_id)Max BPE per id
Show the code
perio |>
group_by(id) %>%
summarise(across(starts_with("max"), max))# A tibble: 3,129 × 2
id max_bpe
<int> <dbl>
1 9 1
2 11 0
3 13 1
4 14 1
5 18 0
6 25 2
7 26 2
8 27 2
9 28 2
10 29 1
# … with 3,119 more rowsHow many per age?
Show the code
perio |>
count(age)# A tibble: 2 × 2
age n
<dbl> <int>
1 12 1557
2 15 1572Show the code
perio |>
select(age, max_bpe) |>
gtsummary::tbl_summary(by = age)| Characteristic | 12, N = 1,5571 | 15, N = 1,5721 |
|---|---|---|
| max_bpe | ||
| 0 | 442 (28%) | 415 (26%) |
| 1 | 594 (38%) | 577 (37%) |
| 2 | 519 (33%) | 579 (37%) |
| 3 | 1 (<0.1%) | 1 (<0.1%) |
| 4 | 1 (<0.1%) | 0 (0%) |
| 1 n (%) | ||
BPE per quadrant
Show the code
perio |>
pivot_longer("11":"46_47",
names_to = "quadrant",
values_to = "bpe_value") |>
select(quadrant, bpe_value) |>
gtsummary::tbl_summary(by = quadrant)| Characteristic | 11, N = 3,1291 | 16_17, N = 3,1291 | 26_27, N = 3,1291 | 31, N = 3,1291 | 36_37, N = 3,1291 | 46_47, N = 3,1291 |
|---|---|---|---|---|---|---|
| bpe_value | ||||||
| 0 | 1,883 (60%) | 1,601 (51%) | 1,471 (47%) | 1,269 (41%) | 1,506 (48%) | 1,441 (46%) |
| 1 | 1,076 (34%) | 1,168 (37%) | 1,227 (39%) | 925 (30%) | 1,276 (41%) | 1,311 (42%) |
| 2 | 169 (5.4%) | 358 (11%) | 430 (14%) | 935 (30%) | 345 (11%) | 375 (12%) |
| 3 | 1 (<0.1%) | 1 (<0.1%) | 1 (<0.1%) | 0 (0%) | 2 (<0.1%) | 2 (<0.1%) |
| 4 | 0 (0%) | 1 (<0.1%) | 0 (0%) | 0 (0%) | 0 (0%) | 0 (0%) |
| 1 n (%) | ||||||
BPE by age table
Show the code
perio |>
group_by(id, age) |>
summarise(across(starts_with("max"), max)) |>
group_by(max_bpe, age) |>
count() |>
pivot_wider(names_from = age,
values_from = n)`summarise()` has grouped output by 'id'. You can override using the `.groups`
argument.# A tibble: 5 × 3
# Groups: max_bpe [5]
max_bpe `12` `15`
<dbl> <int> <int>
1 0 442 415
2 1 594 577
3 2 519 579
4 3 1 1
5 4 1 NABPE by age figure
Show the code
perio |>
group_by(id, age ) %>%
summarise(across(starts_with("max"), max)) |>
ggplot(aes(x = as.factor(max_bpe))) +
geom_bar() +
# scale_y_log10() +
facet_grid(age ~ . ) +
labs(title = "BPE by Age",
x = "BPE",
y = "n")`summarise()` has grouped output by 'id'. You can override using the `.groups`
argument.
BPE by gender figure
Show the code
perio |>
group_by(id, gender) %>%
summarise(across(starts_with("max"), max)) |>
ggplot(aes(x = as.factor(max_bpe))) +
geom_bar() +
# scale_y_log10() +
facet_grid(gender ~. ) +
labs(title = "BPE by gender",
x = "BPE",
y = "n")`summarise()` has grouped output by 'id'. You can override using the `.groups`
argument.
BPE by Quadrant figure
Show the code
perio |>
pivot_longer("11":"46_47",
names_to = "bpe",
values_to = "value") |>
ggplot(aes(x = bpe,
y = value,
fill = as.factor(value))) +
scale_fill_viridis_d() +
geom_col() +
labs(title = "BPE per quadrant",
fill = "BPE",
x = "Quadrant",
y = "n")