<p><div><div><div><div data-show-faces="false" data-height="21" data-width="100" data-layout="button_count" data-send="true" data-href="https://www.r-bloggers.com/weight-loss-in-the-u-s-an-analysis-of-nhanes-data-with-tidyverse/"></div></div><div></div></div><div></div></div>
<div>
(This article was first published on <strong><a href="https://datascienceplus.com/weight-loss-in-the-u-s-an-analysis-of-nhanes-data-with-tidyverse/"> R Programming – DataScience+</a></strong>, and kindly contributed to <a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers)</a> </div>
<p>Based on a paper published in <a rel="nofollow" href="https://jamanetwork.com/journals/jama/fullarticle/2608211" target="_blank">JAMA</a> last year, the weight gain is increasing among US adults while there is no difference in the percentage of people that were trying to lose weight. The authors used the data from the National Health and Nutrition Examination Survey <a rel="nofollow" href="https://www.cdc.gov/nchs/nhanes/index.htm" target="_blank">NHANES</a> from 1988 to 2014 and calculated the proportion of people tried to lose weight during the past 12 months. </p>
<p>Logistic regression analysis was used to estimate the odds of trying to lose weight for different periods from 1988 to 2014. I would like to reproduce these findings with R, given that NHANES data is publically available.</p>
<h2>Libraries and Datasets</h2>
<p>Load libraries</p>
<pre><code>library(tidyverse)
library(RNHANES)
library(weights)
library(ggsci)
library(ggthemes)
</code></pre>
<p>The authors utilized the data from 1988 to 2014, but since the <code>RNHANES</code> package enables the data starting from 1999, I will include data from 1999 to 2014. Therefore, I cannot fully reproduce the results of the paper publish at JAMA.</p>
<p>Load the data using <code>nhanes_load_data</code> function from <code>RNHANES</code> package.</p>
<pre><code>d99 = nhanes_load_data(&quot;DEMO&quot;, &quot;1999-2000&quot;) %>%
  select(SEQN, cycle, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR) %>%
  transmute(SEQN=SEQN, wave=cycle, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR) %>%
  left_join(nhanes_load_data(&quot;BMX&quot;, &quot;1999-2000&quot;), by=&quot;SEQN&quot;) %>%
  select(SEQN, wave, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR, BMXBMI) %>%
  left_join(nhanes_load_data(&quot;WHQ&quot;, &quot;1999-2000&quot;), by=&quot;SEQN&quot;) %>%
  select(SEQN, wave, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR, BMXBMI, WHQ070)

d01 = nhanes_load_data(&quot;DEMO_B&quot;, &quot;2001-2002&quot;) %>% 
  select(SEQN, cycle, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR) %>%
  transmute(SEQN=SEQN, wave=cycle, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR) %>%
  left_join(nhanes_load_data(&quot;BMX_B&quot;, &quot;2001-2002&quot;), by=&quot;SEQN&quot;) %>%
  select(SEQN, wave, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR, BMXBMI) %>%
  left_join(nhanes_load_data(&quot;WHQ_B&quot;, &quot;2001-2002&quot;), by=&quot;SEQN&quot;) %>%
  select(SEQN, wave, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR, BMXBMI, WHQ070)

d03 = nhanes_load_data(&quot;DEMO_C&quot;, &quot;2003-2004&quot;) %>%
  select(SEQN, cycle, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR) %>%
  transmute(SEQN=SEQN, wave=cycle, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR) %>%
  left_join(nhanes_load_data(&quot;BMX_C&quot;, &quot;2003-2004&quot;), by=&quot;SEQN&quot;) %>%
  select(SEQN, wave, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR, BMXBMI) %>%
  left_join(nhanes_load_data(&quot;WHQ_C&quot;, &quot;2003-2004&quot;), by=&quot;SEQN&quot;) %>%
  select(SEQN, wave, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR, BMXBMI, WHQ070)

