---
title: Resting Pulse Rate in the U.S Population
subtitle: Using R with NHANES
author: Cubicle 3253
format:
html:
code-tools: true
echo: false
embed-resources: true
fig-asp: 0.6
fig-dpi: 300
grid:
sidebar-width: 200px
body-width: 1500px
margin-width: 50px
linestretch: 1.1
toc: true
toc-location: left
---
```{r}
#| message: false
library(dplyr)
library(ggiraph)
library(ggplot2)
library(gt)
library(haven)
library(survey)
library(srvyr)
read_nhanes <- function(xpt_name)
{
xpt_name <- toupper(xpt_name)
if(substr(xpt_name, 1, 2) == "P_") {
begin_year = "2017"
} else {
begin_year = switch(substr(xpt_name, nchar(xpt_name) - 1, nchar(xpt_name)),
"_L" = "2021",
"_J" = "2017",
"_I" = "2015",
"_H" = "2013",
"_G" = "2011",
"_F" = "2009",
"_E" = "2007",
"_D" = "2005",
"_C" = "2003",
"_B" = "2001",
"1999")
}
xpt_url <- paste0("https://wwwn.cdc.gov/nchs/data/nhanes/public/", begin_year, "/datafiles/", xpt_name, ".xpt")
try(read_xpt(xpt_url), silent = TRUE)
}
do_plot <- function(df) {
ggplot(df, aes(x = pulse, y = age_group, fill = age_group, weight = survey_wt)) +
geom_boxplot() +
scale_fill_viridis_d(alpha = 0.6) +
coord_cartesian(xlim = c(30, 130)) +
scale_x_continuous(breaks = seq(30, 130, 10)) +
scale_y_discrete(limits = rev) +
labs(x = "Resting Pulse Rate", y = "Age Group") +
theme_bw() +
theme(legend.position = "none")
}
do_table <- function(svy) {
svy |>
group_by(age_group) |>
summarize(
n = n(),
q = survey_quantile(pulse, quantiles = c(0.05, 0.25, 0.50, 0.75, 0.95), vartype = NULL)) |>
gt() |>
cols_label(
age_group = "Age Group",
q_q05 = md("5^th^"),
q_q25 = md("25^th^"),
q_q50 = md("50^th^"),
q_q75 = md("75^th^"),
q_q95 = md("95^th^"),) |>
tab_spanner(columns = 3:7, label = "Percentile") |>
fmt_integer(columns = 2:7) |>
cols_align(columns = 1, align = "left") |>
cols_align(columns = 2:7, align = "center") |>
tab_options(table.align = "left",
data_row.padding = px(2),
row_group.padding = px(2),
table.font.size = 18)
}
```
```{r}
demo_vars <- c("SEQN", "SDDSRVYR", "RIAGENDR", "RIDAGEYR", "SDMVSTRA", "SDMVPSU", "WTMEC2YR", "WTMECPRP")
P_DEMO <- read_nhanes("P_DEMO") |> select(any_of(demo_vars))
DEMO_L <- read_nhanes("DEMO_L") |> select(any_of(demo_vars))
DEMO <- bind_rows(P_DEMO, DEMO_L)
```
```{r}
P_BPX <- read_nhanes("P_BPXO") |> select(SEQN, BPXOPLS1:BPXOPLS3)
BPX_L <- read_nhanes("BPXO_L") |> select(SEQN, BPXOPLS1:BPXOPLS3)
BPX <- bind_rows(P_BPX, BPX_L) |>
mutate(pulse = rowMeans(cbind(BPXOPLS1, BPXOPLS2, BPXOPLS3), na.rm = TRUE)) |>
select(SEQN, pulse)
```
```{r}
One <- DEMO |>
left_join(BPX, by = "SEQN") |>
mutate(
RIAGENDR = if_else(RIAGENDR == 1, "Male", "Female"),
age_group = case_match(RIDAGEYR,
8:11 ~ "8 to 11",
12:15 ~ "12 to 15",
16:19 ~ "16 to 19",
20:34 ~ "20 to 34",
35:49 ~ "35 to 49",
50:64 ~ "50 to 64",
65:79 ~ "65 to 79",
80 ~ "80 or more"),
age_group = factor(age_group,
levels = c("8 to 11", "12 to 15", "16 to 19", "20 to 34", "35 to 49",
"50 to 64", "65 to 79", "80 or more")),
survey_wt = coalesce(WTMECPRP, WTMEC2YR))
```
```{r}
options(survey.lonely.psu = "adjust")
NHANES <- One |>
filter(RIDAGEYR >= 8, !is.na(pulse)) |>
as_survey_design(id = SDMVPSU, strata = SDMVSTRA, nest = TRUE, weights = survey_wt)
```
## Overall
```{r}
One |>
filter(RIDAGEYR >= 8, !is.na(pulse)) |>
do_plot()
```
<details>
<summary>
Data Table
</summary>
```{r}
NHANES |>
do_table()
```
</details>
## Females
```{r}
One |>
filter(RIAGENDR == "Female", RIDAGEYR >= 8, !is.na(pulse)) |>
do_plot()
```
<details>
<summary>
Data Table
</summary>
```{r}
NHANES |>
filter(RIAGENDR == "Female") |>
do_table()
```
</details>
## Males
```{r}
One |>
filter(RIAGENDR == "Male", RIDAGEYR >= 8, !is.na(pulse)) |>
do_plot()
```
<details>
<summary>
Data Table
</summary>
```{r}
NHANES |>
filter(RIAGENDR == "Male") |>
do_table()
```
</details>