These simple linear regression lines plot the y-axis variable (nutrient density) vs. the x-axis variable (price). By visualizing these relationships, we can better understand the feasibility of achieving a nutritious yet affordable diet. The graphs also include the R-Squared (R2), which indicate how well the models fit the data.
In collaboration with researchers from Tufts University, Duke University and Penn State University, this interactive tool is part of the research project “From Scarcity to Prosperity: How Nutrition/Cost Tradeoffs Influence Consumer Choices and the Food System.” The data used in this dashboard are sourced from the 2013/2014 National Health and Nutrition Examination Survey (NHANES) and the USDA/ERS Purchase-To-Plate Price Data Tool, and represents the consumption behaviors of women between 20-50 years old in the US. By harnessing insights from these interactive scatter plots, we can further understand the relationship between nutrient density and price, in turn, allowing us to achieve a more nutritional and affordable diet. Direct any questions to Dr. Norbert Wilson at nwilson@div.duke.edu or Aidan Gildea at aidan.gildea@duke.edu.
---
title: "Nutrient Dashboard"
output:
flexdashboard::flex_dashboard:
orientation: rows
social: menu
source_code: embed
---
```{r setup, include=FALSE}
library(haven)
library(ggplot2)
library(stringr)
library(dplyr)
library(plotly)
library(plyr)
library(flexdashboard)
library(viridis)
library(vembedr)
library(ggpubr)
```
```{r data}
# categ <- read_dta(file = "ByCateg_v5.dta")
categ <- read_dta(file = "ByCateg_women20-50.dta")
categfull <- categ %>%
mutate(broadcateg_name = case_when(
str_detect(categ_des, "Bean") ~ "Plant Protein",
str_detect(categ_des, "Nut") ~ "Plant Protein",
str_detect(categ_des, "Soy products") ~ "Plant Protein",
broadcateg_name == "Protein" ~ "Animal Protein",
broadcateg_name == "Mixed" ~ "Mixed Dishes",
# categ_name == "Steak" ~ "Animal Protein",
TRUE ~ broadcateg_name))
#filter(!str_detect(categ_name, "Baby")) %>%
# filter(!str_detect(categ_name, "Alcohol"))
```
All
=======================================================================
Row {data-width = 200}
-----------------------------------------------------------------------
### Finding Affordable Sources of Protein
```{r pro, error=FALSE, message=FALSE, warning=FALSE}
# Legend
leg <- list(
bordercolor = "#E2E2E2",
borderwidth = 0.5)
# Protein
protplot <- plot_ly(
categfull, x = ~price, y = ~prot,
alpha = 0.7,
hoverinfo = "text",
# Hover text:
text = ~paste0("", categ_des, "
", "ie: ", categ_eg, "
Daily Spending/Capita: ", round(spend, 3), "
Protein(gm)/1000kcal: ", round(prot, 3), "
Price($)/1000kcal: ", round(price, 3)),
color = ~broadcateg_name, size = ~spend,
type = "scatter",
mode = "markers"
)
protplot <- protplot %>%
layout(title = "Protein",
xaxis = list(title = "Price($)/1000kcal"), yaxis = list(title = "Protein(gm)/1000kcal"),
margin = list(l = 123), legend = leg,
margin = list(b=150), ##right margin in pixels
annotations =
list(list(x = 1.38, y = -.1, #position of text adjust as needed
text = "*Datapoint size\n reflects food item's\n daily spending per capita",
showarrow = F, xref='paper', yref='paper',
xanchor='right', yanchor='auto', xshift=0, yshift=0,
font=list(size=10, color="grey")),
list(x = .1, y = -.185, #position of text adjust as needed
text = "NHANES 2013/2014,\n USDA/ERS Purchase-To-Plate\n Price Data Tool",
showarrow = F, xref='paper', yref='paper',
xanchor='right', yanchor='auto', xshift=0, yshift=0,
font=list(size=10, color="grey"))))
protplot
```
### Finding Affordable Sources of Fiber
```{r fibe, error=FALSE, message=FALSE, warning=FALSE}
# Legend
leg1 <- list(
bordercolor = "#E2E2E2",
borderwidth = 0.5)
# Fiber
fibeplot <- plot_ly(
categfull, x = ~price, y = ~fibe,
alpha = 0.7,
hoverinfo = "text",
# Hover text:
text = ~paste0("", categ_des, "
", "ie: ", categ_eg, "
Daily Spending/Capita: ", round(spend, 3), "
Fiber(gm)/1000kcal: ", round(fibe, 3), "
Price($)/1000kcal: ", round(price, 3)),
color = ~broadcateg_name, size = ~spend,
type = "scatter",
mode = "markers"
)
fibeplot <- fibeplot %>%
layout(title = "Fiber",
xaxis = list(title = "Price($)/1000kcal"), yaxis = list(title = "Fiber(gm)/1000kcal"),
margin = list(l = 123), legend = leg1, margin = list(b=150) ##right margin in pixels
# annotations =
# list(list(x = 1.48, y = -.01, #position of text adjust as needed
#text = "*Datapoint size reflects \n food category's total \ndaily spending",
# showarrow = F, xref='paper', yref='paper',
# xanchor='right', yanchor='auto', xshift=0, yshift=0,
#font=list(size=10, color="grey")) #,
#list(x =1.53, y = -.21, #position of text adjust as needed
#text = "Source: NHANES 2013/2014,\n USDA/ERS Purchase-To-Plate
#Price Data Tool",
# showarrow = F, xref='paper', yref='paper',
#xanchor='right', yanchor='auto', xshift=0, yshift=0,
#font=list(size=10, color="grey")))
)
fibeplot
```
Row {data-width = 200}
-----------------------------------------------------------------------
### Finding Affordable Sources of Added Sugar
```{r sug, error=FALSE, message=FALSE, warning=FALSE}
# Legend
leg1 <- list(
bordercolor = "#E2E2E2",
borderwidth = 0.5)
# Sugar
sugplot <- plot_ly(
categfull, x = ~price, y = ~sugr,
alpha = 0.7,
hoverinfo = "text",
# Hover text:
text = ~paste0("", categ_des, "
", "ie: ", categ_eg, "
Daily Spending/Capita: ", round(spend, 3),
"
Sugar(gm)/1000kcal: ", round(sugr, 3), "
Price($)/1000kcal: ", round(price, 3)),
color = ~broadcateg_name, size = ~spend,
type = "scatter",
mode = "markers")
sugplot <- sugplot %>%
layout(title = "Added Sugar",
xaxis = list(title = "Price($)/1000kcal"), yaxis = list(title = "Added Sugar(gm)/1000kcal"),
margin = list(l = 123), legend = leg1, margin = list(b=150) ##right margin in pixels
# annotations =
# list(list(x = 1.48, y = -.01, #position of text adjust as needed
#text = "*Datapoint size reflects \n food category's total \ndaily spending",
# showarrow = F, xref='paper', yref='paper',
# xanchor='right', yanchor='auto', xshift=0, yshift=0,
#font=list(size=10, color="grey")) #,
#list(x =1.53, y = -.21, #position of text adjust as needed
#text = "Source: NHANES 2013/2014,\n USDA/ERS Purchase-To-Plate
#Price Data Tool",
# showarrow = F, xref='paper', yref='paper',
#xanchor='right', yanchor='auto', xshift=0, yshift=0,
#font=list(size=10, color="grey")))
)
sugplot
```
### Finding Affordable Sources of Sodium
```{r sd, error=FALSE, message=FALSE, warning=FALSE}
# Legend
leg1 <- list(
bordercolor = "#E2E2E2",
borderwidth = 0.5)
# Sodium
sodplot <- plot_ly(
categfull, x = ~price, y = ~sodi,
alpha = 0.7,
hoverinfo = "text",
# Hover text:
text = ~paste0("", categ_des, "
", "ie: ", categ_eg, "
Daily Spending/Capita: ", round(spend, 3), "
Sodium(mg)/1000kcal: ", round(sodi, 3), "
Price($)/1000kcal: ", round(price, 3)),
color = ~broadcateg_name, size = ~spend,
type = "scatter",
mode = "markers"
)
sodplot <- sodplot %>%
layout(title = "Sodium",
xaxis = list(title = "Price($)/1000kcal"), yaxis = list(title = "Sodium(mg)/1000kcal"),
margin = list(l = 123), legend = leg1, margin = list(b=150) ##right margin in pixels
# annotations =
# list(list(x = 1.48, y = -.01, #position of text adjust as needed
#text = "*Datapoint size reflects \n food category's total \ndaily spending",
# showarrow = F, xref='paper', yref='paper',
# xanchor='right', yanchor='auto', xshift=0, yshift=0,
#font=list(size=10, color="grey")) #,
#list(x =1.53, y = -.21, #position of text adjust as needed
#text = "Source: NHANES 2013/2014,\n USDA/ERS Purchase-To-Plate
#Price Data Tool",
# showarrow = F, xref='paper', yref='paper',
#xanchor='right', yanchor='auto', xshift=0, yshift=0,
#font=list(size=10, color="grey")))
)
sodplot
```
Protein
=======================================================================
```{r protein2}
protplot %>%
layout(margin = list(l = 123), legend = leg1, margin = list(b=150)
# annotations =
# list(list(x = 1.19, y = -0.07, #position of text adjust as needed
# text = "*Datapoint size reflects food\n item's daily spending per capita",
# showarrow = F, xref='paper', yref='paper',
# xanchor='right', yanchor='auto', xshift=0, yshift=0,
# font=list(size=13, color="grey")),
# list(x = .1, y = -.079, #position of text adjust as needed
# text = "NHANES 2013/2014, USDA/ERS\n Purchase-To-Plate Price Data Tool",
# showarrow = F, xref='paper', yref='paper',
# xanchor='right', yanchor='auto', xshift=0, yshift=0,
# font=list(size=12, color="grey")))
)
```
Fiber
=======================================================================
```{r fiber2}
fibeplot %>%
layout( margin = list(l = 123), legend = leg1, margin = list(b=150)
# annotations =
# list(list(x = 1.19, y = -0.07, #position of text adjust as needed
# text = "*Datapoint size reflects food\n item's daily spending per capita",
# showarrow = F, xref='paper', yref='paper',
# xanchor='right', yanchor='auto', xshift=0, yshift=0,
# font=list(size=13, color="grey")),
# list(x = .1, y = -.079, #position of text adjust as needed
# text = "NHANES 2013/2014, USDA/ERS\n Purchase-To-Plate Price Data Tool",
# showarrow = F, xref='paper', yref='paper',
# xanchor='right', yanchor='auto', xshift=0, yshift=0,
# font=list(size=12, color="grey")))
)
```
Added Sugar
=======================================================================
```{r sugar2}
sugplot %>%
layout( margin = list(l = 123), legend = leg1, margin = list(b=150)
# annotations =
# list(list(x = 1.19, y = -0.07, #position of text adjust as needed
# text = "*Datapoint size reflects food\n item's daily spending per capita",
# showarrow = F, xref='paper', yref='paper',
# xanchor='right', yanchor='auto', xshift=0, yshift=0,
# font=list(size=13, color="grey")),
# list(x = .1, y = -.079, #position of text adjust as needed
# text = "NHANES 2013/2014, USDA/ERS\n Purchase-To-Plate Price Data Tool",
# showarrow = F, xref='paper', yref='paper',
# xanchor='right', yanchor='auto', xshift=0, yshift=0,
# font=list(size=12, color="grey")))
)
```
Sodium
=======================================================================
```{r sodium2}
sodplot %>%
layout( margin = list(l = 123), legend = leg1, margin = list(b=150)
# annotations =
# list(list(x = 1.19, y = -0.07, #position of text adjust as needed
# text = "*Datapoint size reflects food\n item's daily spending per capita",
# showarrow = F, xref='paper', yref='paper',
# xanchor='right', yanchor='auto', xshift=0, yshift=0,
# font=list(size=13, color="grey")),
# list(x = .1, y = -.079, #position of text adjust as needed
# text = "NHANES 2013/2014, USDA/ERS\n Purchase-To-Plate Price Data Tool",
# showarrow = F, xref='paper', yref='paper',
# xanchor='right', yanchor='auto', xshift=0, yshift=0,
# font=list(size=12, color="grey")))
)
```
Models
=======================================================================
These simple linear regression lines plot the y-axis variable (nutrient
density) vs. the x-axis variable (price). By visualizing these relationships, we
can better understand the feasibility of achieving a nutritious yet affordable
diet. The graphs also include the R-Squared (R2), which indicate how well the
models fit the data.
Row {data-width = 200}
-----------------------------------------------------------------------
### Protein
```{r protein gg}
protlm <- lm(categfull$prot ~ categfull$price)
protsq <- glance(protlm) %>%
select(r.squared)
protgg <- ggplot(data = categfull, mapping = aes(x = price, y = prot)) +
geom_point(aes(color = broadcateg_name, size = spend),
alpha = 0.5) +
labs(
title = "Protein",
x = "Price($)/1000 kcal", y = "Protein(gm)/1000 kcal") +
geom_smooth(method = "lm", se = TRUE) +
geom_text(aes(2.5, 38, label = paste("R2 = ", round(protsq, 3)))) +
scale_size(guide = 'none') +
scale_color_discrete(name = "Food Category")
ggplotly(protgg, tooltip="none")
```
### Sodium
```{r sodium gg}
sodlm <- lm(categfull$sodi ~ categfull$price)
sodsq <- glance(sodlm) %>%
select(r.squared)
sodgg<- ggplot(data = categfull, mapping = aes(x = price, y = sodi)) +
geom_point(aes(color = broadcateg_name, size = spend),
alpha = 0.5) +
labs(title = "Sodium", x = "Price($)/1000 kcal",
y = "Sodium(mg)/1000 kcal") +
geom_smooth(method = "lm", se = TRUE) +
geom_text(aes(3, 45, label = paste("R2 = ", round(sodsq, 3)))) +
scale_size(guide = 'none') +
scale_color_discrete(name = "Food Category")
ggplotly(sodgg, tooltip="none")
```
Row {data-width = 200}
-----------------------------------------------------------------------
### Sugar
```{r added sugar}
suglm <- lm(categfull$sugr ~ categfull$price)
sugsq <- glance(suglm) %>%
select(r.squared)
suggg <- ggplot(data = categfull, mapping = aes(x = price, y = sugr)) +
geom_point(aes(color = broadcateg_name, size = spend),
alpha = 0.5) +
labs(title = "Added Sugar", x = "Price($)/1000 kcal",
y = "Added Sugar(gm)/1000 kcal") +
geom_smooth(method = "lm", se = TRUE) +
geom_text(aes(2.5, 38, label = paste("R2 = ", round(sugsq, 3)))) +
scale_size(guide = 'none') +
scale_color_discrete(name = "Food Category")
ggplotly(suggg, tooltip="none")
```
### Fiber
```{r fiber}
fibelm <- lm(categfull$fibe ~ categfull$price)
fibesq <- glance(fibelm) %>%
select(r.squared)
fibegg <- ggplot(data = categfull, mapping = aes(x = price, y = fibe)) +
geom_point(aes(color = broadcateg_name, size = spend),
alpha = 0.5) +
labs(title = "Fiber", x = "Price($)/1000 kcal",
y = "Fiber(mg)/1000 kcal") +
geom_smooth(method = "lm", se = TRUE) +
geom_text(aes(2.5, 38, label = paste("R2 = ", round(fibesq, 3)))) +
scale_size(guide = 'none') +
scale_color_discrete(name = "Food Category")
ggplotly(fibegg, tooltip="none")
```
Tutorial
=======================================================================
### Tutorial Video
```{r video}
embed_youtube(
"sG0h8y6q6Eg",
width = NULL,
height = 450,
ratio = c("16by9", "4by3"),
frameborder = 0,
allowfullscreen = TRUE,
query = NULL
)
```
Row {data-height=200}
-------------------------------------
### About This Interactive Tool
In collaboration with researchers from Tufts University, Duke University and
Penn State University, this interactive tool is part of the research project
"From Scarcity to Prosperity: How Nutrition/Cost Tradeoffs Influence Consumer
Choices and the Food System." The data used in this dashboard are sourced from the 2013/2014 National Health and Nutrition Examination Survey (NHANES) and the USDA/ERS Purchase-To-Plate Price Data Tool, and represents the consumption behaviors of women between 20-50 years old in the US. By harnessing insights from these interactive scatter plots, we can further understand the relationship between nutrient density and price, in turn, allowing us to achieve a more nutritional and affordable diet. Direct any questions to Dr. Norbert Wilson at nwilson@div.duke.edu or Aidan Gildea at aidan.gildea@duke.edu.