d09 = nhanes_load_data(&quot;DEMO_F&quot;, &quot;2009-2010&quot;) %>%
  select(SEQN, cycle, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMIN2, WTINT2YR, WTMEC2YR) %>%
  transmute(SEQN=SEQN, wave=cycle, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC=INDFMIN2, WTINT2YR, WTMEC2YR) %>%
  left_join(nhanes_load_data(&quot;BMX_F&quot;, &quot;2009-2010&quot;), by=&quot;SEQN&quot;) %>%
  select(SEQN, wave, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR, BMXBMI) %>%
  left_join(nhanes_load_data(&quot;WHQ_F&quot;, &quot;2009-2010&quot;), by=&quot;SEQN&quot;) %>%
  select(SEQN, wave, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR, BMXBMI, WHQ070)

d11 = nhanes_load_data(&quot;DEMO_G&quot;, &quot;2011-2012&quot;) %>%
  select(SEQN, cycle, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMIN2, WTINT2YR, WTMEC2YR) %>%
  transmute(SEQN=SEQN, wave=cycle, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC=INDFMIN2, WTINT2YR, WTMEC2YR) %>%
  left_join(nhanes_load_data(&quot;BMX_G&quot;, &quot;2011-2012&quot;), by=&quot;SEQN&quot;) %>%
  select(SEQN, wave, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR, BMXBMI) %>%
  left_join(nhanes_load_data(&quot;WHQ_G&quot;, &quot;2011-2012&quot;), by=&quot;SEQN&quot;) %>%
  select(SEQN, wave, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR, BMXBMI, WHQ070)

d13 = nhanes_load_data(&quot;DEMO_H&quot;, &quot;2013-2014&quot;) %>%
  select(SEQN, cycle, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMIN2, WTINT2YR, WTMEC2YR) %>%
  transmute(SEQN=SEQN, wave=cycle, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC=INDFMIN2, WTINT2YR, WTMEC2YR) %>%
  left_join(nhanes_load_data(&quot;BMX_H&quot;, &quot;2013-2014&quot;), by=&quot;SEQN&quot;) %>%
  select(SEQN, wave, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR, BMXBMI) %>%
  left_join(nhanes_load_data(&quot;WHQ_H&quot;, &quot;2013-2014&quot;), by=&quot;SEQN&quot;) %>%
  select(SEQN, wave, RIAGENDR, RIDAGEYR, RIDRETH1, RIDEXPRG, INDFMINC, WTINT2YR, WTMEC2YR, BMXBMI, WHQ070)
</code></pre>
<p>The list of variables I will use in analysis:</p>
<ul>
<li>SEQN: id</li>
<li>RIAGENDR: gender</li>
<li>RIDAGEYR: age in years</li>
<li>BMXBMI: body mass index</li>
<li>INDFMINC: family income</li>
<li>RIDRETH1: race/ethnicity</li>
<li>RIDEXPRG: pregnancy</li>
<li>WHQ070: intention to lose weight</li>
<li>WTINT2YR: weighted variable for questionnaires</li>
<li>WTMEC2YR: weighted variable for laboratory measurements</li>
</ul>
<p>Merging the datasets, creating new variables, and excluding pregnant women.</p>
<pre><code>dat = rbind(d99, d01, d03, d09, d11, d13) %>%
  mutate(
    race = recode_factor(RIDRETH1,
                         `1` = &quot;Mexian American&quot;,
                         `2` = &quot;Hispanic&quot;,
                         `3` = &quot;Non-Hispanic, White&quot;,
                         `4` = &quot;Non-Hispanic, Black&quot;,
                         `5` = &quot;Others&quot;),
    bmi = if_else(BMXBMI >= 30, &quot;Obese&quot;, &quot;Overweight&quot;),
    pregnancy = if_else(RIDEXPRG == 1, &quot;Yes&quot;, &quot;No&quot;, &quot;No&quot;),
    tryweloss = if_else(WHQ070 == 1, &quot;Yes&quot;, &quot;No&quot;)
    ) %>%
  filter(BMXBMI >= 25, RIDAGEYR >=20, RIDAGEYR &lt; 60, race != &quot;Others&quot;, pregnancy == &quot;No&quot;, WHQ070 %in% c(1,2))
