---
title: Self-Reported Snoring in Adults
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
---
## Introduction
<p>
NHANES added a question about snoring in the 2005-2006 survey
(<a href="https://wwwn.cdc.gov/nchs/data/nhanes/public/2005/questionnaires/sp_slq_d.pdf">1</a>),
using the question
*"In the past 12 months, how often did you snore while you were sleeping?"*,
with response categories: never, rarely (1-2 nights/week), occasionally (3-4 nights/week),
frequently (5 or more nights/week), refused and don't know.
</p><p>
For the 2007-2008 survey
(<a href="https://wwwn.cdc.gov/nchs/data/nhanes/public/2007/questionnaires/slq07_08_eng.pdf">2</a>),
interviewers were instructed to ask respondents, who reported don't know,
if anyone has told them they snore. The question has remained the same since and was
asked in the 2015-2016, 2017-2018, and 2019-March 2020 surveys.
</p><p>
This document examines self-reported snoring, in adults, for the available survey periods.
The combined 2017-March 2020 data was used as it's the only public source for the 2019-March 2020 data.
The data was examined by survey period. First overall, and then by sex, age group, and marital status.
Lastly, modeling of self-reported frequent snoring is included.
</p>
```{r}
#| message: false
library(broom.helpers)
library(dplyr)
library(gt)
library(ggiraph)
library(ggplot2)
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_graph <- function(df, v_end = 1) {
ggplot(df,
aes(x = p, y = SDDSRVYR, fill = SLQ030,
tooltip = sprintf("%s<br>%s: %.1f%%", SDDSRVYR, SLQ030, p))) +
geom_col_interactive(position = position_stack(reverse = TRUE)) +
scale_fill_viridis_d(end = v_end, alpha = 0.8) +
labs(x = "Percent") +
scale_x_continuous(breaks = seq(0, 100, 10), expand = expansion(add = 0)) +
scale_y_discrete(limits = rev, expand = expansion(add = 0.5)) +
theme_bw() +
theme(
text = element_text(size = 10),
axis.title.y = element_blank(),
legend.title = element_blank(),
strip.text = element_text(face = "bold", hjust = 0),
strip.background = element_rect(fill = "#fff"))
}
do_poisson <- function(srv) {
svyglm((SLQ030 == "Frequently") ~ SDDSRVYR + RIAGENDR + RIDAGEYR + DMDMARITAL,
srv, family = quasipoisson()) |>
tidy_and_attach(exponentiate = TRUE) |>
tidy_remove_intercept() |>
tidy_add_reference_rows() |>
tidy_add_term_labels() |>
mutate(
variable = case_match(variable,
"SDDSRVYR" ~ "Survey Period",
"RIAGENDR" ~ "Sex",
"RIDAGEYR" ~ "Age Group",
"DMDMARITAL" ~ "Marital Status"),
pr = if_else(!is.na(estimate),
sprintf("%.2f (%.2f, %.2f)", estimate, conf.low, conf.high), "Ref.")) |>
select(variable, label, pr) |>
gt(groupname_col = "variable", rowname_col = "label") |>
tab_stubhead(label = "") |>
cols_label(pr = "Prevalence Ratio (95% CI)") |>
tab_stub_indent(rows = everything(), indent = 3) |>
cols_align(columns = 3, align = "center") |>
tab_options(table.align = "left",
data_row.padding = px(2),
row_group.padding = px(2),
table.font.size = 16)
}
```
```{r}
demo_vars <- c("SEQN", "SDDSRVYR", "RIAGENDR", "RIDAGEYR", "DMDMARTL", "DMDMARTZ",
"SDMVSTRA", "SDMVPSU", "WTINT2YR", "WTINTPRP")
DEMO_D <- read_nhanes("DEMO_D") |> select(any_of(demo_vars))
DEMO_E <- read_nhanes("DEMO_E") |> select(any_of(demo_vars))
DEMO_I <- read_nhanes("DEMO_I") |> select(any_of(demo_vars))
P_DEMO <- read_nhanes("P_DEMO") |> select(any_of(demo_vars))
DEMO <- bind_rows(DEMO_D, DEMO_E, DEMO_I, P_DEMO)
```
```{r}
SLQ_D <- read_nhanes("SLQ_D") |> select(SEQN, SLQ030)
SLQ_E <- read_nhanes("SLQ_E") |> select(SEQN, SLQ030)
SLQ_I <- read_nhanes("SLQ_I") |> select(SEQN, SLQ030)
P_SLQ <- read_nhanes("P_SLQ") |> select(SEQN, SLQ030)
SLQ <- bind_rows(SLQ_D, SLQ_E, SLQ_I, P_SLQ)
```
```{r}
One <- left_join(DEMO, SLQ, by = "SEQN") |>
mutate(
RIAGENDR = if_else(RIAGENDR == 1, "Men", "Women"),
RIDAGEYR = case_match(RIDAGEYR,
20:34 ~ "20 to 34",
35:49 ~ "35 to 49",
50:64 ~ "50 to 64",
65:80 ~ "65 or more"),
DMDMARITAL = case_when(
SDDSRVYR != 66 & DMDMARTL %in% c(1, 6) ~ "Married/Living with Partner",
SDDSRVYR != 66 & DMDMARTL %in% 2:4 ~ "Widowed/Divorced/Separated",
SDDSRVYR != 66 & DMDMARTL == 5 ~ "Never Married",
DMDMARTZ == 1 ~ "Married/Living with Partner",
DMDMARTZ == 2 ~ "Widowed/Divorced/Separated",
DMDMARTZ == 3 ~ "Never Married"),
DMDMARITAL = factor(DMDMARITAL,
levels = c("Never Married", "Widowed/Divorced/Separated", "Married/Living with Partner")),
## See: https://wwwn.cdc.gov/nchs/nhanes/continuousnhanes/overviewbrief.aspx?Cycle=2017-2020 ##
survey_wt = if_else(SDDSRVYR != 66, WTINT2YR * 2/9.2, WTINTPRP * 3.2/9.2),
SDDSRVYR = case_match(SDDSRVYR,
4 ~ "2005-2006",
5 ~ "2007-2008",
9 ~ "2015-2016",
66 ~ "2017-March 2020"),
SLQ030 = case_match(SLQ030,
0 ~ "Never",
1 ~ "Rarely",
2 ~ "Occasionally",
3 ~ "Frequently",
7:9 ~ "Refused/DK"),
SLQ030 = factor(SLQ030,
levels = c("Never", "Rarely", "Occasionally", "Frequently", "Refused/DK"))) |>
select(SDDSRVYR, RIAGENDR, RIDAGEYR, DMDMARITAL, SLQ030,
SDMVSTRA, SDMVPSU, survey_wt)
```
```{r}
NHANES1 <- One |>
filter(!is.na(RIDAGEYR), !is.na(SLQ030)) |>
as_survey_design(id = SDMVPSU, strata = SDMVSTRA, nest = TRUE, weights = survey_wt)
NHANES2 <- One |>
filter(!is.na(RIDAGEYR), SLQ030 != "Refused/DK") |>
as_survey_design(id = SDMVPSU, strata = SDMVSTRA, nest = TRUE, weights = survey_wt)
```
## Overall
<h4>Self-Reported Snoring in Adults by Survey Cycle</h4>
```{r}
t1 <- NHANES1 |>
group_by(SDDSRVYR, SLQ030) |>
summarize(p = survey_prop(proportion = TRUE, vartype = "ci", prop_method = "beta")) |>
mutate(across(p:p_upp, ~ .x * 100))
t2 <- NHANES2 |>
group_by(SDDSRVYR, SLQ030) |>
summarize(p = survey_prop(proportion = TRUE, vartype = "ci", prop_method = "beta")) |>
mutate(across(p:p_upp, ~ .x * 100))
```
::: {.panel-tabset}
### Including Refused & Don't Know
```{r}
g <- do_graph(t1)
girafe(ggobj = g)
```
### Excluding Refused & Don't Know
```{r}
g <- do_graph(t2, 0.8)
girafe(ggobj = g)
```
:::
## By Sex
<h4>Self-Reported Snoring in Adults by Sex & Survey Cycle</h4>
```{r}
t1 <- NHANES1 |>
group_by(RIAGENDR, SDDSRVYR, SLQ030) |>
summarize(p = survey_prop(proportion = TRUE, vartype = "ci", prop_method = "beta")) |>
mutate(across(p:p_upp, ~ .x * 100))
t2 <- NHANES2 |>
group_by(RIAGENDR, SDDSRVYR, SLQ030) |>
summarize(p = survey_prop(proportion = TRUE, vartype = "ci", prop_method = "beta")) |>
mutate(across(p:p_upp, ~ .x * 100))
```
::: {.panel-tabset}
### Including Refused & Don't Know
```{r}
g <- do_graph(t1) + facet_wrap(vars(RIAGENDR), ncol = 1)
girafe(ggobj = g)
```
### Excluding Refused & Don't Know
```{r}
g <- do_graph(t2, 0.8) + facet_wrap(vars(RIAGENDR), ncol = 1)
girafe(ggobj = g)
```
:::
## By Age
<h4>Self-Reported Snoring in Adults by Age & Survey Cycle</h4>
```{r}
t1 <- NHANES1 |>
group_by(RIDAGEYR, SDDSRVYR, SLQ030) |>
summarize(p = survey_prop(proportion = TRUE, vartype = "ci", prop_method = "beta")) |>
mutate(across(p:p_upp, ~ .x * 100))
t2 <- NHANES2 |>
group_by(RIDAGEYR, SDDSRVYR, SLQ030) |>
summarize(p = survey_prop(proportion = TRUE, vartype = "ci", prop_method = "beta")) |>
mutate(across(p:p_upp, ~ .x * 100))
```
::: {.panel-tabset}
### Including Refused & Don't Know
```{r}
g <- do_graph(t1) + facet_wrap(vars(RIDAGEYR), ncol = 1)
girafe(ggobj = g)
```
### Excluding Refused & Don't Know
```{r}
g <- do_graph(t2, 0.8) + facet_wrap(vars(RIDAGEYR), ncol = 1)
girafe(ggobj = g)
```
:::
## By Marital Status
<h4>Self-Reported Snoring in Adults by Age & Survey Cycle</h4>
```{r}
t1 <- NHANES1 |>
filter(!is.na(DMDMARITAL)) |>
group_by(DMDMARITAL, SDDSRVYR, SLQ030) |>
summarize(p = survey_prop(proportion = TRUE, vartype = "ci", prop_method = "beta")) |>
mutate(across(p:p_upp, ~ .x * 100))
t2 <- NHANES2 |>
filter(!is.na(DMDMARITAL)) |>
group_by(DMDMARITAL, SDDSRVYR, SLQ030) |>
summarize(p = survey_prop(proportion = TRUE, vartype = "ci", prop_method = "beta")) |>
mutate(across(p:p_upp, ~ .x * 100))
```
::: {.panel-tabset}
### Including Refused & Don't Know
```{r}
g <- do_graph(t1) + facet_wrap(vars(DMDMARITAL), ncol = 1)
girafe(ggobj = g)
```
### Excluding Refused & Don't Know
```{r}
g <- do_graph(t2, 0.8) + facet_wrap(vars(DMDMARITAL), ncol = 1)
girafe(ggobj = g)
```
:::
## Modeling
<p>
Poisson regression is used to model self-reported frequent snoring.
</p>
::: {.panel-tabset}
### Including Refused & Don't Know
```{r}
do_poisson(NHANES1)
```
### Excluding Refused & Don't Know
```{r}
do_poisson(NHANES2)
```
:::