EGM reporting

library(tidyverse)

## Warning: 패키지 'tidyverse'는 R 버전 4.2.3에서 작성되었습니다

## Warning: 패키지 'ggplot2'는 R 버전 4.2.3에서 작성되었습니다

## Warning: 패키지 'tibble'는 R 버전 4.2.3에서 작성되었습니다

## Warning: 패키지 'readr'는 R 버전 4.2.3에서 작성되었습니다

## Warning: 패키지 'purrr'는 R 버전 4.2.3에서 작성되었습니다

## Warning: 패키지 'dplyr'는 R 버전 4.2.3에서 작성되었습니다

## Warning: 패키지 'lubridate'는 R 버전 4.2.3에서 작성되었습니다

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.3     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.3     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(readxl)

## Warning: 패키지 'readxl'는 R 버전 4.2.3에서 작성되었습니다

library(countrycode)

## Warning: 패키지 'countrycode'는 R 버전 4.2.3에서 작성되었습니다

library(ggrepel)
library(openxlsx)

## Warning: 패키지 'openxlsx'는 R 버전 4.2.3에서 작성되었습니다

library(janitor)

## 
## 다음의 패키지를 부착합니다: 'janitor'
## 
## The following objects are masked from 'package:stats':
## 
##     chisq.test, fisher.test

library(writexl)

## Warning: 패키지 'writexl'는 R 버전 4.2.3에서 작성되었습니다

library(gganimate)

## Warning: 패키지 'gganimate'는 R 버전 4.2.3에서 작성되었습니다

library(ggthemes)

## Warning: 패키지 'ggthemes'는 R 버전 4.2.3에서 작성되었습니다

library(gt)

## Warning: 패키지 'gt'는 R 버전 4.2.3에서 작성되었습니다

library(gtExtras)

## Warning: 패키지 'gtExtras'는 R 버전 4.2.3에서 작성되었습니다

theme_set(theme_light())


intervention_variable <- tibble(
  intervention = c(
    rep("SRHR policy, advocacy and health systems", 7),
    rep("Social and behavioural change for the public", 7),
    rep("SRHR Services", 7),
    rep("Vouchers, cash, or in-kind transfers", 3)
  ),
  intervention_combined = c(
    "Policy advocacy", "Policies and laws", "Healthcare financing schemes", "Civil registration and vital statistics systems", "Supply chain and logistics activities", "Social accountability", "Provider capacity building and service adjustments",
    "Mass and social media campaigns", "Social marketing", "SRHR education, including Comprehensive Sexuality Education", "Social groups and clubs", "Peer education and mentorship", "Family mobilisation and dialogue", "Community mobilisation and dialogue",
    "Counselling", "Screening and assessment", "Maternal and newborn care", "Safe abortion services", "Community health workers and home visits", "mHealth and technology-based interventions", "Provision of SRH products", 
    "Cash transfers", "Vouchers", "In-kind transfers (excluding SRH products)"
  )
)

outcome_variable <- tibble(
  outcome = c(
    rep("Knowledge, attitudes and norms", 2),
    rep("Behaviours of the public", 4),
    rep("Availability, accessibility, acceptability and quality of services", 6),
    rep("Health outcomes", 7),
    rep("Gender-based violence and harmful practices", 4),
    rep("Enabling environment", 3)
  ),
  outcome_combined = c(
    "Knowledge and awareness", "Attitudes and normative change",
    "Sexual behaviour", "Contraception and other prevention", "Menstrual hygiene", "Communication, support seeking and caregiver practices", "Sexual behaviour and function",
    "Availability and use", "Accessibility", "Affordability", "Quality and acceptability", "Registration",
    "Adolescent pregnancy", "Adult fertility and infertility", "Safe abortion", "HIV and other STI testing and incidence", "Maternal morbidity and mortality", "Newborn morbidity and mortality", "Sexual function and satisfaction",
    "Child, early and forced marriage", "Female genital mutilation/cutting", "Trafficking", "Gender-based violence",
    "Agency and empowerment", "Legislative environment", "International norms"
  )
)