</code></pre>
<p>I excluded pregnant women from the analysis as they are overweight or obese due to pregnancy and might have no intention to lose weight during pregnancy. The R code below calculates the weighted proportion of overweight and obesity as well as intention to lose weight for the total population.</p>
<pre><code>with(dat, wpct(bmi, weight =  WTMEC2YR))</code>
<em>## Obese Overweight ## 0.4997831 0.5002169
</em></pre>
<pre><code>with(dat, wpct(tryweloss, weight =  WTINT2YR))</code>
<em>## No Yes ## 0.5235062 0.4764938
</em></pre>
<p>The proportion of obese and overweight is 50%, as I excluded the normal weight individuals before. The intention to lose weight in the total population is 48%. Now, I will evaluate the “intention to lose weight” among overweight and obese people in different periods. (I will repeat the same code for each period studied. If you know how to short the code below please let me know. I don't know how to weight the proportion with the <code>tidyverse</code> package)</p>
<pre><code>with(dat %>% filter(wave == &quot;1999-2000&quot;, bmi == &quot;Obese&quot;),
     wpct(tryweloss, weight =  WTINT2YR))</code>
<em>## No Yes ## 0.4555818 0.5444182
</em></pre>
<pre><code>with(dat %>% filter(wave == &quot;1999-2000&quot;, bmi == &quot;Overweight&quot;),
     wpct(tryweloss, weight =  WTINT2YR))</code>
<em>## No Yes ## 0.6000436 0.3999564
</em></pre>
<p>There are 54% obese and 40% overweight people who are trying to lose weight in 1999-2000. Using the above, I calculated the proportions for other periods and made a table. I will focus only on those who lost weight to see how the trend goes over years in overweight and obese.</p>
<pre><code>trend &lt;- read.table(header=TRUE, text='
year bmi weightloss
1999-2000 Obese 54.44182
1999-2000 Overweight 39.99564
2001-2002 Obese 54.14932
2001-2002 Overweight 38.60543
2003-2004 Obese 53.6699
2003-2004 Overweight 42.97784
2009-2010 Obese 53.62087
2009-2010 Overweight 35.6233
2011-2012 Obese 57.5303
2011-2012 Overweight 41.99084
2013-2014 Obese 58.32048
2013-2014 Overweight 40.19653
')</code>

<code>trend %>% 
  ggplot(aes(year, weightloss, fill = bmi, group = bmi)) +
  geom_line(color = &quot;black&quot;, size = 0.3) +
  geom_point(colour=&quot;black&quot;, pch=21, size = 3) +
  theme(text = element_text(family = &quot;serif&quot;, size = 11), legend.position=&quot;bottom&quot;) +
  scale_fill_jama() +
  theme_hc() +
  labs(
    title = &quot;Trends of 'trying to lose weight' in the United States&quot;,
    caption = &quot;NHANES 1999-2014 survey\ndatascienceplus.com&quot;,
    x = &quot;Survey Cycle Years&quot;,
    y = &quot;Percentage, %&quot;,
    fill = &quot;&quot;
    ) +
  scale_y_continuous(limits=c(30,80), breaks=seq(30,80, by = 10))
</code></pre>
<p>Gives this plot:<br>
<a rel="nofollow" href="https://i2.wp.com/datascienceplus.com/wp-content/uploads/2018/07/unnamed-chunk-8-1-1.png?ssl=1" target="_blank"><img sizes="(max-width: 490px) 100vw, 490px" src="https://i2.wp.com/datascienceplus.com/wp-content/uploads/2018/07/unnamed-chunk-8-1-1-490x490.png?w=450&ssl=1" alt="" class="wp-image-15675" data-recalc-dims="1"></a></p>
<p>There is a small increasing trend to lose weight in people with obesity in recent years.</p>
<h3>Logistic Regression</h3>
<p>A logistic regression model with <em>Poisson</em> distribution is used to evaluate the odds of intention to lose weight <code>tryweloss</code> in different time periods. In this analysis, several confounders were considered such as BMI status, gender, age, family income, and race.</p>
<pre><code>mylogit &lt;- glm(tryweloss2 ~ wave + bmi + RIAGENDR + RIDAGEYR + INDFMINC + race,
  data = dat,
  family = &quot;poisson&quot;)
summary(mylogit)</code>
<em>## ## Call:
## glm(formula = tryweloss2 ~ wave + bmi + RIAGENDR + RIDAGEYR + ## INDFMINC + race, family = &quot;poisson&quot;, data = dat)
## ## Deviance Residuals: ## Min 1Q Median 3Q Max ## -1.2590 -0.9171 -0.7429 0.6490 1.1270 ## ## Coefficients:
## Estimate Std. Error z value Pr(>|z|) ## (Intercept) -1.2545203 0.0886399 -14.153 &lt; 2e-16 ***
## wave2001-2002 0.0028610 0.0553019 0.052 0.95874 ## wave2003-2004 0.0277646 0.0562594 0.494 0.62165 ## wave2009-2010 -0.0434281 0.0519876 -0.835 0.40352 ## wave2011-2012 0.0377786 0.0539726 0.700 0.48395 ## wave2013-2014 0.0929779 0.0523326 1.777 0.07562 . ## bmiOverweight -0.3519162 0.0306745 -11.473 &lt; 2e-16 ***
## RIAGENDR 0.4184619 0.0303948 13.768 &lt; 2e-16 ***
## RIDAGEYR -0.0028538 0.0013459 -2.120 0.03398 * ## INDFMINC 0.0008816 0.0010161 0.868 0.38559 ## raceHispanic 0.0847514 0.0584763 1.449 0.14725 ## raceNon-Hispanic, White 0.1199298 0.0387668 3.094 0.00198 ** ## raceNon-Hispanic, Black -0.0016056 0.0436180 -0.037 0.97064 ## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## ## (Dispersion parameter for poisson family taken to be 1)
## ## Null deviance: 7330.3 on 10232 degrees of freedom
## Residual deviance: 6923.2 on 10220 degrees of freedom
## (88 observations deleted due to missingness)
## AIC: 16273
## ## Number of Fisher Scoring iterations: 5
</em></pre>
<p>The results show that there are no significant odds (p>0.05) on the intention to lose weight when I compare different periods to 1999-2000. The small sample size could explain these findings for each survey.</p>
<p>However, let me get the exponential of these coefficients and confidence intervals.</p>
<pre><code>exp(coef(mylogit))</code>
<em>## (Intercept) wave2001-2002 wave2003-2004 ## 0.2852126 1.0028651 1.0281537 ## wave2009-2010 wave2011-2012 wave2013-2014 ## 0.9575014 1.0385013 1.0974375 ## bmiOverweight RIAGENDR RIDAGEYR ## 0.7033391 1.5196224 0.9971503 ## INDFMINC raceHispanic raceNon-Hispanic, White ## 1.0008820 1.0884464 1.1274177 ## raceNon-Hispanic, Black ## 0.9983957
</em></pre>
<pre><code>exp(confint(mylogit))</code>
<em>## 2.5 % 97.5 %
## (Intercept) 0.2395745 0.3391149
## wave2001-2002 0.8999514 1.1178640
## wave2003-2004 0.9208583 1.1481368
## wave2009-2010 0.8650406 1.0606215
## wave2011-2012 0.9344651 1.1546960
## wave2013-2014 0.9907765 1.2164297
## bmiOverweight 0.6622089 0.7468264
## RIAGENDR 1.4318982 1.6130974
## RIDAGEYR 0.9945248 0.9997859
## INDFMINC 0.9988443 1.0028327
## raceHispanic 0.9697129 1.2196128
## raceNon-Hispanic, White 1.0452581 1.2168270
## raceNon-Hispanic, Black 0.9166538 1.0876073
</em></pre>
<p>The odds ratio and 95% confidence intervals (95%CI) of losing weight in the period 2013-2014 is 1.10 (95% CI 0.99-1.22) compare to 1999-2000. The odds ratio (95%CI) of losing weight in overweight compared to obese individuals is significantly lower 0.70 (95% CI 0.66-0.75) indicating that obese individuals are trying more to lose weight than overweight (as we can expect).</p>
<p>My results were different from the paper published in JAMA. There are some differences from this analysis compared to the article. My reference is the period 1999-2000, whereas in the paper is 1988-1994. Moreover, I excluded pregnant women, when the paper keeps those in the analysis.</p>
<ul></ul>
<p><strong>
<p>Related Post</p>
<p></p></strong>
<ol>
<li><a rel="nofollow" href="https://datascienceplus.com/machine-learning-results-in-r-one-plot-to-rule-them-all-part-2-regression-models/" title="Permanent Link toMachine Learning Results in R: one plot to rule them all! (Part 2 – Regression Models)" target="_blank">Machine Learning Results in R: one plot to rule them all! (Part 2 – Regression Models)</a></li>
<li><a rel="nofollow" href="https://datascienceplus.com/story-of-pairs-ggpairs-and-the-linear-regression/" title="Permanent Link toStory of pairs, ggpairs, and the linear regression" target="_blank">Story of pairs, ggpairs, and the linear regression</a></li>
<li><a rel="nofollow" href="https://datascienceplus.com/extract-fred-data-for-ols-regression-analysis-a-complete-tutorial/" title="Permanent Link toExtract FRED Data for OLS Regression Analysis: A Complete R Tutorial" target="_blank">Extract FRED Data for OLS Regression Analysis: A Complete R Tutorial</a></li>
<li><a rel="nofollow" href="https://datascienceplus.com/mnist-for-machine-learning-beginners-with-softmax-regression/" title="Permanent Link toMNIST For Machine Learning Beginners With Softmax Regression" target="_blank">MNIST For Machine Learning Beginners With Softmax Regression</a></li>
<li><a rel="nofollow" href="https://datascienceplus.com/time-dependent-roc-for-survival-prediction-models-in-r/" title="Permanent Link toTime-dependent ROC for Survival Prediction Models in R" target="_blank">Time-dependent ROC for Survival Prediction Models in R</a></li>
</ol>
	<p>
<div>
<div>To <strong>leave a comment</strong> for the author, please follow the link and comment on their blog: <strong><a href="https://datascienceplus.com/weight-loss-in-the-u-s-an-analysis-of-nhanes-data-with-tidyverse/"> R Programming – DataScience+</a></strong>.</div>
<hr>
<a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers.com</a> offers <strong><a rel="nofollow" href="https://feedburner.google.com/fb/a/mailverify?uri=RBloggers">daily e-mail updates</a></strong> about <a rel="nofollow" href="https://www.r-project.org/" title="The R Project for Statistical Computing">R</a> news and <a rel="nofollow" href="https://www.r-bloggers.com/search/tutorial" title="R tutorials">tutorials</a> on topics such as: <a rel="nofollow" href="https://www.r-bloggers.com/search/data%20science" title="Data science">Data science</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/Big%20Data" title="Big Data">Big Data, <a rel="nofollow" href="https://www.r-users.com/" title="R jobs">R jobs</a>, visualization (<a rel="nofollow" href="https://www.r-bloggers.com/search/ggplot2" title="ggplot and ggplot2 tutorials">ggplot2</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/boxplot" title="Boxplots using lattice and ggplot2 tutorials">Boxplots</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/map" title="Maps and gis">maps</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/animation" title="Animation in R">animation</a>), programming (<a rel="nofollow" href="https://www.r-bloggers.com/search/RStudio" title="RStudio IDE for R">RStudio</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/sweave" title="Sweave and literate programming">Sweave</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/LaTeX" title="LaTeX in R">LaTeX</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/SQL" title="SQL and databases">SQL</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/eclipse" title="Eclipse IDE for R">Eclipse</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/git" title="git and github, Version Control System">git</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/hadoop" title="Large data in R using Hadoop">hadoop</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/Web+Scraping" title="Web Scraping of google, facebook, yahoo, twitter and more using R">Web Scraping</a>) statistics (<a rel="nofollow" href="https://www.r-bloggers.com/search/regression" title="Regressions and ANOVA analysis tutorials">regression</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/PCA" title="principal component analysis tutorial">PCA</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/time+series" title="Time series">time series</a>, <a rel="nofollow" href="https://www.r-bloggers.com/search/trading" title="finance trading">trading</a>) and more...
<img width="1" alt="" src="http://feeds.feedburner.com/~r/RBloggers/~4/mYa2zZpCrrI" height="1"></a></div>