---
title: ""
format:
html:
embed-resources: true
smooth-scroll: true
toc: false
page-layout: full
tbl-cap-location: bottom
code-tools: true
---
```{r}
#| echo: false
#| output: false
#| warning: false
load("unichild.RData") #the data-set obtained from https://mics.unicef.org/surveys, file named "ch.sav" was cleaned and stored in the RData format
library(tidyverse)
library(anthro) # WHO library to calculate zscore
library(patchwork)
library(ggtext)
library(cowplot)
library(tidyquant)
library(gt)
library(janitor)
# data object to store required variable for anthropometric malnutrition indicators
unicef_ch |>
as.data.frame() |>
select(AN4, 27:30, 11:13, 408, 392, 409, 410, 435, 401, 406, 419:423, 424, 429:430, 438, CAGE, HH6) |> # variable were chosen after examining labels of column names
rename("age_days" = "CAGED",
"age_years" = "AN4",
"gender" = "HL4",
"province" = "HH7c",
"height(cm)" = "AN11",
"age_month" = "CAGE",
"area" = "HH6",
`Maternal Education` = "melevel1",
`Wealth Quantile` = "windex5",
`Age of Child` = "CAGE_6"
) |>
mutate(zscore_stnt = as.numeric(as.character(HAZ2)),
zscore_wasting = as.numeric(as.character(WHZ2)),
zscore_overweight = as.numeric(as.character(ZBMI)),
zscore_underweight = as.numeric(as.character(WAZ2)),
bmi = as.numeric(as.character(BMI))
) -> anthro_indicator
levels(anthro_indicator$province)[1] <- "Koshi Province"
levels(anthro_indicator$province)[2] <- "Madhesh Province"
levels(anthro_indicator$province)[5] <- "Lumbini Province"
# Function to create gauge chart (pie chart for anthropemtric malnutrition indicator)
pie_chart <- function(indicator, clr) {
anthro_indicator |>
mutate(var = case_when( #choose specific column based on the argument "indicator"
indicator == "stunted" ~ zscore_stnt,
indicator == "wasted" ~ zscore_wasting,
indicator == "overweight" ~ zscore_overweight,
indicator == "underweight" ~ zscore_underweight
)) |>
filter(!is.na(var)) |>
mutate(age = round(age_days/30,0)) |>
mutate(test = ifelse(indicator == "overweight", TRUE, FALSE)) |> # TRUE in case of calculation required for 'overweight'
mutate(category = if_else(test == FALSE,
case_when(
var < -2 ~ indicator # in case of 3 anthropometric indicator other than overweight the condition (such as stunting) is defined if the zscore is less than neg 2 SD
),
case_when(
var > 2 ~ indicator # in case of overweight
))) |>
mutate(category = ifelse(is.na(category), "normal", category)) |> # mark normal condition
count(category) |>
mutate(proportion = round(n/sum(n),3)) |>
arrange(n) |>
mutate(ymax = cumsum(proportion)) |> #required for plotting donut chart out from geom_rect() in ggplot2
mutate(sn = row_number(), .before = "category") %>%
mutate(sn = as.character(sn) ) |>
mutate(ymin = ifelse( # required for plotting geom_rect()
sn == 1,
0,
lag(ymax)
)) |>
mutate(lp = (ymax+ymin)/2, #position of label in chart
lbl = paste(round(proportion*100,2), "%", sep = "")) |> #character which would be used as label in the chart
ggplot(aes(
ymax = ymax,
ymin = ymin,
xmax = 4,
xmin = 2,
fill = category
)) +
geom_rect(linewidth = 2, # linewidth handles the thickness of border of the donut chart
color = "white") +
geom_text(x=3, aes(y=lp, label= ifelse(category != "normal", lbl, "")), #omit labeling normal category
size=5,
color = "black") +
coord_polar(theta = "y") + #convert the chart to radian ie to pie/donut chart
xlim(c(0,4)) + # determine thickness of the donut chart
scale_fill_manual(values=c("lightgray",clr))+ # for this chart only two types of categories are assumed
labs(caption = str_wrap(paste("Percentage children under-5 who are",indicator, sep = " "),
width = 32)
)+
theme_void() +
theme(
legend.position = "none",
plot.caption = element_text(
size = 11,
hjust = 0.5,
family = "Times New Roman"
))
}
# Function to plot (draw) text for each indicator; the function has two arguments the heading (also the indicator) and the text describing it
desc_pie <- function(indicator, description) {
ggdraw() +
draw_label(
indicator,
x =0.1, y = 0.9,
color = "#555755",
fontfamily = "Times New Roman",
size = 20,
fontface = "bold",
hjust = 0 ) +
draw_label(
stringr::str_wrap(description, width = 42, #wraps the text into fixed lenght
exdent =0),
x = 0.1,
y = 0.4,
size = 13,
hjust = 0,
vjust = 1,
fontfamily = "Times New Roman"
)
}
```
## Anthropometric Malnutrition Indicators - Nepal MICS6
::: columns
::: {.column width="48%"}
```{r stunted}
#| echo: false
desc_pie("Stunting: SDG 2.2.1",
paste(
"Stuntingrefers to a child who is too short for his or her age. Stunting is the failure to grow both physically and congnitively and is the result of chronic or recurrent malnutrition.")
) +
pie_chart("stunted", "#54bcbf")
```
:::
::: {.column width="48%"}
```{r}
#| echo: false
desc_pie("Wasting: SDG 2.2.2",
paste(
"Wasting refers to a child who is too thin for his or her weight. Wasting, or acute malnutrition, is the result of recent rapid weight loss or the failure to gain weight. A child who is moderately or severly wasted has an increased risk of death, but treatment is possible.")
) +
pie_chart("wasted", "#d64520")
```
:::
:::
::: {columns}
::: {.column width="48%"}
```{r}
#| echo: false
#| warning: false
desc_pie("Overweight: SDG 2.2.2",
paste(
"Overweight refers to a child who is too heavy for his or her height. This form of malnutrition results from expending too few calories for the amount consumed from food and drinks and increases the risk of noncommunicable diseases later in life.")
) +
pie_chart("overweight", "purple")
```
:::
::: {.column width="48%"}
```{r}
#| echo: false
#| warning: false
desc_pie("Underweight",
paste(
"Underweight is a composite form of undernutrition that can include elements of stunting and wasting (ie an underweight child can have a reduced weight for their age due to being too short for their age and/or being too thin for their height).")
) +
pie_chart("underweight", "orange")
```
:::
:::
```{r}
#| echo: false
#| warning: false
anthro_indicator |>
as.data.frame() |>
select(age_month, zscore_stnt, zscore_wasting, zscore_underweight, zscore_overweight) |>
pivot_longer(2:5) |>
filter(!is.na(value)) |>
mutate(direction = ifelse(name == "zscore_overweight", "2", "-2")) |>
mutate(test = ifelse(direction == "2",
case_when(
value > 2 ~ T),
case_when(
value < -2 ~ T
)
)) |>
count(age_month, name, test) |>
group_by(age_month, name ) |>
mutate(p = round(n/sum(n)*100,2)) |>
ungroup() |>
filter(test == T) |>
ggplot(aes(
x = age_month,
y = p,
fill = name
)) +
geom_col() +
scale_fill_manual(values = c("purple", "#54bcbf","orange", "#d64520"))+
geom_hline(yintercept = 0)+
theme_minimal(base_size = 12, base_family = 'Times New Roman') +
facet_wrap(~factor(name, c("zscore_stnt",
"zscore_overweight",
"zscore_wasting",
"zscore_underweight")),
labeller = as_labeller(
c("zscore_stnt" = "Stunting",
"zscore_overweight" = "Overweight",
"zscore_wasting" = "Wasting",
"zscore_underweight"="Underweight")),
nrow =1 ) +
coord_flip() +
labs(x = "Age in months",
y = "Percent",
title = "<b> Anthropometric Malnutrition Indicators by Age </b>",
caption = "<b>Percent of children who are stunted, underweight, wasted and overweight by age in months </b>")+
theme(
panel.grid.minor = element_blank(),
panel.grid.major.y = element_blank(),
legend.position = "none",
plot.title = element_markdown(
hjust = 0.5
),
plot.caption = element_markdown(
hjust = 0,
size = 6
),
axis.title = element_text(
size = 8
)
)
```
## National Status of Children: Disaggregates
::: {columns}
::: {.column width="48%"}
```{r}
#| echo: false
anthro_indicator |>
select(age_days, province, zscore_stnt, area, `Maternal Education`,`Wealth Quantile`, `Age of Child`) |>
mutate(Stunting = as.numeric(as.character(zscore_stnt))) |>
filter(!is.na(Stunting)) |>
filter(`Maternal Education` != "Missing/DK") |>
mutate(category = case_when(
Stunting < -2 ~ "stunted"
)) |>
mutate(category = ifelse(is.na(category), "normal", category)) |>
pivot_longer(cols = c(2,4,5,6,7)) |>
select(4:6) |>
group_by_all() |>
summarise(total = n(),
.groups = "drop") |>
group_by(name,value) |>
mutate(p = total/sum(total)*100) |>
filter(category == "stunted") |>
select(-category) |>
ungroup() -> nationa_dis
nationa_dis |>
group_by(name) |>
mutate(max = max(p),
min = min(p)) |>
mutate(max_name = value[p ==max],
min_name = value[p == min]
) |>
ungroup() |>
data.frame() |>
select(1, 5:8) |>
distinct() |>
ggplot(aes(x = name,
y = max)) +
geom_segment(
aes(
x = name,
y = max,
xend = name,
yend = min,
group = name
),
linewidth = 7,
color = "#54debf",
alpha = 0.3
) +
geom_hline(yintercept = 32.4,
linetype = "dotted",
color = "red3"
)+
geom_point(size = 5,
fill = "#54bcbf",
color = "#54bcbf",
shape = 21,
stroke =2)+
geom_text(aes(
label = paste(round(max, 2), "%", sep="")
),
nudge_x = -0.3,
size = 3
)+
geom_text(aes(
label = word(max_name,1)
),
nudge_x = 0.3,
hjust = 0.5,
size = 3
) +
geom_point(
aes(x = name,
y = min),
size = 5,
fill = "white",
color = "#54bcbf",
shape = 21,
stroke = 2
) +
geom_text(
aes(x = name,
y = min,
label = paste(round(min,2), "%", sep ="")
),
nudge_x = 0.3,
size = 3
) +
geom_text(aes(x = name,
y = min,
label = word(min_name,1)
),
nudge_x = -0.3,
hjust = 0.5,
size = 3
)+
labs(
x = element_blank(),
y = "percent",
title = "<b> Stunting: SDG 2.2.1",
caption = "<b>Percent of under 5 children who are stunted, by background characteristics</b>"
) +
scale_y_continuous(breaks = seq(from = 10, to = 60, by = 10),
labels = seq(from = 10, to = 60, by = 10)
) +
coord_flip() +
theme_minimal() +
annotate(
"text",
y = 31.5,
x = 3.5,
label = "National Mean",
color = "red3",
family = "Times New Roman",
angle = 90
) +
theme(
#panel.grid.minor = element_blank(),
#panel.grid.major.y = element_blank(),
axis.title = element_text(
size = 7.5,
face = "bold"
),
plot.title = element_markdown(
hjust = -0.4,
size = 20,
family = "Times New Roman"
),
plot.caption = element_markdown(
hjust = -0.6,
size = 8,
family = "Times New Roman"
),
axis.text.x = element_text(
size = 6,
face = "bold"
),
axis.text.y = element_text(
face = "bold",
hjust = 0
)
)
```
:::
::: {.column width="48%"}
```{r}
#| echo: false
#| fig-align: right
anthro_indicator |>
select(age_days, province, zscore_wasting, area, `Maternal Education`,`Wealth Quantile`, `Age of Child`) |>
mutate(Wasting = as.numeric(as.character(zscore_wasting))) |>
filter(!is.na(Wasting)) |>
filter(`Maternal Education` != "Missing/DK") |>
mutate(category = case_when(
Wasting < -2 ~ "wasted"
)) |>
mutate(category = ifelse(is.na(category), "normal", category)) |>
pivot_longer(cols = c(2,4,5,6,7)) |>
select(4:6) |>
group_by_all() |>
summarise(total = n(),
.groups = "drop") |>
group_by(name,value) |>
mutate(p = total/sum(total)*100) |>
filter(category == "wasted") |>
select(-category) |>
ungroup() -> nationa_dis_wasted
nationa_dis_wasted |>
group_by(name) |>
mutate(max = max(p),
min = min(p)) |>
mutate(max_name = value[p ==max],
min_name = value[p == min]
) |>
ungroup() |>
data.frame() |>
select(1, 5:8) |>
distinct() |>
ggplot(aes(x = name,
y = max)) +
geom_segment(
aes(
x = name,
y = max,
xend = name,
yend = min,
group = name
),
linewidth = 7,
color = "#e94520",
alpha = 0.3
) +
geom_hline(yintercept = 12,
linetype = "dotted"
)+
geom_point(size = 5,
fill = "#d64520",
color = "#d64520",
shape = 21,
stroke =2)+
geom_text(aes(
label = paste(round(max, 1), "%", sep="")
),
nudge_x = -0.3,
size = 3,
hjust = 0.3
)+
geom_text(aes(
label = word(max_name,1)
),
nudge_x = 0.3,
hjust = 0.3,
size = 3
) +
geom_point(
aes(x = name,
y = min),
size = 5,
fill = "white",
color = "#d64520",
shape = 21,
stroke = 2
) +
geom_text(
aes(x = name,
y = min,
label = paste(round(min,2), "%", sep ="")
),
nudge_x = 0.3,
size = 3,
vjust = 0
) +
geom_text(aes(x = name,
y = min,
label = word(min_name,1)
),
nudge_x = -0.3,
hjust = 0.5,
size = 3
)+
labs(
x = element_blank(),
y = "percent",
title = "<b> Wasting: SDG 2.2.2",
caption = "<b>Percent of under 5 children who are wasted, by background characteristics</b>"
) +
scale_y_continuous(breaks = seq(from = 5, to = 40, by = 5),
labels = seq(from = 5, to = 40, by = 5)
) +
coord_flip() +
theme_minimal() +
annotate(
"text",
y = 11.7,
x = 3.5,
label = "National Mean",
color = "forestgreen",
family = "Times New Roman",
angle = 90
) +
theme(
#panel.grid.minor = element_blank(),
#panel.grid.major.y = element_blank(),
axis.title = element_text(
size = 7.5,
face = "bold"
),
plot.title = element_markdown(
hjust = -0.4,
size = 20,
family = "Times New Roman"
),
plot.caption = element_markdown(
hjust = -0.6,
size = 8,
family = "Times New Roman"
),
axis.text.x = element_text(
size = 6,
face = "bold"
),
axis.text.y = element_text(
face = "bold",
hjust = 0
)
)
```
:::
:::
<br>
:::{columns}
::: {.column width="48%"}
```{r}
#| echo: false
#| fig-align: right
anthro_indicator |>
select(age_days, province, zscore_underweight, area, `Maternal Education`,`Wealth Quantile`, `Age of Child`) |>
mutate(Underweight = as.numeric(as.character(zscore_underweight))) |>
filter(!is.na(Underweight)) |>
filter(`Maternal Education` != "Missing/DK") |>
mutate(category = case_when(
Underweight < -2 ~ "underweight"
)) |>
mutate(category = ifelse(is.na(category), "normal", category)) |>
pivot_longer(cols = c(2,4,5,6,7)) |>
select(4:6) |>
group_by_all() |>
summarise(total = n(),
.groups = "drop") |>
group_by(name,value) |>
mutate(p = total/sum(total)*100) |>
filter(category == "underweight") |>
select(-category) |>
ungroup() -> nationa_dis_under
nationa_dis_under |>
group_by(name) |>
mutate(max = max(p),
min = min(p)) |>
mutate(max_name = value[p ==max],
min_name = value[p == min]
) |>
ungroup() |>
data.frame() |>
select(1, 5:8) |>
distinct() |>
ggplot(aes(x = name,
y = max)) +
geom_segment(
aes(
x = name,
y = max,
xend = name,
yend = min,
group = name
),
linewidth = 7,
color = "orange",
alpha = 0.3
) +
geom_hline(yintercept = 24.5,
linetype = "dotted"
)+
geom_point(size = 5,
fill = "orange",
color = "orange",
shape = 21,
stroke =2)+
geom_text(aes(
label = paste(round(max, 1), "%", sep="")
),
nudge_x = -0.3,
size = 3,
hjust = 0.3
)+
geom_text(aes(
label = word(max_name,1)
),
nudge_x = 0.3,
hjust = 0.3,
size = 3
) +
geom_point(
aes(x = name,
y = min),
size = 5,
fill = "white",
color = "orange",
shape = 21,
stroke = 2
) +
geom_text(
aes(x = name,
y = min,
label = paste(round(min,2), "%", sep ="")
),
nudge_x = 0.3,
size = 3,
vjust = 0
) +
geom_text(aes(x = name,
y = min,
label = word(min_name,1)
),
nudge_x = -0.3,
hjust = 0.5,
size = 3
)+
labs(
x = element_blank(),
y = "percent",
title = "<b> Underweight",
caption = "<b>Percent of under 5 children who are underweight, by background characteristics</b>"
) +
scale_y_continuous(breaks = seq(from = 5, to = 40, by = 5),
labels = seq(from = 5, to = 40, by = 5)
) +
coord_flip() +
theme_minimal() +
annotate(
"text",
y = 24,
x = 3.5,
label = "National Mean",
color = "red3",
family = "Times New Roman",
angle = 90
) +
theme(
#panel.grid.minor = element_blank(),
#panel.grid.major.y = element_blank(),
axis.title = element_text(
size = 7.5,
face = "bold"
),
plot.title = element_markdown(
hjust = -0.28,
size = 20,
family = "Times New Roman"
),
plot.caption = element_markdown(
hjust = -0.6,
size = 8,
family = "Times New Roman"
),
axis.text.x = element_text(
size = 6,
face = "bold"
),
axis.text.y = element_text(
face = "bold",
hjust = 0
)
)
```
:::
::: {.column width="48%"}
```{r}
#| echo: false
#| fig-align: right
anthro_indicator |>
select(age_days, province, zscore_overweight, area, `Maternal Education`,`Wealth Quantile`, `Age of Child`) |>
mutate(Overweight = as.numeric(as.character(zscore_overweight))) |>
filter(!is.na(Overweight)) |>
filter(`Maternal Education` != "Missing/DK") |>
mutate(category = case_when(
Overweight > 2 ~ "overweight"
)) |>
mutate(category = ifelse(is.na(category), "normal", category)) |>
pivot_longer(cols = c(2,4,5,6,7)) |>
select(4:6) |>
group_by_all() |>
summarise(total = n(),
.groups = "drop") |>
group_by(name,value) |>
mutate(p = total/sum(total)*100) |>
filter(category == "overweight") |>
select(-category) |>
ungroup() -> nationa_dis_over
nationa_dis_over |>
group_by(name) |>
mutate(max = max(p),
min = min(p)) |>
mutate(max_name = value[p ==max],
min_name = value[p == min]
) |>
ungroup() |>
data.frame() |>
select(1, 5:8) |>
distinct() |>
ggplot(aes(x = name,
y = max)) +
geom_segment(
aes(
x = name,
y = max,
xend = name,
yend = min,
group = name
),
linewidth = 7,
color = "#9370db",
alpha = 0.3
) +
geom_hline(yintercept = 3.3,
linetype = "dotted"
)+
geom_point(size = 5,
fill = "purple",
color = "purple",
shape = 21,
stroke =2)+
geom_text(aes(
label = paste(round(max, 1), "%", sep="")
),
nudge_x = -0.3,
size = 3,
hjust = 0.3
)+
geom_text(aes(
label = word(max_name,1)
),
nudge_x = 0.3,
hjust = 0.3,
size = 3
) +
geom_point(
aes(x = name,
y = min),
size = 5,
fill = "white",
color = "purple",
shape = 21,
stroke = 2
) +
geom_text(
aes(x = name,
y = min,
label = paste(round(min,2), "%", sep ="")
),
nudge_x = 0.3,
size = 3,
vjust = 0
) +
geom_text(aes(x = name,
y = min,
label = word(min_name,1)
),
nudge_x = -0.3,
hjust = 0.5,
size = 3
)+
labs(
x = element_blank(),
y = "percent",
title = "<b> Overweight: SDG 2.2.2",
caption = "<b>Percent of under 5 children who are overweight, by background characteristics</b>"
) +
scale_y_continuous(breaks = seq(from = 5, to = 40, by = 5),
labels = seq(from = 5, to = 40, by = 5)
) +
coord_flip() +
theme_minimal() +
annotate(
"text",
y = 3.2,
x = 4.2,
label = "National Mean",
color = "red3",
family = "Times New Roman",
angle = 90
) +
theme(
#panel.grid.minor = element_blank(),
#panel.grid.major.y = element_blank(),
axis.title = element_text(
size = 7.5,
face = "bold"
),
plot.title = element_markdown(
hjust = -0.46,
size = 20,
family = "Times New Roman"
),
plot.caption = element_markdown(
hjust = -0.6,
size = 8,
family = "Times New Roman"
),
axis.text.x = element_text(
size = 6,
face = "bold"
),
axis.text.y = element_text(
face = "bold",
hjust = 0
)
)
```
:::
:::
## Provincial Data on Stunting, Overweight & Wasting
```{r}
#| echo: false
anthro_indicator |>
as.data.frame() |>
select(province, zscore_stnt, zscore_wasting, zscore_underweight, zscore_overweight) |>
mutate(Overweight = as.numeric(as.character(zscore_overweight)),
Stunting = as.numeric(as.character(zscore_stnt)),
Underweight = as.numeric(as.character(zscore_underweight)),
Wasting = as.numeric(as.character(zscore_wasting))) |>
select(1, 6:9) |>
pivot_longer(
2:5
) |>
filter(!is.na(value)) |>
mutate(category = case_when(
name == "Stunting" & value < -2 ~ "Stunted",
name == "Overweight" & value > 2 ~ "Overweight",
name == "Underweight" & value < -2 ~ "Underweight",
name == "Wasting" & (value > -3 & value < -2) ~ "Wasted",
name == "Wasting" & value < -3 ~ "Severe Wasted"
)) |>
mutate(category = ifelse(is.na(category), "normal", category)) |>
group_by(province, name, category) |>
summarise(total = n(),
.groups = "drop") |>
group_by(province, name) |>
mutate(
p = round(total/sum(total)*100,2)
) |>
ungroup() |>
mutate(new = paste(category, name, sep = "-")) |>
select(1, 5,6) |>
spread(new, p) |>
select(1,8, 6, 10, 7, 9) |>
rename(`% stunted (moderate and severe)` = "Stunted-Stunting",
`% overweight (moderate and severe)` = "Overweight-Overweight",
`% wasted (moderate)` = "Wasted-Wasting",
`% wasted (severe)` = "Severe Wasted-Wasting",
`% underweight (moderate and severe)` = "Underweight-Underweight") |>
gt() |>
#opt_table_lines() |>
#opt_table_outline(style = "solid") |>
tab_spanner(
label = md("**Stunting: SDG 2.2.1**"),
columns = `% stunted (moderate and severe)`
) |>
tab_spanner(
label = md("**Overweight: SDG 2.2.2**"),
columns = `% overweight (moderate and severe)`
) |>
tab_spanner(
label = md("**Wasting**"),
columns = contains("wasted"),
gather = T
) |>
tab_spanner(
label = md("**Underweight**"),
columns = contains("underweight"),
gather = T
) |>
tab_style(
style = cell_borders(
sides = "all",
color = "gray",
weight = px(2)),
locations = cells_column_spanners(everything())
) |>
tab_style(
style = cell_borders(
sides = "all",
color = "gray",
weight = px(2)),
locations = cells_column_labels(everything())
) |>
tab_style(
style = cell_borders(
sides = "all",
color = "gray",
weight = px(2)),
locations = cells_body(everything())
) |>
data_color(
columns = c(2:6),
palette = "ggsci::light_green_material") |>
tab_options(column_labels.background.color = "orange")
```