coding_mapping <- data.frame(
  name = c(
    "id", "legacy_id", "assigned_to", "type", "created_at", 
    "updated_at", "status", "title", "study_status", "language", 
    "authors", "author_affiliation", "department", "author_country",
    "journal", "other_journal_name", "year_of_publication", "doi",
    "abstract", "open_access", "3ie_funded", "publication_type", 
    "publication_url", "publication_info_minutes", "sector_name", 
    "sub_sector", "primary_theme", "sub_primary_theme", 
    "additional_theme", "additional_sub_theme", "primary_dac_code", 
    "secondary_dac_code", "crs_voluntary_dac_code", 
    "additional_primary_dac_code", "additional_secondary_dac_code", 
    "additional_crs_voluntary_dac_code", "un_sustainable_development_goal", 
    "other_topics", "first_year_of_intervention", "equity_focus", 
    "equity_dimension", "equity_description", "keywords", 
    "sector_info_minutes", "primary_dataset_availability", 
    "primary_dataset_location", "primary_dataset_format", 
    "secondary_dataset_disclosure", "secondary_dataset_name", 
    "secondary_dataset_location", "additional_dataset_info", 
    "analysis_code_availability", "analysis_code_format_other", 
    "study_materials_availability", "study_materials_list", 
    "study_materials_other", "pre_registration", "pre_registration_url", 
    "protocol_pre_analysis_plan", "ethics_approval", 
    "transparency_minutes", 
    "country", "continent", "income_level", "fcv_status", "electoral_democracy","geographic_info_minutes",
    "evaluation_design", 
    "evaluation_method", "mixed_methods", "additional_method", 
    "additional_method_2", "unit_of_observation", 
    "methods_minutes", "project_name", "implementation_agencies", 
    "implementation_agencies_name", "program_funding_agency", 
    "program_funding_agency_name", "research_funding_agency", 
    "research_funding_agency_name", "funding_minutes", 
    "grantholding_institution", "evidence_programme", 
    "synopsis", "context", "research_questions", "methodology", 
    "main_findings", "instances_of_evidence_use", 
    "3ie_funded_minutes", "project", "project_ids", 
    "intervention", "intervention_description", "outcome", 
    "outcome_description", "of_studies", "of_high_quality_studies", 
    "of_medium_quality_studies", "findings_minutes", "dep", 
    "exclusion_reason", "exclusion_open_answer", "screened_by", 
    "screening_minutes", "review_type", "review_other", 
    "quantitative_method", "quantitative_method_other", 
    "qualitative_method", "qualitative_method_other", 
    "quality_assessment_tool", "quality_assessment_tool_other", 
    "extract_comment", "overall_of_studies", "overall_of_high_quality_studies", 
    "overall_of_medium_quality_studies", "background", "objectives", 
    "headline_findings", "evidence_findings", "policy_findings", 
    "research_findings", "methodology_summary", "external_validity", 
    "external_validity_treatment", "summary_minutes", 
    "did_the_authors_specify_the_type_of_studies_to_be_included", 
    "did_the_authors_specify_the_participants_settings_and_populations_to_be_included", 
    "did_the_authors_specify_the_interventions_to_be_included", 
    "did_the_authors_specify_the_outcomes_to_be_included", 
    "were_the_criteria_used_for_deciding_which_studies_to_include_in_the_review_reported", 
    "did_the_authors_avoid_a_language_bias_in_the_search", 
    "was_greyunpublished_literature_included_in_the_search", 
    "were_the_relevant_databases_searched", 
    "were_the_reference_lists_of_included_articles_checked", 
    "were_authorsexperts_contacted", 
    "was_the_search_for_evidence_reasonably_comprehensive", 
    "does_the_review_cover_an_appropriate_time_period", 
    "were_articles_independently_screened_at_full_text_by_at_least_two_reviewers", 
    "is_a_list_of_the_included_studies_provided", 
    "is_a_list_of_the_excluded_studies_provided", 
    "was_bias_in_the_selection_of_articles_avoided", 
    "do_the_authors_report_the_criteria_used_for_assessing_the_quality_risk_of_bias", 
    "is_there_a_table_or_summary_reporting_the_assessment_of_each_included_study_for_each_criteria", 
    "were_sensible_criteria_used_that_focus_on_the_qualityrisk_of_bias_and_not_other_qualities_of_the_studies_such_as_precision_or_applicabilityexternal_validity", 
    "did_the_authors_use_appropriate_criteria_to_assess_the_quality_and_risk_of_bias_in_analysing_the_studies_that_are_included", 
    "overall_how_much_confidence_do_you_have_in_the_methods_used_to_identify_include_and_critically_appraise_studies", 
    "was_data_independently_extracted_by_at_least_two_reviewers", 
    "b_1_2_independent_risk_of_bias_assessment_by_at_least_2_reviewers", 
    "is_there_a_table_or_summary_of_the_characteristics_of_the_participants_intervention_and_outcomes_for_the_included_studies", 
    "is_there_a_table_or_summary_of_the_results_of_all_the_included_studies", 
    "were_the_characteristics_and_results_of_the_included_studies_reliably_reported", 
    "are_the_methods_used_by_the_review_authors_to_analyse_the_findings_of_the_included_studies_clear_including_methods_for_calculating_effect_sizes_if_applicable", 
    "did_the_review_ensure_that_included_studies_were_similar_enough_that_it_made_sense_to_combine_them_sensibly_divide_the_included_studies_into_homogeneous_groups_or_sensibly_conclude_that_it_did_not_make_sense_to_combine_or_group_the_included_studies", 
    "did_the_review_describe_the_extent_to_which_there_were_important_differences_in_the_results_of_the_included_studies", 
    "if_a_meta_analysis_was_done_was_the_isup2sup_or_chi_squared_test_for_heterogeneity_or_other_appropriate_statistic_reported_if_no_statistical_test_was_reported_is_a_qualitative_justification_made_for_the_use_of_random_effects", 
    "did_the_review_describe_the_extent_of_heterogeneity", 
    "how_was_the_data_analysis_done_enter_multiple_responses_if_needed", 
    "how_were_the_studies_weighted_in_the_analysis_enter_multiple_responses_if_needed", 
    "did_the_review_address_unit_of_analysis_errors", 
    "were_the_findings_of_the_relevant_studies_combined_or_not_combined_appropriately_relative_to_the_primary_question_the_review_addresses_and_the_available_data", 
    "does_the_review_make_clear_which_evidence_is_subject_to_low_risk_of_bias_in_assessing_causality_attribution_of_outcomes_to_intervention_and_which_is_likely_to_be_biased_and_does_so_appropriately", 
    "where_studies_of_differing_risk_of_bias_are_included_results_are_they_reported_and_analysed_separately_by_risk_of_bias_status", 
    "does_the_review_report_evidence_appropriately", 
    "were_factors_that_the_review_authors_considered_as_likely_explanatory_factors_clearly_described", 
    "was_a_sensible_method_used_to_explore_the_extent_to_which_key_factors_explained_heterogeneity_enter_multiple_responses_if_needed", 
    "did_the_review_examine_the_extent_to_which_specific_factors_might_explain_differences_in_the_results_of_the_included_studies", 
    "overall_how_much_confidence_do_you_have_in_the_methods_used_to_analyse_the_findings_relative_to_the_primary_question_addressed_in_the_review", 
    "are_there_any_other_aspects_of_the_review_not_mentioned_before_which_lead_you_to_question_the_results_enter_multiple_responses_if_needed", 
    "are_there_any_mitigating_factors_which_should_be_taken_into_account_in_determining_the_reviews_reliability_enter_multiple_responses_if_needed", 
    "based_on_the_above_assessments_of_the_methods_how_would_you_rate_the_reliability_of_the_review", 
    "critical_appraisal_minutes", "url_link", 
    "intervention_description_page_number", "outcome_description_page_number", 
    "population_study_focus", "age_group_intervention_focus", 
    "marital_status_intervention_focus", "mode_of_delivery_or_setting_intervention", 
    "srhr_topic_srhr_egm", "theory_of_change_srhr_egm", 
    "theory_of_change_page_numbers", "cost_evidence", 
    "time_spent", "intervention_combined", 
    "outcome_combined"),
  category = c(
    rep("Study Information", 14),
    rep("Publication Information", 10),
    rep("Sector Information", 20),
    rep("Transparency Information", 17),
    rep("Geographic info", 6),
    rep("Methodological information", 7),
    rep("Funding/Implementing agency Information", 8),
    rep("3ie funded", 9),
    rep("Study Information", 2),
    rep("Intervention Information", 8),
    rep("Screening", 5),
    rep("Methods", 9),
    rep("Intervention Information", 3),
    rep("Summary", 10),
    rep("Critical appraisal", 46),
    rep("EGM", 14)
  )
) |> 
  as_tibble()

