Every year, millions of children – mostly young girls – have their futures decided for them through child marriage. This isn’t just about numbers in a dataset; it’s about real kids losing their chance to grow, dream, and choose their own paths. While there has been progress, child marriage still happens too often, driven by from poverty and gender power dynamics in societies. Before I worked on this #MakeoverMonday, I wanted to recognize the humanity and pain in this data.
Here’s some more information from UNICEF’s website:
Child marriage refers to any formal marriage or informal union between a child under the age of 18 and an adult or another child. Despite a steady decline in this harmful practice over the past decade, child marriage remains widespread, with approximately one in five girls married in childhood across the globe. Today, multiple crises – including conflict, climate shocks and the ongoing fallout from COVID-19 – are threatening to reverse progress towards eliminating this human rights violation. The United Nations Sustainable Development Goals call for global action to end child marriage by 2030.
Now, here’s the original plot for #MakeoverMonday
My alternative plots
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
tidyverse,
tidytuesdayR,
dlookr,
ggtext,
gt,
gtExtras, #for font awesome icons in gt tables
ggbump,
ggalt,
hrbrthemes,
countrycode,
showtext,
janitor, #for clean_names()
scales,
htmltools, #for tagList()
glue,
here,
geomtextpath
)
font_add_google('Lato')mm_year <- 2020
mm_week <- 39
df <- read.csv("https://query.data.world/s/qss24rzobvbkg6gc7y7lzfn75c4b46",
header=TRUE, stringsAsFactors=FALSE) %>%
clean_names()
tile_data <- read_csv("https://gist.githubusercontent.com/maartenzam/787498bbc07ae06b637447dbd430ea0a/raw/9a9dafafb44d8990f85243a9c7ca349acd3a0d07/worldtilegrid.csv")df %>%
glimpse()Rows: 128
Columns: 4
$ country <chr> "Afghanistan", "Albania", "Algeria", "Angola", "…
$ females_married_by_15 <dbl> 0.04200000, 0.01400000, 0.00400000, 0.07900000, …
$ females_married_by_18 <dbl> 0.2830000, 0.1180000, 0.0250000, 0.3030000, 0.05…
$ males_married_by_18 <dbl> 0.073, 0.012, NA, 0.060, 0.004, 0.004, 0.044, NA…df %>%
summary() country females_married_by_15 females_married_by_18
Length:128 Min. :0.00000 Min. :0.0010
Class :character 1st Qu.:0.01150 1st Qu.:0.1115
Mode :character Median :0.03750 Median :0.2220
Mean :0.05482 Mean :0.2313
3rd Qu.:0.07750 3rd Qu.:0.3070
Max. :0.29700 Max. :0.7630
males_married_by_18
Min. :0.00000
1st Qu.:0.01300
Median :0.03500
Mean :0.04777
3rd Qu.:0.06000
Max. :0.27900
NA's :33 # collect country codes and regions
codelist <- countrycode::codelist %>%
select(un.name.en, continent,
un.region.name, un.regionsub.name,
iso2c) %>%
rename(country = un.name.en) %>%
filter(!is.na(country))
# adjust text of some names and join on codelist
df <- df %>%
mutate(country = recode(country,
"Cote d'Ivoire" = "Côte D'Ivoire",
"Gambia" = "Gambia (Republic of The)",
"Guinea-Bissau" = "Guinea Bissau",
"Lao People's Democratic Republic" = "Lao People’s Democratic Republic")) %>%
left_join(x=.,
y=codelist,
by='country')
# Namibia is missing an `alpha.2` code, so correcting that
tile_data <- tile_data %>%
mutate(alpha.2 = if_else(is.na(alpha.2), 'NA', alpha.2))
# join tile_data with df
tile_data <- tile_data %>%
left_join(x=.,
y=df,
by=c('alpha.2' = 'iso2c'))
# create top 10 dataframes for vizzes
top_10_girls15_df <- df %>%
slice_max(order_by = females_married_by_15,
n =10)
top_10_disparity_df <- df %>%
mutate(diff_by_18 = females_married_by_18 - males_married_by_18) %>%
slice_max(order_by = diff_by_18, n = 10)my_theme <- theme(
text = element_text(family = 'Lato', size=12, color='black'),
axis.ticks = element_blank(),
plot.background = element_rect(color='white'),
panel.background = element_blank(),
legend.background = element_blank(),
panel.grid.major = element_line(colour = "grey90", size = 0.5),
panel.grid.minor = element_line(colour = "grey93", size = 0.5),
panel.border = element_blank(),
legend.title=element_blank(),
legend.position = 'top')
region_cols <- c('Southern Asia' = 'darkorchid3',
'Sub-Saharan Africa' = 'springgreen4')top10_viz <- top_10_girls15_df %>%
ggplot(.,
aes(x=females_married_by_15,
y=reorder(country, females_married_by_15))) +
geom_col(aes(fill=un.regionsub.name)) +
geom_text(aes(label=paste(round(females_married_by_15 * 100, 1), '%', sep = '')),
vjust=0.5,
size = 16,
position = position_stack(vjust = 0.5),
color='grey98',
fontface='bold') +
geom_text(aes(x = .002, label = country),
color = 'grey98',
hjust = 0,
vjust = 1,
size = 10,
fontface = 'bold') +
annotate("text",
x=.3, y=1.25,
size=9, family="Lato",
label = 'Makeover Monday Week 39 (2020)\nData Source: UNICEF',
color='black',
lineheight=.3,
hjust = 1) +
scale_x_continuous(labels = percent) +
labs(x='',
y='',
title='Child marriage: a **human rights** issue that perpetuates **inequality**',
subtitle=glue("Worst countries all in <span style='color:springgreen4'>**Sub-Saharan Africa**</span> and <span style='color:darkorchid3'>**Sourthern Asia**</span><br>% of girls married by age 15")) +
scale_fill_manual(values = region_cols) +
my_theme +
theme(legend.position = 'none',
plot.title = element_textbox(size=rel(5)),
plot.subtitle = element_textbox(size=rel(3.5), lineheight = .4),
plot.caption = element_textbox(size=rel(2), lineheight = .2),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid.minor = element_blank(),
panel.grid.major = element_blank())disparity_viz <- top_10_disparity_df %>%
ggplot(.) +
geom_dumbbell(aes(x=males_married_by_18,
xend=females_married_by_18,
y=reorder(country, diff_by_18)),
size_x = 6,
size_xend = 6,
color = 'gray60',
colour_x = 'darkorchid3',
colour_xend = 'springgreen4') +
labs(x='<br>% of girls and boys married by age 18, arranged by the size of the gap<br>',
y='',
title=glue("Countries with wide **disparities** in rates of **youth marriage among <span style='color:darkorchid3'>boys</span> and <span style='color:springgreen4'>girls**</span>"),
caption = "10 countries with widest gender gap<br>Makeover Monday Week 39 (2020)<br>**Data Source**: UNICEF") +
scale_x_continuous(labels = c('', '20%', '40%', '60%', '80%'),
position = 'top') +
expand_limits(x=c(0, .85)) +
my_theme +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_textbox(size=rel(4.5), hjust = 0),
plot.title.position = 'plot',
plot.caption = element_textbox(size=rel(2), lineheight = .4),
axis.ticks = element_blank(),
axis.title = element_textbox(size=rel(2), lineheight = .4),
axis.text.x = element_text(size=rel(4)),
axis.text.y = element_text(size=rel(2.75)))tilemap_viz <- tile_data %>%
ggplot(.,
aes(xmin = x, ymin = y, xmax = x + 1, ymax = y + 1)) +
geom_rect(aes(fill=females_married_by_15), color = "#ffffff") +
geom_text(aes(x = x, y = y, label = alpha.2),
color = "#ffffff", alpha = 0.5, nudge_x = 0.5, nudge_y = -0.5, size = 3) +
labs(title='**Marriage rate of girls by 15 years old**',
subtitle='Makeover Monday Week 39 (2020)<br>**Data Source**: UNICEF<br>') +
scale_y_reverse() +
viridis::scale_fill_viridis(option = 'inferno',
labels = scales::percent,
na.value = "gray90") +
# theme_void() +
my_theme +
theme(plot.title = element_textbox(size=rel(7)),
plot.subtitle = element_textbox(size=rel(3), lineheight = .3),
plot.background = element_rect(color='white'),
legend.position = "top",
legend.direction = "horizontal",
legend.key.height = unit(0.3, "cm"),
legend.key.width = unit(2, "cm"),
legend.title.position = "top",
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_blank(),
axis.text = element_blank(),
axis.title = element_blank(),
legend.title = element_blank(),
legend.text = element_text(size=rel(3)),
legend.background = element_rect(fill = "white", color = NA),
legend.spacing.x = unit(0.2, 'cm'))# TOP 10 PLOT
ggsave(
filename = glue("mm_{mm_year}_{mm_week}_bar.png"),
plot = top10_viz,
width = 8, height = 5, units = "in", dpi = 320
)
# DISPARITY PLOT
ggsave(
filename = glue("mm_{mm_year}_{mm_week}_dumbbell.png"),
plot = disparity_viz,
width = 8, height = 5, units = "in", dpi = 320
)
# TILE MAP
ggsave(
filename = glue("mm_{mm_year}_{mm_week}_tilemap.png"),
plot = tilemap_viz,
width = 6, height = 6, units = "in", dpi = 320
)
# make thumbnail for page
magick::image_read(glue("mm_{mm_year}_{mm_week}_bar.png")) %>%
magick::image_resize(geometry = "400") %>%
magick::image_write(glue("mm_{mm_year}_{mm_week}_bar_thumbnail.png"))
magick::image_read(glue("mm_{mm_year}_{mm_week}_dumbbell.png")) %>%
magick::image_resize(geometry = "400") %>%
magick::image_write(glue("mm_{mm_year}_{mm_week}_dumbbell_thumbnail.png"))
magick::image_read(glue("mm_{mm_year}_{mm_week}_tilemap.png")) %>%
magick::image_resize(geometry = "400") %>%
magick::image_write(glue("mm_{mm_year}_{mm_week}_tilemap_thumbnail.png"))R version 4.4.0 (2024-04-24)
Platform: aarch64-apple-darwin20
Running under: macOS Sonoma 14.6.1
Matrix products: default
BLAS: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRblas.0.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.12.0
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
time zone: America/Denver
tzcode source: internal
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] geomtextpath_0.1.4 here_1.0.1 glue_1.8.0 htmltools_0.5.8.1
[5] scales_1.3.0 janitor_2.2.0 showtext_0.9-7 showtextdb_3.0
[9] sysfonts_0.8.9 countrycode_1.6.0 hrbrthemes_0.8.7 ggalt_0.4.0
[13] ggbump_0.1.0 gtExtras_0.5.0 gt_0.11.1 ggtext_0.1.2
[17] dlookr_0.6.3 tidytuesdayR_1.1.2 lubridate_1.9.3 forcats_1.0.0
[21] stringr_1.5.1 dplyr_1.1.4 purrr_1.0.2 readr_2.1.5
[25] tidyr_1.3.1 tibble_3.2.1 ggplot2_3.5.1 tidyverse_2.0.0
[29] pacman_0.5.1
loaded via a namespace (and not attached):
[1] gridExtra_2.3 rematch2_2.1.2 rlang_1.1.4
[4] magrittr_2.0.3 snakecase_0.11.1 compiler_4.4.0
[7] systemfonts_1.1.0 vctrs_0.6.5 maps_3.4.2
[10] pkgconfig_2.0.3 crayon_1.5.3 fastmap_1.2.0
[13] magick_2.8.5 fontawesome_0.5.2 labeling_0.4.3
[16] utf8_1.2.4 promises_1.3.0 rmarkdown_2.28
[19] markdown_1.13 tzdb_0.4.0 ragg_1.3.3
[22] bit_4.5.0 xfun_0.48 ash_1.0-15
[25] jsonlite_1.8.9 later_1.3.2 parallel_4.4.0
[28] R6_2.5.1 stringi_1.8.4 RColorBrewer_1.1-3
[31] pagedown_0.21 extrafontdb_1.0 Rcpp_1.0.13
[34] knitr_1.48 extrafont_0.19 httpuv_1.6.15
[37] timechange_0.3.0 tidyselect_1.2.1 rstudioapi_0.17.1
[40] yaml_2.3.10 viridis_0.6.5 curl_5.2.3
[43] shiny_1.9.1 withr_3.0.1 evaluate_1.0.1
[46] xml2_1.3.6 pillar_1.9.0 KernSmooth_2.23-24
[49] generics_0.1.3 vroom_1.6.5 rprojroot_2.0.4
[52] paletteer_1.6.0 hms_1.1.3 munsell_0.5.1
[55] commonmark_1.9.2 xtable_1.8-4 gdtools_0.4.0
[58] tools_4.4.0 reactable_0.4.4 grid_4.4.0
[61] Rttf2pt1_1.3.12 colorspace_2.1-1 cli_3.6.3
[64] kableExtra_1.4.0 textshaping_0.4.0 proj4_1.0-14
[67] fontBitstreamVera_0.1.1 fansi_1.0.6 viridisLite_0.4.2
[70] svglite_2.1.3 gtable_0.3.5 digest_0.6.37
[73] fontquiver_0.2.1 htmlwidgets_1.6.4 farver_2.1.2
[76] lifecycle_1.0.4 mime_0.12 fontLiberation_0.1.0
[79] gridtext_0.1.5 bit64_4.5.2 MASS_7.3-61