Data loading

setwd("d:/r/egm/sample/")
dataset <- read_excel("data_2024-01-18.xlsx", guess_max = 4000)
egm_data <- read_excel("custom_fields_data1705443330.xlsx") |> 
  clean_names()

intervention_variable <-read_excel("coding_mapping_Anaemia EGM 1.xlsx", sheet = "intervention_variable") |> 
  mutate(intervention_combined = str_trim(intervention_combined)) |> 
  distinct(intervention_combined, .keep_all = T)


color_palette <- setNames(c("#6A589F", "#617D95", "#153A80", "#007AAD"),
                          c("Direct causes", "Intermediate risk factors", "Underlying risk factors", "Multi-domain"))

Figure 4

1. Change the color codes
2. SR and Impact Evaluation (stack)
3. Number labels
4. Stack bars

# option 1
dataset |> 
  separate_rows(intervention_combined, outcome_combined, sep = ";") |> 
  select(-intervention, -outcome) |>
  filter(intervention_combined != "No data" & outcome_combined != "No data") |> 
  group_by(id) |> 
  mutate(rowid = row_number(),
         arms_id = paste0(id, "_",rowid)) |>
  ungroup() |> 
  separate_rows(intervention_combined, sep = "\\|") |> 
  distinct(id, intervention_combined, .keep_all = T) |> 
  group_by(id) %>%
  mutate(intervention_combined = paste0(intervention_combined, collapse = ";")) |>
  distinct(id, .keep_all = T) |> 
  ungroup() |> 
  mutate(n = str_count(intervention_combined, ";") + 1) |> 
  mutate(intervention_combined_multi = ifelse(n == 1, intervention_combined, "Multi-component")) |> 
  dplyr::select(-n) |> 
  inner_join(intervention_variable, by = join_by("intervention_combined_multi" == "intervention_combined")) |> 
  select(id, type, intervention, intervention_cat) |> 
  count(intervention, intervention_cat) |> 
  mutate(intervention = str_squish(intervention)) |> 
  arrange(intervention_cat, -n) |> 
  select(intervention_cat, intervention, n) |> 
  gt() |> 
  cols_label(
    n = "Number of studies"
  ) |> 
  tab_header(title = "Interventions by Category") |> 
  cols_label(intervention_cat = "Intervention Category") |> 
  gt_plt_bar(column = n, scaled = F, keep_column = T, width = 45) |> 
  cols_label(
    n = "Number of studies"
  )

Interventions by Category
Intervention Category	intervention	Number of studies	n
Direct causes	Inadequate nutrient intake, absorption, and utilization	1218
Direct causes	Chronic disease / exposure and response to infectious diseases	346
Direct causes	Gynaecological and obstetric conditions	97
Intermediate risk factors	Inadequate health / nutrition knowledge and awareness	70
Intermediate risk factors	Access / use of health / nutrition services and interventions	37
Intermediate risk factors	Inadequate access / use of WASH	19
Intermediate risk factors	Food insecurity	5
Intermediate risk factors	Inadequate family planning	4
Multi-domain	Multi-component	438
Underlying risk factors	Poverty	12
Underlying risk factors	Health policies	5
Underlying risk factors	Cultural norms and behaviours	3
Underlying risk factors	Low educational attainment	2

# option2
dataset_f4 <- dataset |> 
  separate_rows(intervention_combined, outcome_combined, sep = ";") |> 
  select(-intervention, -outcome) |>
  filter(intervention_combined != "No data" & outcome_combined != "No data") |> 
  group_by(id) |> 
  mutate(rowid = row_number(),
         arms_id = paste0(id, "_",rowid)) |>
  ungroup() |> 
  separate_rows(intervention_combined, sep = "\\|") |> 
  distinct(id, intervention_combined, .keep_all = T) |> 
  group_by(id) %>%
  mutate(intervention_combined = paste0(intervention_combined, collapse = ";")) |>
  distinct(id, .keep_all = T) |> 
  ungroup() |> 
  mutate(n = str_count(intervention_combined, ";") + 1) |> 
  mutate(intervention_combined_multi = ifelse(n == 1, intervention_combined, "Multi-component")) |> 
  dplyr::select(-n) |> 
  inner_join(intervention_variable, by = join_by("intervention_combined_multi" == "intervention_combined")) |> 
  select(id, type, intervention, intervention_cat) |> 
  count(type, intervention, intervention_cat) |> 
  mutate(intervention = str_trim(intervention)) 
  

intervention_text <- intervention_variable |> 
  mutate(intervention = str_trim(intervention)) |> 
  select(intervention, intervention_combined) |> 
  group_by(intervention) |> 
  summarize(text = paste0(intervention_combined, collapse = " ; "))


library(gtExtras)

prepared_data  <- dataset_f4 |> 
  select(intervention_cat, intervention, n, type) |> 
  pivot_wider(names_from = type,
               values_from = n) |> 
  rename(ier = 'Impact Evaluation',
         srr = 'Systematic Review') |>
  mutate(intervention_cat = fct_relevel(intervention_cat, "Multi-domain", after = Inf)) |> 
  arrange(intervention_cat, -ier)  |> 
  mutate(ggplot = NA) |> 
  left_join(intervention_text, by = "intervention")

gt_table <- prepared_data |> 
  gt() |> 
  cols_merge(
    columns = c(intervention, text),
    pattern = "{1} <br><br> ({2})"
  )
gt_table

intervention_cat	intervention	ier	srr	ggplot
Direct causes	Inadequate nutrient intake, absorption, and utilization (Supplementation ; Mass fortification ; Point-of-use fortification ; Targeted fortification ; Biofortification ; Dietary enhancement and diversification)	1180	38	NA
Direct causes	Chronic disease / exposure and response to infectious diseases (Anti-malaria programs ; Routine immunization ; Deworming and helminth programs ; Other anti-parasite programs ; HIV programs ; Tuberculosis programs)	325	21	NA
Direct causes	Gynaecological and obstetric conditions (Delayed cord clamping ; Management of menses ; Management of postpartum haemorrhage)	94	3	NA
Intermediate risk factors	Inadequate health / nutrition knowledge and awareness (Breastfeeding and IYCF education and support ; Anaemia education and habit support ; Other nutrition education and counselling ; Counselling and management of anaemia due to genetic blood disorders)	70	NA	NA
Intermediate risk factors	Access / use of health / nutrition services and interventions (Antenatal and postnatal visits ; Resources and staff for health facilities ; Treatment of moderate or severe acute malnutrition ; Provision of other preventative care ; Education and direct support for supply chain management ; Mobilization of public and private sector actors to support anaemia-product value chains)	34	3	NA
Intermediate risk factors	Inadequate access / use of WASH (Water access, sanitation, and hygiene resources ; Education on hygiene)	19	NA	NA
Intermediate risk factors	Food insecurity (Nutrition sensitive agriculture)	5	NA	NA
Intermediate risk factors	Inadequate family planning (Family planning and birth spacing counselling)	4	NA	NA
Underlying risk factors	Poverty (Social assistance ; Social insurance ; Social care services ; Labour market programs)	11	1	NA
Underlying risk factors	Health policies (Multi-sectoral anaemia platform strengthening ; Advocacy for better services related to anaemia ; Product registration and standardization ; Governmental funding for anaemia treatment and prevention)	5	NA	NA
Underlying risk factors	Cultural norms and behaviours (Women's empowerment ; Social and behaviour change communication on gender norms)	3	NA	NA
Underlying risk factors	Low educational attainment (Schooling)	2	NA	NA
Multi-domain	Multi-component (Multi-component)	427	11	NA

for (cat in names(color_palette)) {
  # Create a logical vector indicating which rows have the category equal to 'cat'
  cat_rows <- prepared_data$intervention_cat == cat
  
  # Use the logical vector to apply styles only to those rows
  gt_table <- gt_table %>%
    tab_style(
      style = list(
        cell_fill(color = color_palette[cat]),
        cell_text(color = "white")
      ),
      locations = cells_body(
        columns = c("intervention_cat", "intervention", "ier", "srr"),
        rows = cat_rows
      )
    )
}

library(ggprism)

## Warning: 패키지 'ggprism'는 R 버전 4.2.3에서 작성되었습니다

create_plot <- function(intervention_name, dataset) {
  
  filtered_data <- dataset %>%
    filter(intervention == intervention_name) |> 
    pivot_longer(cols = c(ier, srr)) |> 
    rename(type = "name",
           n = "value") |> 
    mutate_at(vars(n), ~replace_na(., 0)) 
  
  # Calculate the maximum of n outside the ggplot to avoid the error
  max_n <- max(dataset$ier, na.rm = TRUE)
  
  # Now filter and mutate using the calculated max_n
  plot_data <- filtered_data |> 
    mutate(dodged_position = n + (max_n * 0.001))
  
  # Create the ggplot
  ggplot(plot_data, aes(x = dodged_position, y = intervention, fill = rev(type))) +
    geom_col(position = "dodge", show.legend = FALSE) +
    geom_text(aes(x = 100, label = n), 
              position = position_dodge(width = 1), 
              hjust = -0.1, 
              size = 30) +
    scale_x_continuous(limits = c(0, ceiling(max_n / 100) * 100 + 100),
                       breaks = seq(0, 1300, by = 400),
                       minor_breaks = seq(0,1300, by = 100),
                       guide = "prism_offset_minor") +
    scale_fill_manual(values = c("Systematic Review" = "grey30",
                                 "Impact Evaluation" = "grey80")) +
    theme_void() +
    theme_few() +
    theme_prism() +
    theme(axis.text.y = element_blank(),
          axis.title.y = element_blank(),
          axis.ticks.y = element_blank(),
          axis.title.x = element_blank(),
          axis.line.y = element_blank(),
          axis.line.x = element_blank(), 
          axis.text.x = element_text(size = 30),
          axis.ticks = element_line(size = 3),
          axis.ticks.length.x = unit(30, "pt"))
}

plot_list <- list()

for (i in 1:nrow(prepared_data)) {
  plot_list[[i]] <- create_plot(prepared_data$intervention[i], prepared_data)
}

## Warning: The `size` argument of `element_line()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

gt_table |>
  cols_hide(c("ier", "srr")) |> 
  cols_align(
    align = "center",
    columns = c(intervention_cat, intervention) 
  ) |> 
  tab_style(
    style = list(cell_text(align = "center")),
    locations = cells_column_labels(columns = everything())
  ) |> 
  text_transform(
    locations = cells_body(rows = 1, columns = c(ggplot)),
    fn = function(x) {
      ggplot_image(plot_list[[1]], height = px(100))
    }
  ) |>
  text_transform(
    locations = cells_body(rows = 2, columns = c(ggplot)),
    fn = function(x) {
      ggplot_image(plot_list[[2]], height = px(100))
    }
  ) |>
  text_transform(
    locations = cells_body(rows = 3, columns = c(ggplot)),
    fn = function(x) {
      ggplot_image(plot_list[[3]], height = px(100))
    }
  ) |>
  text_transform(
    locations = cells_body(rows = 4, columns = c(ggplot)),
    fn = function(x) {
      ggplot_image(plot_list[[4]], height = px(100))
    }
  ) |>
  text_transform(
    locations = cells_body(rows = 5, columns = c(ggplot)),
    fn = function(x) {
      ggplot_image(plot_list[[5]], height = px(100))
    }
  ) |>
  text_transform(
    locations = cells_body(rows = 6, columns = c(ggplot)),
    fn = function(x) {
      ggplot_image(plot_list[[6]], height = px(100))
    }
  ) |>
  text_transform(
    locations = cells_body(rows = 7, columns = c(ggplot)),
    fn = function(x) {
      ggplot_image(plot_list[[7]], height = px(100))
    }
  ) |>
  text_transform(
    locations = cells_body(rows = 8, columns = c(ggplot)),
    fn = function(x) {
      ggplot_image(plot_list[[8]], height = px(100))
    }
  ) |>
  text_transform(
    locations = cells_body(rows = 9, columns = c(ggplot)),
    fn = function(x) {
      ggplot_image(plot_list[[9]], height = px(100))
    }
  ) |>
  text_transform(
    locations = cells_body(rows = 10, columns = c(ggplot)),
    fn = function(x) {
      ggplot_image(plot_list[[10]], height = px(100))
    }
  ) |>
  text_transform(
    locations = cells_body(rows = 11, columns = c(ggplot)),
    fn = function(x) {
      ggplot_image(plot_list[[11]], height = px(100))
    }
  ) |>
  text_transform(
    locations = cells_body(rows = 12, columns = c(ggplot)),
    fn = function(x) {
      ggplot_image(plot_list[[12]], height = px(100))
    }
  ) |>
  text_transform(
    locations = cells_body(rows = 13, columns = c(ggplot)),
    fn = function(x) {
      ggplot_image(plot_list[[13]], height = px(100))
    }
  )  |> 
  cols_width(
    intervention_cat ~ px(200),
    intervention ~ px(500),
    ggplot ~ px(100)
  ) |> 
  cols_label(
    "ggplot" ~ 'Number of Studies',
    "intervention_cat" ~ "Domains",
    "intervention" ~ "Sub-domains (Categories)"
  ) |> 
  tab_spanner(
    columns = c(intervention_cat, intervention),
    label = "Intervetnion"
  ) |> 
  tab_footnote(
    footnote = "Dark Grey denotes Impact Evaluation, Light grey means Systematic Review",
    locations = cells_column_labels(columns = ggplot)
  )

Intervetnion		Number of Studies1
Domains	Sub-domains (Categories)
Direct causes	Inadequate nutrient intake, absorption, and utilization (Supplementation ; Mass fortification ; Point-of-use fortification ; Targeted fortification ; Biofortification ; Dietary enhancement and diversification)
Direct causes	Chronic disease / exposure and response to infectious diseases (Anti-malaria programs ; Routine immunization ; Deworming and helminth programs ; Other anti-parasite programs ; HIV programs ; Tuberculosis programs)
Direct causes	Gynaecological and obstetric conditions (Delayed cord clamping ; Management of menses ; Management of postpartum haemorrhage)
Intermediate risk factors	Inadequate health / nutrition knowledge and awareness (Breastfeeding and IYCF education and support ; Anaemia education and habit support ; Other nutrition education and counselling ; Counselling and management of anaemia due to genetic blood disorders)
Intermediate risk factors	Access / use of health / nutrition services and interventions (Antenatal and postnatal visits ; Resources and staff for health facilities ; Treatment of moderate or severe acute malnutrition ; Provision of other preventative care ; Education and direct support for supply chain management ; Mobilization of public and private sector actors to support anaemia-product value chains)
Intermediate risk factors	Inadequate access / use of WASH (Water access, sanitation, and hygiene resources ; Education on hygiene)
Intermediate risk factors	Food insecurity (Nutrition sensitive agriculture)
Intermediate risk factors	Inadequate family planning (Family planning and birth spacing counselling)
Underlying risk factors	Poverty (Social assistance ; Social insurance ; Social care services ; Labour market programs)
Underlying risk factors	Health policies (Multi-sectoral anaemia platform strengthening ; Advocacy for better services related to anaemia ; Product registration and standardization ; Governmental funding for anaemia treatment and prevention)
Underlying risk factors	Cultural norms and behaviours (Women's empowerment ; Social and behaviour change communication on gender norms)
Underlying risk factors	Low educational attainment (Schooling)
Multi-domain	Multi-component (Multi-component)
1 Dark Grey denotes Impact Evaluation, Light grey means Systematic Review

dataset_f4 |> 
  mutate(intervention = fct_rev(intervention)) |> 
  ggplot(aes(n, intervention, fill = type)) +
  geom_col() +
  theme_void() +
  theme(legend.position = "bottom")

gt_table |> 
  gt::cells_row_groups()

## $groups
## <quosure>
## expr: ^gt_table
## env:  global
## 
## attr(,"class")
## [1] "cells_row_groups" "location_cells"

gt_table

intervention_cat	intervention	ier	srr	ggplot
Direct causes	Inadequate nutrient intake, absorption, and utilization (Supplementation ; Mass fortification ; Point-of-use fortification ; Targeted fortification ; Biofortification ; Dietary enhancement and diversification)	1180	38	NA
Direct causes	Chronic disease / exposure and response to infectious diseases (Anti-malaria programs ; Routine immunization ; Deworming and helminth programs ; Other anti-parasite programs ; HIV programs ; Tuberculosis programs)	325	21	NA
Direct causes	Gynaecological and obstetric conditions (Delayed cord clamping ; Management of menses ; Management of postpartum haemorrhage)	94	3	NA
Intermediate risk factors	Inadequate health / nutrition knowledge and awareness (Breastfeeding and IYCF education and support ; Anaemia education and habit support ; Other nutrition education and counselling ; Counselling and management of anaemia due to genetic blood disorders)	70	NA	NA
Intermediate risk factors	Access / use of health / nutrition services and interventions (Antenatal and postnatal visits ; Resources and staff for health facilities ; Treatment of moderate or severe acute malnutrition ; Provision of other preventative care ; Education and direct support for supply chain management ; Mobilization of public and private sector actors to support anaemia-product value chains)	34	3	NA
Intermediate risk factors	Inadequate access / use of WASH (Water access, sanitation, and hygiene resources ; Education on hygiene)	19	NA	NA
Intermediate risk factors	Food insecurity (Nutrition sensitive agriculture)	5	NA	NA
Intermediate risk factors	Inadequate family planning (Family planning and birth spacing counselling)	4	NA	NA
Underlying risk factors	Poverty (Social assistance ; Social insurance ; Social care services ; Labour market programs)	11	1	NA
Underlying risk factors	Health policies (Multi-sectoral anaemia platform strengthening ; Advocacy for better services related to anaemia ; Product registration and standardization ; Governmental funding for anaemia treatment and prevention)	5	NA	NA
Underlying risk factors	Cultural norms and behaviours (Women's empowerment ; Social and behaviour change communication on gender norms)	3	NA	NA
Underlying risk factors	Low educational attainment (Schooling)	2	NA	NA
Multi-domain	Multi-component (Multi-component)	427	11	NA

library(magick)

## Warning: 패키지 'magick'는 R 버전 4.2.3에서 작성되었습니다

## Linking to ImageMagick 6.9.12.96
## Enabled features: cairo, freetype, fftw, ghostscript, heic, lcms, pango, raw, rsvg, webp
## Disabled features: fontconfig, x11

gt_temp <- tempfile(fileext = ".png")

gt_table |> 
  gtsave(
    filename = gt_temp
  )

gt_image <- magick::image_read(gt_temp) |> image_ggplot (interpolate = T)


empty_rows <- data.frame(
  intervention_cat = rep("a", 16),
  intervention = rep("a", 16),
  n = rep(0, 16),
  type = rep("Impact Evaluation", 16)
)

plot <- empty_rows |> 
  bind_rows(dataset_f4) |> 
  mutate(intervention = fct_rev(intervention)) |> 
  ggplot(aes(n, intervention, fill = type)) +
  geom_col() +
  theme_void() +
  theme(legend.position = "bottom")

plot

library(patchwork)

gt_image + plot +
  plot_layout(
    ncol = 2,
    width = c(2,1)
    
  )

Figure 5 Regional coding

Select one or more from the dropdown list. Country groupings by respective region are in the WHO regions tab. Note: This classification (based on WHO’s regions) is different from the categories used in the DEP’s geographic information fields (based on WB regions).

• Data label
• Color coding should be the same as the intervention Direct costs -> Immediate -> underlying risk factors -> Multi-component X- axis and Y-axis

# option 1 : allowing the multiple WHO region codes (# of observation => # of studies)
option1 <- dataset |> 
  separate_rows(intervention_combined, outcome_combined, sep = ";") |> 
  select(-intervention, -outcome) |>
  filter(intervention_combined != "No data" & outcome_combined != "No data") |> 
  group_by(id) |> 
  mutate(rowid = row_number(),
         arms_id = paste0(id, "_",rowid)) |>
  ungroup() |> 
  separate_rows(intervention_combined, sep = "\\|") |> 
  distinct(id, intervention_combined, .keep_all = T) |> 
  group_by(id) %>%
  mutate(intervention_combined = paste0(intervention_combined, collapse = ";")) |>
  distinct(id, .keep_all = T) |> 
  ungroup() |> 
  mutate(n = str_count(intervention_combined, ";") + 1) |> 
  mutate(intervention_combined_multi = ifelse(n == 1, intervention_combined, "Multi-component")) |> 
  dplyr::select(-n) |> 
  inner_join(intervention_variable, by = join_by("intervention_combined_multi" == "intervention_combined")) |> 
  select(id, intervention_cat, selected_input = region_multi_select_separate_values_with_single_vertical_bar) |> 
  separate_rows(selected_input, sep = "\\|") |> 
  filter(!is.na(selected_input))
  
option1 |> 
  count(selected_input, intervention_cat, sort = TRUE) |> 
  
  mutate(dodged_position = n + (max(n) * 0.02)) |> 
  mutate(intervention_cat = fct_relevel(intervention_cat, 
                                        'Multi-domain',
                                        'Underlying risk factors',
                                        'Intermediate risk factors',
                                        'Direct causes', 
                                     )) |> 
  ggplot(aes(n, selected_input, fill = intervention_cat)) +
  geom_col(position = "dodge") +
  geom_text(aes(x = dodged_position, label = n),
            position = position_dodge(width = 0.9),
            size = 5) +
  labs(y = "WHO region",
       x = "Number of studies",
       fill = "",
       title = paste0("Total number of Studies = ", nrow(option1)),
       subtitle = paste0("Unique Study = ", nrow(option1 |> distinct(id)))) +
  scale_x_continuous(
    limits = c(0,500),
    breaks = seq(0,500, 100)
  ) +
  scale_fill_manual(values = color_palette) +
  guides(fill = guide_legend(reverse = T)) +
  theme_few() +
  theme(legend.position = "bottom")

## Warning: Removed 2 rows containing missing values (`geom_col()`).

## Warning: Removed 2 rows containing missing values (`geom_text()`).

# option2 : NOT allowing the multiple WHO region codes (# of observation == # of studies)
option2 <- dataset |> 
  separate_rows(intervention_combined, outcome_combined, sep = ";") |> 
  select(-intervention, -outcome) |>
  filter(intervention_combined != "No data" & outcome_combined != "No data") |> 
  group_by(id) |> 
  mutate(rowid = row_number(),
         arms_id = paste0(id, "_",rowid)) |>
  ungroup() |> 
  separate_rows(intervention_combined, sep = "\\|") |> 
  distinct(id, intervention_combined, .keep_all = T) |> 
  group_by(id) %>%
  mutate(intervention_combined = paste0(intervention_combined, collapse = ";")) |>
  distinct(id, .keep_all = T) |> 
  ungroup() |> 
  mutate(n = str_count(intervention_combined, ";") + 1) |> 
  mutate(intervention_combined_multi = ifelse(n == 1, intervention_combined, "Multi-component")) |> 
  dplyr::select(-n) |> 
  inner_join(intervention_variable, by = join_by("intervention_combined_multi" == "intervention_combined")) |> 
  select(id, intervention_cat, selected_input = region_multi_select_separate_values_with_single_vertical_bar) |> 
  mutate(selected_input = if_else(str_detect(selected_input, "\\|"), "Multi-regions", selected_input)) |> 
  filter(!is.na(selected_input))

option2 |> 
  count(selected_input, intervention_cat, sort = TRUE) |> 
  mutate(dodged_position = n + (max(n) * 0.02)) |> 
  mutate(selected_input = fct_relevel(selected_input, "Multi-regions", after = 0)) |> 
  mutate(intervention_cat = fct_relevel(intervention_cat, 
                                        'Multi-domain',
                                        'Underlying risk factors',
                                        'Intermediate risk factors',
                                        'Direct causes', 
                                     )) |> 
  ggplot(aes(n, selected_input, fill = intervention_cat)) +
  geom_col(position = "dodge") +
  geom_text(aes(x = dodged_position, label = n),
            position = position_dodge(width = 0.9),
            size = 5) +
  labs(y = "WHO region",
       x = "Number of studies",
       fill = "",
       title = paste0("Total number of Studies = ", nrow(option2)),
       subtitle = paste0("Unique Study = ", nrow(option2 |> distinct(id)))) +
  scale_x_continuous(
    limits = c(0,500),
    breaks = seq(0,500, 100)
  ) +
  scale_fill_manual(values = color_palette) +
  guides(fill = guide_legend(reverse = T)) +
  theme_few() +
  theme(legend.position = "bottom")

EGM custom coding

Figure 8 - Disease targeted

Based on the intention of the intervention, select one or more from the list below, > Malaria > TB > HIV > Helminth / worms > CRP / AGP > Obesity (includes weight) > Other parasites > Does not target a disease Note: If an intervention targets one disease, but measures outcome for another disease (example: HIV intervention, measuring Malaria outcomes), select BOTH.

# Function to insert line breaks for long labels
insert_line_breaks <- function(labels, max_length = 10) {
  sapply(labels, function(label) {
    # Split the label at spaces, keeping slashes with the preceding word
    words <- unlist(strsplit(label, "(?<=/)|\\s", perl = TRUE))
    new_label <- ""
    current_line <- ""
    
    for (word in words) {
      # Check if adding the next word would exceed the max length
      if (nchar(current_line) + nchar(word) + 1 <= max_length) {
        current_line <- paste(current_line, word, sep = "")
      } else {
        # Append the current line to the label and start a new line
        new_label <- paste(new_label, current_line, sep = "\n")
        current_line <- word
      }
    }
    
    # Append any remaining words
    new_label <- paste(new_label, current_line, sep = "\n")
    
    # Trim leading and trailing whitespace and return
    return(trimws(new_label))
  })
}

egm_data |> 
  select(record_id, study_design_multi_select_separate_values_with_single_vertical_bar:cost_evidence_text) |> 
  select(selected_input = disease_targeted_multi_select_separate_values_with_single_vertical_bar) |>
  separate_rows(selected_input, sep = "\\|") |> 
  count(selected_input, sort = TRUE) |> 
  filter(!is.na(selected_input)) |> 
  mutate(selected_input = insert_line_breaks(selected_input)) |> 
  mutate(selected_input = fct_reorder(selected_input, -n),
         selected_input = fct_relevel(selected_input, "Doesnot\ntargeta\ndisease", after = Inf)) |> 
  ggplot(aes(x = selected_input, y = n)) +
  geom_text(aes(label = n),
            color = "black",
            vjust = -0.3,
            size = 6) +
  geom_col(fill = "#153A80") +
  scale_y_continuous(
    limits = c(0, 1600),
    breaks = seq(0, 1600, by = 200)) +
  labs(y = "Number of Studies",
       x = "") +
  ggthemes::theme_few() +
  theme(axis.text.x = element_text(size = 13))

Figure 9 - Age

Based on the participants of the study for which the OUTCOMES were measured (NOT the population that were targeted by the interventions), select one or more from the dropdown list. > Infant (0-6 mo) > Older infant (7-23) > Young child (24-59 mo) > Child (60 mo-12 yrs) > Adolescent (13 -19 yrs) > Adult (>19 yrs) > Not specified or entire population If the study mentions age group (e.g. adolescent) without specifing numeric age, choose the option that matches the closest

-> Need to confirm how to deal with Young adolescent and Older adolescent

egm_data |> 
  filter(record_type  == "ier") |> 
  select(record_id, study_design_multi_select_separate_values_with_single_vertical_bar:cost_evidence_text) |> 
  select(selected_input = age_multi_select_separate_values_with_single_vertical_bar) |>
  separate_rows(selected_input, sep = "\\|") |> 
  count(selected_input, sort = TRUE) |> 
  filter(str_detect(selected_input, "dole")) |> 
  filter(!is.na(selected_input)) |> 
  mutate(selected_input = str_remove_all(selected_input, "\\s+\\(.*$")) |> 
  mutate(selected_input = case_when(selected_input == "Young adolescent" ~ "Young adolescents",
                                    selected_input == "Older adolescent" ~ "Older adolescents")) |> 
  mutate(selected_input = fct_relevel(selected_input,
                                 "Infant",
                                 "Older infant",
                                 "Young child",
                                 "Child",
                                 "Young adolescent",
                                 "Older adolescent",
                                 "Adolescent",
                                 "Adults",
                                 "Unspecified/entire population")) |> 
  ggplot(aes(x = selected_input, y = n)) +
  geom_text(aes(label = n),
            color = "black",
            vjust = -0.3,
            size = 6) +
  geom_col(fill = "#153A80") +
  labs(y = "Number of Studies",
       x = "") +
  ggthemes::theme_few() +
  theme(axis.text.x = element_text(size = 13))

## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `selected_input = fct_relevel(...)`.
## Caused by warning:
## ! 9 unknown levels in `f`: Infant, Older infant, Young child, Child, Young
## adolescent, Older adolescent, Adolescent, Adults, and Unspecified/entire
## population

Figure 10 - Gender and reproductive status

Based on the participants of the study that were targeted by the INTERVENTION, select one or more from the dropdown list, > Not specified or entired population > Men > Women (unspecified/general) > Pregnant women > Lactating women > Non-pregnant/ lactating women > Women of reproductive age [15-49 yrs] > Adolescent girls [10-19 yrs]

egm_data |> 
  filter(record_type  == "ier") |> 
  select(record_id, study_design_multi_select_separate_values_with_single_vertical_bar:cost_evidence_text) |> 
  select(selected_input = gender_and_reproductive_status_multi_select_separate_values_with_single_vertical_bar) |>
  separate_rows(selected_input, sep = "\\|") |> 
  count(selected_input, sort = TRUE) |> 
  filter(!is.na(selected_input)) |> 
  mutate(selected_input = case_when(selected_input == "Unspecified/entire population" ~ "Unspecified",
                                    selected_input == "Women of reproductive age" ~ "Women of\nreproductive \nage",
                                    selected_input == "Pregnant women" ~ "Pregnant\nwomen",
                                    selected_input == "Women (unspecified)" ~ "Women\n(unspecified)",
                                    selected_input == "Lactating women" ~ "Lactating\nwomen",
                                    selected_input == "Adolescent girls" ~ "Adolescent\ngirls",
                                    TRUE ~ selected_input)
         ) |> 
  mutate(selected_input = fct_reorder(selected_input, -n),
         selected_input = fct_relevel(selected_input, "Unspecified", after = Inf)) %>%
  ggplot(aes(x = selected_input, y = n)) +
  geom_text(aes(label = n),
            color = "black",
            vjust = -0.3,
            size = 6) +
  geom_col(fill = "#153A80") +
  scale_y_continuous(
    limits = c(0, 1400),
    breaks = seq(0, 1400, by = 200)) +
  labs(y = "Number of Studies",
       x = "") +
  ggthemes::theme_few() +
  theme(axis.text.x = element_text(size = 13))