From c93f6f82165927475a8cc1552ed2ecb3de1ad270 Mon Sep 17 00:00:00 2001 From: Ernest Guevarra Date: Sat, 17 Dec 2022 08:16:15 +0000 Subject: [PATCH] finalise results outputs --- .gitignore | 4 +- R/bootstrap_indicators.R | 295 +++++++++++- R/calculate_province_estimates.R | 43 ++ R/clean_data.R | 1 + R/create_indicator_list.R | 768 ++++++++++++++++++++++++++++++ R/create_results_tables_xlsx.R | 29 ++ R/create_sofala_population.R | 31 +- R/interpolate_indicators.R | 206 ++++++++ R/plot_choropleth.R | 90 ++++ R/plot_maps.R | 311 ++++++++++++ R/recode_anthro_child.R | 9 +- R/recode_anthro_mother.R | 11 +- R/recode_diarrhoea.R | 2 +- R/recode_food_groups.R | 55 ++- R/recode_hygiene.R | 38 +- R/recode_mental_health.R | 52 +- R/recode_mother_characteristics.R | 5 +- R/recode_natal_care.R | 4 +- R/recode_pica.R | 5 +- R/recode_sanitation.R | 11 +- R/recode_vita.R | 8 +- R/recode_water.R | 29 +- R/restructure_results_tables.R | 115 +++++ _targets.R | 429 +++++++++++++++-- 24 files changed, 2430 insertions(+), 121 deletions(-) create mode 100644 R/calculate_province_estimates.R create mode 100644 R/create_indicator_list.R create mode 100644 R/create_results_tables_xlsx.R create mode 100644 R/interpolate_indicators.R create mode 100644 R/plot_choropleth.R create mode 100644 R/plot_maps.R create mode 100644 R/restructure_results_tables.R diff --git a/.gitignore b/.gitignore index 63d8191..7afae12 100644 --- a/.gitignore +++ b/.gitignore @@ -16,6 +16,8 @@ outputs !outputs/.gitkeep !outputs/data_processing_report.html !outputs/s3m_recoded_data.csv -!outputs.s3m_recoded_data.xlsx +!outputs/s3m_recoded_data.xlsx +!outputs/choropleth/.gitkeep +!outputs/interpolation/.gitkeep _targets Rplots.pdf diff --git a/R/bootstrap_indicators.R b/R/bootstrap_indicators.R index fe814de..451f513 100644 --- a/R/bootstrap_indicators.R +++ b/R/bootstrap_indicators.R @@ -25,9 +25,11 @@ ################################################################################ boot_estimate <- function(.data, - w, + w, + statistic = bbw::bootClassic, vars, labs, + indicator_set, replicates = 399) { currentDF <- .data[c("spid", "ea_code", "district", vars)] |> (\(x) x[!is.na(x$spid) & x$spid != 0, ])() @@ -47,7 +49,7 @@ boot_estimate <- function(.data, temp <- bbw::bootBW( x = currentDF, w = w, - statistic = bbw::bootClassic, + statistic = statistic, params = params, outputColumns = outputColumns, replicates = replicates @@ -60,35 +62,308 @@ boot_estimate <- function(.data, probs = c(0.5, 0.025, 0.975), na.rm = TRUE ) + se <- apply( + X = temp, + MARGIN = 2, + FUN = sd + ) + est <- t(est) - est <- data.frame(unique(currentDF$district), labs, est) + est <- data.frame( + unique(currentDF$district), indicator_set, vars, labs, est, se + ) row.names(est) <- 1:nrow(est) - names(est) <- c("district", "indicators", "estimate", "lcl", "ucl") + names(est) <- c( + "district", "indicator_set", "indicator_variable", + "indicator", "estimate", "lcl", "ucl", "sd" + ) est } +## Bootstrap estimation by district -------------------------------------------- boot_estimates <- function(.data, - w, vars, labs, + w, + statistic = bbw::bootClassic, + vars, labs, indicator_set, replicates = 399) { - .data <- split(x = .data, f = .data$district) - w <- rep(list(w), length(.data)) - vars <- rep(list(vars), length(.data)) - labs <- rep(list(labs), length(.data)) + .data <- split(x = .data, f = .data$district) + w <- rep(list(w), length(.data)) + statistic <- rep(list(statistic), length(.data)) + vars <- rep(list(vars), length(.data)) + labs <- rep(list(labs), length(.data)) + indicator_set <- rep(list(indicator_set), length(.data)) parallel::mcMap( f = boot_estimate, .data = .data, w = w, + statistic = statistic, vars = vars, labs = labs, + indicator_set = indicator_set, replicates = replicates, mc.cores = 4 ) |> - (\(x) do.call(rbind, x))() + (\(x) do.call(rbind, x))() |> + (\(x) { row.names(x) <- 1:nrow(x); x })() +} + +## Specific bootstrap functions for household indicators groups/sets ----------- + +boot_estimates_household <- function(.data, w, + replicates = 399, + indicator_list) { + boot_estimates( + .data = .data, + w = w, + vars = indicator_list[["indicator_variable"]], + labs = indicator_list[["indicator"]], + + indicator_set = indicator_list[["indicator_set"]], + replicates = replicates + ) +} + +## Specific bootstrap functions for carer indicators groups/sets --------------- + +boot_estimates_carer <- function(.data, w, + replicates = 399, indicator_list) { + boot_estimates( + .data = .data, + w = w, + vars = indicator_list[["indicator_variable"]], + labs = indicator_list[["indicator"]], + indicator_set = indicator_list[["indicator_set"]], + replicates = replicates + ) } +## Specific bootstrap functions for woman indicators groups/sets --------------- + +boot_estimates_woman <- function(.data, w, + replicates = 399, indicator_list) { + boot_estimates( + .data = .data, + w = w, + vars = indicator_list[["indicator_variable"]], + labs = indicator_list[["indicator"]], + indicator_set = indicator_list[["indicator_set"]], + replicates = replicates + ) +} + +## Specific bootstrap functions for child indicators groups/sets --------------- + +boot_estimates_child <- function(.data, w, + replicates = 399, indicator_list) { + boot_estimates( + .data = .data, + w = w, + vars = indicator_list[["indicator_variable"]], + labs = indicator_list[["indicator"]], + indicator_set = indicator_list[["indicator_set"]], + replicates = replicates + ) +} + +## Bootstrap probit a single district ------------------------------------------ + +boot_probit <- function(.data, + w, + vars, + labs, + indicator_set, + THRESHOLD, + replicates = 399) { + currentDF <- .data[c("spid", "ea_code", "district", vars[1:2])] |> + (\(x) x[!is.na(x$spid) & x$spid != 0, ])() + + ## + params <- vars[1:2] + + ## Rename "eid" to psu + colnames(currentDF)[1] <- "psu" + + w <- w[w$psu %in% currentDF$psu, ] + + ## + outputColumns <- params + + bootPROBIT <- function(x, params, threshold = THRESHOLD) { + d <- x[[params[1]]] + m <- median(d, na.rm = TRUE) + s <- IQR(d, na.rm = TRUE) / 1.34898 + x <- pnorm(q = threshold, mean = m, sd = s) + return(x) + } + + ## + temp <- bbw::bootBW( + x = currentDF, + w = w, + statistic = bootPROBIT, + params = params, + outputColumns = outputColumns, + replicates = replicates + ) + + temp <- data.frame( + global = temp[[1]], + moderate = temp[[1]] - temp[[2]], + severe = temp[[2]] + ) + + est <- apply( + X = temp, + MARGIN = 2, + FUN = quantile, + probs = c(0.5, 0.025, 0.975), na.rm = TRUE + ) + + se <- apply( + X = temp, + MARGIN = 2, + FUN = sd + ) + + est <- t(est) + + vars <- ifelse( + unique(vars) == "hfaz", + c("global_stunting", "moderate_stunting", "severe_stunting"), + ifelse( + unique(vars) == "wfaz", + c("global_underweight", "moderate_underweight", "severe_underweight"), + ifelse( + unique(vars) == "wfhz", + c("global_wasting_whz", "moderate_wasting_whz", "severe_wasting_whz"), + c("global_wasting_muac", "moderate_wasting_muac", "severe_wasting_muac") + ) + ) + ) + + est <- data.frame( + unique(currentDF$district), indicator_set, vars, labs, est, se + ) + + row.names(est) <- 1:nrow(est) + + names(est) <- c( + "district", "indicator_set", "indicator_variable", + "indicator", "estimate", "lcl", "ucl", "sd" + ) + + est +} + +## Bootstrap probit all districts ---------------------------------------------- + +boot_probits_anthro <- function(.data, + w, + vars, + labs, + indicator_set, + THRESHOLD, + replicates = 399) { + # vars <- c("hfaz", "hfaz", "wfaz", "wfaz", "wfhz", "wfhz", "cmuac", "cmuac") + # labs <- c( + # "Global stunting", "Severe stunting", + # "Global underweight", "Severe underweight", + # "Global wasting by weight-for-height z-score", + # "Severe wasting by weight-for-height z-score", + # "Global wasting by MUAC", "Severe wasting by MUAC" + # ) + # indicator_set <- rep("Child nutritional status", 8) + + .data <- split(x = .data, f = .data$district) + w <- rep(list(w), length(.data)) + vars <- rep(list(vars), length(.data)) + labs <- rep(list(labs), length(.data)) + indicator_set <- rep(list(indicator_set), length(.data)) + THRESHOLD <- rep(list(THRESHOLD), length(.data)) + + parallel::mcMap( + f = boot_probit, + .data = .data, + w = w, + vars = vars, + labs = labs, + indicator_set = indicator_set, + THRESHOLD = THRESHOLD, + replicates = replicates, + mc.cores = 4 + ) |> + (\(x) do.call(rbind, x))() |> + (\(x) { row.names(x) <- 1:nrow(x); x })() +} + + +boot_probits_stunting <- function(.data, w, replicates = 399) { + boot_probits_anthro( + .data = .data, + w = w, + vars = rep("hfaz", 3), + labs = c( + "Proportion of children 6-59 months old with height-for-age z-score less than -2", + "Proportion of children 6-59 momths old with height-for-age z-score less than -2 and greater than or equal to -3", + "Proportion of children 6-59 months old with height-for-age z-score less than -3" + ), + indicator_set = rep("Child nutritional status", 3), + THRESHOLD = c(-2, -3), + replicates = replicates + ) +} + + +boot_probits_underweight <- function(.data, w, replicates = 399) { + boot_probits_anthro( + .data = .data, + w = w, + vars = rep("wfaz", 3), + labs = c( + "Proportion of children 6-59 months old with weight-for-age z-score less than -2", + "Proportion of children 6-59 momths old with weight-for-age z-score less than -2 and greater than or equal to -3", + "Proportion of children 6-59 months old with weight-for-age z-score less than -3" + ), + indicator_set = rep("Child nutritional status", 3), + THRESHOLD = c(-2, -3), + replicates = replicates + ) +} + +boot_probits_whz <- function(.data, w, replicates = 399) { + boot_probits_anthro( + .data = .data, + w = w, + vars = rep("wfhz", 3), + labs = c( + "Proportion of children 6-59 months old with weight-for-height z-score less than -2", + "Proportion of children 6-59 momths old with weight-for-height z-score less than -2 and greater than or equal to -3", + "Proportion of children 6-59 months old with weight-for-height z-score less than -3" + ), + indicator_set = rep("Child nutritional status", 3), + THRESHOLD = c(-2, -3), + replicates = replicates + ) +} + +boot_probits_muac <- function(.data, w, replicates = 399) { + boot_probits_anthro( + .data = .data, + w = w, + vars = rep("cmuac", 3), + labs = c( + "Proportion of children 6-59 months old with mid-upper arm circumference less than 12.5 cms", + "Proportion of children 6-59 momths old with mid-upper arm circumference less than 12.5 cms and greater than or equal to 11.5 cms", + "Proportion of children 6-59 months old with mid-upper arm circumference less than 11.5 cms" + ), + indicator_set = rep("Child nutritional status", 3), + THRESHOLD = c(12.5, 11.5), + replicates = replicates + ) +} \ No newline at end of file diff --git a/R/calculate_province_estimates.R b/R/calculate_province_estimates.R new file mode 100644 index 0000000..82f7986 --- /dev/null +++ b/R/calculate_province_estimates.R @@ -0,0 +1,43 @@ +################################################################################ +# +#' +#' Calculate province estimates +#' +# +################################################################################ + +calculate_province_estimate <- function(df, pop) { + merge(df, pop) |> + dplyr::summarise( + indicator_set = unique(indicator_set), + indicator_variable = unique(indicator_variable), + indicator = unique(indicator), + estimate = sum(estimate * population, na.rm = TRUE) / sum(population), + se = sqrt(sum(sd ^ 2 * population / sum(population, na.rm = TRUE), na.rm = TRUE)), + lcl = estimate - 1.96 * se, + ucl = estimate + 1.96 * se + ) |> + dplyr::relocate(se, .after = ucl) +} + +## Calculate province estimates for all indicators ----------------------------- + +calculate_province_estimates <- function(results_table, pop) { + df_list <- split( + x = results_table, + f = factor( + x = results_table[["indicator"]], + levels = unique(results_table[["indicator"]]) + ) + ) + + pop <- rep(list(pop), length(df_list)) + + Map( + f = calculate_province_estimate, + df = df_list, + pop = pop + ) |> + dplyr::bind_rows() +} + diff --git a/R/clean_data.R b/R/clean_data.R index eb4e29f..8ac684b 100644 --- a/R/clean_data.R +++ b/R/clean_data.R @@ -26,6 +26,7 @@ clean_raw_data <- function(raw_data, survey_codebook, survey_questions) { cweight1 = ifelse(flag == 1, cpeso1, cpeso), cheight1 = ifelse(flag == 1, caltura1, caltura), cmuac1 = ifelse(flag == 1, cbraco1, cbraco), + oedema = as.integer(oedema), age_years = ((as.Date(today) - as.Date(child_dob)) / 365.25) |> as.numeric(), age_months = ((as.Date(today) - as.Date(child_dob)) / (365.25 / 12)) |> diff --git a/R/create_indicator_list.R b/R/create_indicator_list.R new file mode 100644 index 0000000..fae6390 --- /dev/null +++ b/R/create_indicator_list.R @@ -0,0 +1,768 @@ +################################################################################ +# +#' +#' Create indicator list +#' +# +################################################################################ + +create_indicator_list <- function(id = c("household", "carer", "woman", "child")) { + id <- match.arg(id) + + # Household indicators ------------------------------------------------------- + if (id == "household") { + ## Variable names ---------------------------------------------------------- + vars <- c( + "hh_size", paste0("roof_type_", 1:9), paste0("floor_type_", 1:9), + "overcrowded", "own_home", "electricity", paste0("cooking_fuel_", 1:8), + paste0("lighting_fuel_", 1:7), paste0("cooking_location_", 1:3), + "separate_kitchen", "radio", "tv", "cellphone", "computer", "bicycle", + "motorcycle", "motorcar", "fridge", "food_preserver", + "association_member", "association_presentation_attendance", + "association_member_participant", "presentation_facilitator_1", + "presentation_facilitator_2", "association_information_usage", + "q07FamilyPlanning", "q07FoodNutrition", "q07Health", "q07Hygiene", + "q07Latrines", "q07SocialProtection", "q07Vaccine", "q07WaterTreatment", + "q07Other", "q07Any", + paste0("ge", 1:10) |> + lapply(FUN = paste0, c("_men", "_women", "_both")) |> + unlist(), + paste0("water_", c( + "surface", "unimproved", "limited", "basic", "sufficient") + ), + paste0("water_sufficient_reasons_", 1:3), + "water_collection_time", "water_filter_use", "water_filter_adequate", + paste0("san_", c("open", "unimproved", "limited", "basic")), + "hygiene_wash_recent", paste0("handwash_event_", 1:6), + paste0( + "hygiene_", + c("wash_appropriate", "child_defecation") + ), + paste0("diaper_disposal_", 1:8), "hygiene_child_diaper", + "hdds", "fcs", "fcs_poor", "fcs_borderline", "fcs_acceptable", + "rcsi", "rcsi_minimal", "rcsi_stressed", "rcsi_crisis", + "lcsi", "lcsi_secure", "lcsi_stress", "lcsi_crisis", "lcsi_emergency", + paste0("corn_", 0:4), paste0("rice_", 0:4), paste0("millet_", 0:4), + paste0("sorghum_", 0:4), paste0("cassava_", 0:4), + paste0("sweet_potato_", 0:4), paste0("legumes_", 0:4), + "net_any", "net_adequate", paste0("net", 1:4) + ) + ## Labels ------------------------------------------------------------------ + labs <- c( + "Mean household size", + paste0("Proportion of households with roof made of ", + c("cane/leaf/straw/grass", "zinc", "luzalite", "aluminium", "wood", + "cement", "plastic", "calamine", "other") + ), + paste0("Proportion of households with floor made of ", + c("earth/sand", "dung", "wood planks", "palm/bamboo", + "parquet or polished wood", "vinyl or asphalt strips", + "ceramic tiles", "cement", "carpet") + ), + "Proportion of households that are overcrowded", + "Proportion of households who own the home they live in", + "Proportion of households with electricity", + paste0("Proportion of households by type of cooking fuel - ", + c("Electricity", "Gas", "Paraffin", "Wood", "Coal/charcoal", "Solar", + "Dung", "Other") + ), + paste0("Proportion of households by type of lighting fuel - ", + c("Electricity", "Gas", "Paraffin", "Candles", "Solar", "Flashlight", + "Other") + ), + "Proportion of households that cook food inside the house", + "Proportion of households that cook in a separate house or hut", + "Proportion of households that cook food outside the house", + "Proportion of households that have a separate kitchen", + paste0("Proportion of households that own a ", + c("radio", "television", "cellphone", "computer", "bicycle", + "motorcycle", "motorcar", "fridge", "food preserver") + ), + "Proportion of households with a member who is part of a community association within the past year", + "Proportion of households with a member who participated in a community association presentation within the past year", + "Proportion of households with a member who is either a part of a community association or participated in a community association presentation in the past year", + "Community association presentation facilitated by a non-governmental organisation", + "Community association presentation facilitated by a government health institution", + "Proportion of households with a member who has used the information obtained from community association presentations", + "Proportion of households with a member who participated in family planning community activities", + "Proportion of households with a member who participated in food and nutrition community activities", + "Proportion of households with a member who participated in health community activities", + "Proportion of households with a member who participated in hygiene community activities", + "Proportion of households with a member who participated in latrines-building community activities", + "Proportion of households with a member who participated in social protection community activities", + "Proportion of households with a member who participated in vaccination community activities", + "Proportion of households with a member who participated in water treatment community activities", + "Proportion of households with a member who participated in other community activities", + "Proportion of households with a member who participated in any community activities", + "Proportion of households in which men decide the appropriate age to marry", + "Proportion of households in which women decide the appropriate age to marry", + "Proportion of households in which both men and women decide the appropriate age to marry", + "Proportion of households in which men decide the use of condoms", + "Proportion of households in which women decide the use of condoms", + "Proportion of households in which both men and women decide the use of condoms", + "Proportion of households in which men decide on household responsibilities", + "Proportion of households in which women decide on household responsibilities", + "Proportion of households in which both men and women decide on household responsibilities", + "Proportion of households in which men decide on the number of children to have", + "Proportion of households in which women decide on the number of children to have", + "Proportion of households in which both men and women decide on the number of children to have", + "Proportion of households in which men decide on family/land chores", + "Proportion of households in which women decide on family/land chores", + "Proportion of households in which both men and women decide on family/land chores", + "Proportion of households in which men decide on the administrative of finances", + "Proportion of households in which women decide on the administration of finances", + "Proportion of households in which both men and women decide on the administration of finances", + "Proportion of households in which men decide on how to raise children", + "Proportion of households in which women decide on how to raise children", + "Proportion of households in which both men and women decide on how to raise children", + "Proportion of households in which men decide on hitting/spanking children", + "Proportion of households in which women decide on hitting/spanking children", + "Proportion of households in which both men and women decide on hitting/spanking children", + "Proportion of households in which men decide on seeking healthcare for pregnancy", + "Proportion of households in which women decide on seeking healthcare for pregnancy", + "Proportion of households in which both men and women decide on seeking healthcare for pregnancy", + "Proportion of households in which men decide on seeking healthcare for child", + "Proportion of households in which women decide on seeking healthcare for child", + "Proportion of households in which both men and women decide on seeking healthcare for child", + "Proportion of households with a surface water source", + "Proportion of households with an unimproved water source", + "Proportion of households with a limited water source", + "Proportion of households with a basic water source", + "Proportion of households with a sufficient water source", + "Proportion of households that have experienced water not being available at the source", + "Proportion of households that have experienced water being too expensive", + "Proportion of households that have experienced water source not being accessible", + "Mean water collection time in minutes", + "Proportion of households that use a water filter", + "Proportion of households that use an adequate water filter", + "Proportion of households that practice open defecation", + "Proportion of households with unimproved toilet facility", + "Proportion of households with limited toilet facility", + "Proportion of households with basic toilet facility", + "Proportion of household respondents who washed their hands recently", + paste0("Proportion of household respondents who report washing their hands ", + c("after using latrine/defecation", + "after cleaning up faeces of children", "before preparing food", + "before giving food to children", "before eating", + "at other instances") + ), + "Proportion of household respondents who washed their hands with soap and water or with ashes recently", + "Proportion of household respondents who recently had their child defecate in an appropriate location", + paste0("Proportion of household respondents by disposal method of soiled diapers - ", + c("Discarded diaper in latrine", + "Washed with water and discarded the water in the latrine", + "Washed with water and discarded the water in the sink", + "Washed with water and discarded water in the yard", + "Discarded the diaper in the trash", + "Discarded the diaper in the yard", + "Buried", "Other") + ), + "Proportion of household respondents who recently washed their child's soiled diapers at the appropriate frequency", + "Mean household dietary diversity score", + "Mean food consumption score", + "Proportion of households with poor food security based on food consumption score", + "Proportion of households with borderline food security based on food consumption score", + "Proportion of households with acceptable food security based on food consumption score", + "Mean reduced coping strategy index", + "Proportion of households with minimal level of food insecurity based on reduced coping strategies index", + "Proportion of households with stressed level of food insecurity based on reduced coping strategies index", + "Proportion of households with crisis level of food insecurity based on reduced coping strategies index", + "Mean livelihoods coping strategy index", + "Proportion of households with secure level of food security based on livelihoods coping strategies index", + "Proportion of households with stressed level of food insecurity based on livelihoods coping strategies index", + "Proportion of households with crisis level of food insecurity based on livelihoods coping strategies index", + "Proportion of households with emergency level of food insecurity based on livelihoods coping strategies index", + "Proportion of households with no corn reserves", + "Proportion of households with less than one month of corn reserves", + "Proportion of households with 1 to 3 months of corn reserves", + "Proportion of households with 4 to 6 months of corn reserves", + "Proportion of households with more than 6 months of corn reserves", + "Proportion of households with no rice reserves", + "Proportion of households with less than one month of rice reserves", + "Proportion of households with 1 to 3 months of rice reserves", + "Proportion of households with 4 to 6 months of rice reserves", + "Proportion of households with more than 6 months of rice reserves", + "Proportion of households with no millet reserves", + "Proportion of households with less than one month of millet reserves", + "Proportion of households with 1 to 3 months of millet reserves", + "Proportion of households with 4 to 6 months of millet reserves", + "Proportion of households with more than 6 months of millet reserves", + "Proportion of households with no sorghum reserves", + "Proportion of households with less than one month of sorghum reserves", + "Proportion of households with 1 to 3 months of sorghum reserves", + "Proportion of households with 4 to 6 months of sorghum reserves", + "Proportion of households with more than 6 months of sorghum reserves", + "Proportion of households with no cassava reserves", + "Proportion of households with less than one month of cassava reserves", + "Proportion of households with 1 to 3 months of cassava reserves", + "Proportion of households with 4 to 6 months of cassava reserves", + "Proportion of households with more than 6 months of cassava reserves", + "Proportion of households with no sweet potato reserves", + "Proportion of households with less than one month of sweet potato reserves", + "Proportion of households with 1 to 3 months of sweet potato reserves", + "Proportion of households with 4 to 6 months of sweet potato reserves", + "Proportion of households with more than 6 months of sweet potato reserves", + "Proportion of households with no legumes reserves", + "Proportion of households with less than one month of legumes reserves", + "Proportion of households with 1 to 3 months of legumes reserves", + "Proportion of households with 4 to 6 months of legumes reserves", + "Proportion of households with more than 6 months of legumes reserves", + "Proportion of households with at least one mosquito net", + "Proportion of households with adequate number of mosquito nets", + "Proportion of households with no mosquito nets", + "Proportion of households with mosquito nets less than the number of beds/sleeping mats", + "Proportion of households with one mosquito net for every bed/sleeping mat", + "Proportion of households with more mosquito nets than the number of beds/sleeping mats" + ) + ## Indicator set ----------------------------------------------------------- + indicator_set <- c( + rep("Housing characteristics", 41), + rep("Household assets", 9), + rep("Household participation in associations", 16), + rep("Household decision making", 30), + rep("Water, sanitation, and hygiene", 33), + "Household dietary diversity score", + rep("Food consumption score", 4), + rep("Reduced coping strategy index", 4), + rep("Livelihoods coping strategies index", 5), + #"Food insecurity experience scale", + rep("Food stocks", 35), + rep("Mosquito net ownership", 6) + ) + + ## Mapping function -------------------------------------------------------- + map_function <- c( + rep("plot_qual_map", 19), "plot_divergent_map", + rep("plot_qual_map", 30), rep("plot_divergent_map", 3), + rep("plot_qual_map", 2), rep("plot_divergent_map", 11), + rep("plot_qual_map", 30), rep("plot_divergent_map", 8), + "plot_qual_map", rep("plot_divergent_map", 72) + ) + + direction <- c( + "lo", rep("hi", 18), "lo", rep("hi", 76), rep("lo", 3), rep("hi", 2), + rep("lo", 4), rep("hi", 2), rep("lo", 3), rep("hi", 15), rep("lo", 2), + rep("hi", 4), "lo", rep("hi", 4), rep("lo", 2), rep("hi", 2), + rep("lo", 5), rep("hi", 2), rep("lo", 3), rep("hi", 2), rep("lo", 3), + rep("hi", 2), rep("lo", 3), rep("hi", 2), rep("lo", 3), rep("hi", 2), + rep("lo", 3), rep("hi", 2), rep("lo", 3), rep("hi", 2) + ) + + pal <- ifelse( + map_function == "plot_qual_map", + "get_qual_colours(n = n)", + "get_div_colours(n = n)" + ) |> + (\(x) + ifelse( + direction == "lo", paste0("rev(", x, ")"), x + ) + )() + + indicator_list <- data.frame( + id = seq_len(length(vars)), + indicator_group = "Household", + indicator_set = indicator_set, + indicator_variable = vars, + indicator = labs#, + #map_function = map_function, + #pal = pal, + #direction = direction + ) + } + + # Carer indicators ----------------------------------------------------------- + if (id == "carer") { + ## Variable names ---------------------------------------------------------- + vars <- c( + paste0("carer_", + c("age", "sex_1", "sex_2", "single", "married", "civil_union", + "divorced_separated", "widowed", "grade1", "grade2", "grade3", "grade4", + "grade5", "grade6", "grade7", "grade8", "grade9", "grade10", + "grade11", "grade12", "professional", "non_college", "college", + "literacy", "with_partner") + ), + paste0("partner_", + c("age", "grade1", "grade2", "grade3", "grade4", "grade5", "grade6", + "grade7", "grade8", "grade9", "grade10", "grade11", "grade12", + "professional", "non_college", "college", "literacy") + ), + paste0("income_source_", 1:6), paste0("income_amount_", 1:9), + paste0("occupation_carer_", 1:6), paste0("occupation_partner_", 1:7), + paste0("travel_modes_town_", 1:11), + paste0("travel_modes_health_facility_", 1:5), + paste0("travel_modes_local_markets_", 1:5), + paste0("travel_modes_water_sources_", 1:5), + paste0("travel_times_", + c("health_facility", "local_markets", "water_sources") + ), + paste0("ccare_danger_", 1:10), "ccare_danger_score", "ccare_participation", + paste0("ccare_barriers_", 1:5), + paste0("play1", letters[1:7]), "play2", paste0("play3", letters[1:6]), + "see", "hear", paste0("pica_frequency_", 1:5), + paste0("pica_response_", 1:5), "pica_perception" + ) + ## Indicator labels -------------------------------------------------------- + labs <- c( + "Mean age of carers", + paste0("Proportion of carers by sex - ", c("Male", "Female")), + paste0("Proportion of carers by marital status - ", + c("Single", "Married", "Civil union", "Divorced/separated", "Widowed") + ), + paste0("Proportion of carers by highest educational attainment - ", + c("Grade 1", "Grade 2", "Grade 3", "Grade 4", "Grade 5", "Grade 6", + "Grade 7", "Grade 8", "Grade 9", "Grade 10", "Grade 11", "Grade 12", + "Professional training", "Non-college degree", "College degree", + "Literacy") + ), + "Proportion of carers who live with their partners", + "Mean age of partners", + paste0("Proportion of partners by highest educational attainment - ", + c("Grade 1", "Grade 2", "Grade 3", "Grade 4", "Grade 5", "Grade 6", + "Grade 7", "Grade 8", "Grade 9", "Grade 10", "Grade 11", "Grade 12", + "Professional training", "Non-college degree", "College degree", + "Literacy") + ), + paste0("Proportion of carers by income source - ", + c("Sale of agricultural products and/or animals", + "Self-employed (commercial, service)", + "Assitência alimentar/ajuda/ganho ganho/biscate", + "Fishing", "Salary, pension, remittance", "Other") + ), + paste0("Proportion of carers by income amount - ", + c("No income/or remittances not declared in money", + "Less than 60-150 Mts per month", + "From Mts 150.01 to Mts 500.00 per month", + "From Mts 500.01 to Mts 1500.00 per month", + "From Mts 1500.01 to Mts 3500.00 per month", + "From Mts 3500.01 to Mts 5500.00 per month", + "From Mts 5500.01 to Mts 7500.00 per month", + "From Mts 7500.01 to Mts 9500.00 per month", + "More than Mts 9500.00 per month") + ), + paste0("Proportion of carers by occupation - ", + c("Homemaker", "Your land", "Fishing", "Wage labor", "Business", "Other") + ), + paste0("Proportion of partners by occupation - ", + c("None", "Your land", "Fishing", "Wage labor", "Business", "Other", + "I do not have a partner/husband") + ), + paste0("Proportion of carers by mode of travel to town - ", + c("On foot", "Bicycle", "Bus", + "My own motorized vehicle (motorcycle, car, etc.)", "Truck", + "I don't travel", "Boat", "Carro chapa", "Chate", "Comboio", "Moto") + ), + paste0("Proportion of carers by mode of travel to health facility - ", + c("On foot", "Bicycle", "Motorcycle", "Car", "Other") + ), + paste0("Proportion of carers by mode of travel to local markets - ", + c("On foot", "Bicycle", "Motorcycle", "Car", "Other") + ), + paste0("Proportion of carers by mode of travel to water source - ", + c("On foot", "Bicycle", "Motorcycle", "Car", "Other") + ), + "Mean travel time in minutes to health facility", + "Mean travel time in minutes to local markets", + "Mean travel time in minutes to water sources", + paste0("Proportion of carers by child danger sign identified - ", + c("Fever", "Blood in stool", "Diarrhoea with dehydration", + "Cough, rapid respiration and/or difficulty breathing", + "Unable to drink water, breastfeed, or eat", "Vomiting", + "Convulsions", "Loss of consciousness", + "Fatigue/no response/not wanting to play", "Neck rigidity") + ), + "Mean number of child danger signs identified by carer", + "Proportion of carers who report that partners support/contribute in taking care of child health care needs", + paste0("Proportion of carers by reported child health care access barriers - ", + c("Distance", "Transport", "Money", "Poor treatment at health facility", "Other") + ), + "Proportion of carers who sing songs for or with their child", + "Proportion of carers who take their child for a walk away from home", + "Proportion of carers who play games with their child", + "Proportion of carers who read books or see photos with their child", + "Proportion of carers who tell stories to their child", + "Proportion of carers who name things around their child", + "Proportion of carers who draw things for or with their child", + "Proportion of carers who provide their child with a bag or a box to keep their things in", + "Proportion of carers who play with their child while giving them a bath", + "Proportion of carers who play with their child when feeding", + "Proportion of carers who play with their child when changing their clothes/diaper", + "Proportion of carers who play with their child while working at home", + "Proportion of carers who play with their child while working in the field", + "Proportion of carers who play with their child during their free time", + "Proportion of carers who report knowing that children can see from birth", + "Proportion of carers who report knowing that children can hear from birth", + paste0("Proportion of carers by the reported frequency of their child eating dirt - ", + c("0 times", "<1 time per day", "Once per day", "2-5 times per day", + "More than 5 times per day") + ), + paste0("Proportion of carers by response to their child eating dirt - ", + c("Stop the child from putting the dirt in their mouth", + "Remove the dirt from the hands/mouth of the child", + "Wash the hands of the child with water only", + "Wash the hands of the child with water and soap/ash", + "Do not do anything") + ), + "Proportion of carers who believe that eating dirt is bad for their child's health" + ) + ## Indicator set ----------------------------------------------------------- + indicator_set <- c( + rep("Carer and partner characteristics", 42), + rep("Carer and partner income and occupation", 28), + rep("Travel modalities and time to travel", 29), + rep("Childcare practices", 17), + rep("Child development", 16), + rep("Pica", 11) + ) + + indicator_list <- data.frame( + id = seq_len(length(vars)), + indicator_group = "Carer", + indicator_set = indicator_set, + indicator_variable = vars, + indicator = labs + ) + } + + # Women indicators ----------------------------------------------------------- + if (id == "woman") { + ## Indicator variables ----------------------------------------------------- + vars <- c( + paste0("delivery_location_", 1:5), "anc_four", "anc_well", "delivery_well", + paste0("delivery_assist_", 1:9), "delivery_return", + paste0("delivery_difficulty_", 1:6), "mother_days_to_pnc", + "mother_pnc_check", paste0("pnc_mother_", 0:3), "child_days_to_pnc", + "child_pnc_check", paste0("pnc_child_", 0:3), "nc_protect", + paste0("pnc_card_", 1:3), "preg_malaria", "preg_anaemia", "preg_more", + paste0("danger_", 1:10), "danger_all", paste0("labor_", 1:6), + paste0("newborn_", 1:8), + "mal_prevalence", "mal_no_treatment", + "mal_appropriate_treatment", "folate", "tt_any", "tt_two_more", + "idk1", "idk2", + paste0("pmtct", 1:3), "fp_use", "fp_wait_time_appropriate", + paste0("benefit_next_", 1:7), paste0("benefit_first_", 1:9), + paste0("multiparity_danger_", 1:9), "fp_wait_abort_appropriate", + "von1_no_choice", "von1_little_choice", "von1_some_choice", + "von1_lots_choices", "von2_no", "von2_little", "von2_enough", + "von2_a_lot", "von3_never", "von3_sometimes", "von3_almost", + "von3_always", "von4_freely", "von4_freely_consent", + "von4_husband_consent", "von4_someone_consent", + paste0("phq_", c("no_depression", "minimal_to_mild", "major", "severe")), + paste0("alcohol_frequency_", 1:5), "wdds", "mddw", + "bmi", "bmi_underweight", "bmi_overweight", "bmi_obese", + "muac_undernutrition" + ) + ## Indicator labels -------------------------------------------------------- + labs <- c( + paste0("Proportion of women of reproductive age by delivery location for her youngest child - ", + c("Health facility/hospital", "In your own house", + "The house of a traditional birth attendant", + "House of a neighbour/family member", "Other") + ), + "Proportion of women of reproductive age who attended at least 4 antenatal care visits during pregnancy for youngest child", + "Proportion of women of reproductive age who report being treated well during antenatal care visits", + "Proportion of women of reproductive age who report being treated well during delivery for youngest child", + paste0("Proportion of women of reproductive age by the person who assisted during delivery for her youngest child - ", + c("Doctor", "Nurse", "Midwife", "Other person", "Traditional midwife", + "Community health worker", "Relative/friend", "Other", "Nobody") + ), + "Proportion of women of reproductive age who report that they will come back to health facility for their next delivery", + paste0("Proportion of women of reproductive age by difficulties in delivery reported - ", + c("Cost", "Distance", "Stigma (shame)", "Poor roads", "Other", "No") + ), + "Mean number of days until post-natal check sought by woman of reproductive age after delivery of her youngest child", + "Proportion of women of reproductive age who received post-natal check", + "Proportion of women of reproductive age who didn't receive post-natal check", + "Proportion of women of reproductive age who received post-natal check immediately after delivery", + "Proportion of women of reproductive age who received post-natal check within 24 hours of delivery", + "Proportion of women of reproductive age who received post-natal check more than 24 hours after delivery", + "Mean number of days until post-natal check sought by woman of reproductive age for child after delivery", + "Proportion of women of reproductive age whose youngest child received post-natal check", + "Proportion of women of reproductive age whose youngest child didn't receive post-natal check", + "Proportion of women of reproductive age whose youngest child received post-natal check immediately after delivery", + "Proportion of women of reproductive age whose youngest child received post-natal check within 24 hours of delivery", + "Proportion of women of reproductive age whose youngest child received post-natal check more than 24 hours after delivery", + "Proportion of women of reproductive age whose youngest child was protected from cold after delivery", + "Proportion of pregnant women who are able to show her pre-natal card", + "Proportion of pregnant women who report having a pre-natal card but are not able to show it", + "Proportion of pregnant women who do not have a pre-natal card", + "Proportion of pregnant women who report having had malaria", + "Proportion of pregnant women who report having anaemia", + "Proportion of pregnant women who report wanting to have more children after current pregnancy", + paste0("Proportion of pregnant women by pregnancy danger signs identified - ", + c("Bleeding or vaginal fluid", "Severe headache", "Blurry vision", + "Swollen hands and feet", "Convulsions", "Fever", "Intense abdominal pain", + "Loss of consciousness", "Fatigue", "Accelerated/diminished fetal movement") + ), + "Proportion of pregnant women who are able to identify all ten pregnancy danger signs", + paste0("Proportion of pregnant women by actions they will take during labour - ", + c("Go to the closest hospital", "Ask a nearby relative/family member/neighbour to come help", + "Call a traditional birth attendant", "Stay alone with your husband/partner", + "Stay all alone", "Other") + ), + paste0("Proportion of pregnant women by newborn danger signs identified - ", + c("Difficulty breathing", "Jaundice (yellow eyes/skin)", + "Poor feeding", "Fever/warm body", "Cold body", "Convulsions", + "Vomiting", "Lack of stooling") + ), + "Proportion of women of reproductive age who had malaria during their pregnancy for their youngest child", + "Proportion of women of reproductive age who didn't receive treatment for malaria during their pregnancy for their youngest child", + "Proportion of women of reproductive age who received appropriate treatment for malaria during their pregnancy for their youngest child", + "Proportion of women of reproductive age who received folate tablets during their pregnancy for their youngest child", + "Proportion of women of reproductive age who received any dose of tetanus toxoid vaccination during their pregnancy for their youngest child", + "Proportion of women of reproductive age who received two or more doses of tetanus toxoid vaccination during their pregnancy for their youngest child", + "Proportion of women of reproductive age who received mosquito net during their most recent pregnancy", + "Proportion of women of reproductive age who slept under a mosquito net during their most recent pregnancy", + "Proportion of women of reproductive age who received voluntary counselling and testing during her pregnancy for her youngest child or her current pregnancy", + "Proportion of women of reproductive age who received their voluntary counselling and testing results during her pregnancy for her youngest child or her current pregnancy", + "Proportion of women of reproductive age who were offered medication to lower the risk of child transmission during her pregnancy for her youngest child or her current pregnancy", + "Proportion of women of reproductive age who have used or tried a method to delay or avoid pregnancy", + "Proportion of women of reproductive age who know the appropriate/ideal waiting time after birth before trying to get pregnant again", + paste0("Proportion of women of reproductive age by reported benefits of waiting for next pregnancy - ", + c("Less risk to the health of the mother", + "Less risk to the health of the child", + "Avoid poverty", + "More probability that your children will be educated", + "Other", + "None", + "Growth/development") + ), + paste0("Proportion of women of reproductive age by reported benefits of waiting until after 18 years before getting pregnant - ", + c("Less risk to the health of the mother", + "Less risk to the health of the child", + "Avoid poverty", + "More probability that your children will be educated", + "Other", + "None", + "Education", "Birth complications", "Growth/development") + ), + paste0("Proportion of women of reproductive age by reported dangers of having more than 4 children - ", + c("Maternal mortality", + "Death of the baby", + "Poverty", + "Less probability that the children will be educated", + "Other", + "None", "Maternal morbidity", "Birth complications", "It depends") + ), + "Proportion of women of reproductive age who know the appropriate/ideal waiting time to get pregnant after a spontaneous abortion", + paste0("Proportion of women of reproductive age by levels of freedom of choice they feel they have on what happens to their lives - ", + c("No choice", "Little choice", "Some choice", "A lot of choice") + ), + paste0("Proportion of women of reproductive age by levels they feel they can decide their own destiny - ", + c("Not at all", "A little", "Enough", "A lot") + ), + paste0("Proportion of women of reproductive age by levels of ability to decide by themselves without consulting their husbands - ", + c("Never", "Sometimes", "Almost always", "Always") + ), + paste0("Proportion of women of reproductive age by levels of participation in this survey - ", + c("I accepted to participate voluntarily and freely", + "Yes, but I need the consent of the male head of household", + "No, I needed the consent of the male head of household", + "I need someone else's consent") + ), + "Proportion of women of reproductive age who have no depression", + "Proportion of women of reproductive age who have minimal to mild depression", + "Proportion of women of reproductive age who have major depression", + "Proportion of women of reproductive age who have severe depression", + paste0("Proportion of women of reproductive age by frequency of alcohol consumption - ", + c("Never", "Monthly or less", "Between 2-4 times per month", + "Between 2-3 times per week", "4 or more times per week") + ), + "Mean women's dietary diversity score", + "Proportion of women of reproductive age who consumed at least 5 food groups in the last 24 hours", + "Mean women's body mass index", + "Proportion of women of reproductive age who are underweight based on body mass index", + "Proportion of women of reproductive age who are overweight based on body mass index", + "Proportion of women of reproductive age who are obese based on body mass index", + "Proportion of women of reproductive age who are wasted based on mid-upper arm circumference" + ) + ## Indicator set ----------------------------------------------------------- + indicator_set <- c( + rep("Pre-natal, natal and post-natal care", 37), + rep("Treatment and services during pregnancy", 39), + rep("Prevention of mother to child transmission", 3), + rep("Family planning", 28), + rep("Women's empowerment", 16), + rep("Women's mental health and alcohol consumption", 9), + rep("Women's diet and nutritional status", 7) + ) + + indicator_list <- data.frame( + id = seq_len(length(vars)), + indicator_group = "Woman", + indicator_set = indicator_set, + indicator_variable = vars, + indicator = labs + ) + } + + # Child indicators ----------------------------------------------------------- + if (id == "child") { + ## Variables names --------------------------------------------------------- + vars <- c( + "diarrhoea_episode", "diarrhoea_treatment", + paste0("diarrhoea_poc_", 1:6), "diarrhoea_treatment_ors", + paste0("diarrhoea_treatment_", 1:10), + "rti_episode", "rti_treatment", paste0("rti_poc_", 1:6), + paste0("rti_treatment_", 1:5), + "fever_episode", "fever_treatment", paste0("fever_poc_", 1:6), + "fever_rdt", "fever_smear", "fever_test", "fever_test_result", + paste0("fever_malaria_", 1:7), "fever_malaria_intake", + "imm_card1", "imm_card2", "bcg_card_recall", "opv1_card_recall", + "opv2_card_recall", "opv3_card_recall", "opv4_card_recall", + "dpt1_card_recall", "dpt2_card_recall", "dpt3_card_recall", + "rub1_card_recall", "rub2_card_recall", "pcv1_card_recall", + "pcv2_card_recall", "pcv3_card_recall", "vorh1_card_recall", + "vorh2_card_recall", "imm_full_recall", "imm_appropriate_recall", + "bcg_card_only", "opv1_card_only", "opv2_card_only", "opv3_card_only", + "opv4_card_only", "dpt1_card_only", "dpt2_card_only", "dpt3_card_only", + "rub1_card_only", "rub2_card_only", "pcv1_card_only", "pcv2_card_only", + "pcv3_card_only", "vorh1_card_only", "vorh2_card_only", "imm_full_card", + "imm_appropriate_card", "vita_at_least_once", "vita_0", "vita_1", + "vita_2", "deworm", "meal_frequency", "fg_dairy", "fg_starch", "fg_vita", + "fg_other_fruit_veg", "fg_legumes", "fg_meat", "fg_eggs", "fg_score", + "bf_ever", "bf_early", "bf_continuing", "bf_exclusive", "icfi_score", + "icfi_good", "iycf_good", "hfaz", "global_stunting", "moderate_stunting", + "severe_stunting", "wfaz", "global_underweight", "moderate_underweight", + "severe_underweight", "wfhz", "global_wasting_whz", "moderate_wasting_whz", + "severe_wasting_whz", "cmuac", "global_wasting_muac", "moderate_wasting_muac", + "severe_wasting_muac", "oedema" + ) + ## Indicator labels -------------------------------------------------------- + labs <- c( + "Proportion of children 0-59 months old who had a diarrhoea episode in the past 2 weeks", + "Proportion of children 0-59 months old who sought treatment for diarrhoea", + paste0("Proportion of children 0-59 months old by point-of-care for diarrhoea treatment - ", + c("Health facility", "Traditional healer", "Agente Polivalente Elementar", + "Family member", "Pharmacy", "Other") + ), + "Proportion of children 0-59 months old who received oral rehydration solution as treatment for diarrhoea", + paste0("Proportion of children 0-59 months old by diarrhoea treatment - ", + c("Pills/syrup", "Injections", "Intravenous Serum", "Rice water", + "Cereal pap", "Tea made of herbs and roots", "Powdered/fresh milk", + "Tea/Fruit juice/coconut milk", "Home-made remedy/medicinal herbs", + "Other") + ), + "Proportion of children 0-59 months old who had a cough episode in the past 2 weeks", + "Proportion of children 0-59 months old who sought treatment for cough", + paste0("Proportion of children 0-59 months old by point-of-care for cough treatment - ", + c("Health facility", "Traditional healer", "Agente Polivalente Elementar", + "Family member", "Pharmacy", "Other") + ), + paste0("Proportion of children 0-59 months old by cough treatment - ", + c("Antibiotic", "Paracetamol/Panadol/Acetaminophen", "Aspirin", + "Ibuprofen", "Other") + ), + "Proportion of children 0-59 months old who had a fever episode in the past 2 weeks", + "Proportion of children 0-59 months old who sought treatment for fever", + paste0("Proportion of children 0-59 months old by point-of-care for fever treatment - ", + c("Health facility", "Traditional healer", "Agente Polivalente Elementar", + "Family member", "Pharmacy", "Other") + ), + "Proportion of children 0-59 months old tested for malaria using a rapid diagnostic test", + "Proportion of children 0-59 months old tested for malaria using a smear test", + "Proportion of children 0-59 months old tested for malaria with rapid diagnostic test or a smear test", + "Proportion of children 0-59 months old with a positive rapid diagnostic test or smear test for malaria", + paste0("Proportion of children 0-59 months old by treatment provided for malaria - ", + c("Coartem (AL) CP", "Amodiaquina + Artesanato (ASAQ)", "Fansidar CP", + "Quinino CP", "Quinino INJ", "Artesanato", "Paracetamol Comprimido/Xarope") + ), + "Proportion of children 0-59 months old who took anti-malarial treatment on the same day or the day after onset of fever", + "Proportion of children 0-59 months old who report having an immunisation card", + "Proportion of children 0-59 months old who are able to show an immunisation card", + "Proportion of children 0-59 months old who received BCG based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 1 of OPV based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 2 of OPV based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 3 of OPV based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 4 of OPV based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 1 of DPT based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 2 of DPT based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 3 of DPT based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 1 of MMR based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 2 of MMR based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 1 of PCV based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 2 of PCV based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 3 of PCV based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 1 of VORH based on recall or on immunisation card", + "Proportion of children 0-59 months old who received dose 2 of VORH based on recall or on immunisation card", + "Proportion of children 12-23 months old who are fully immunised based on recall or on immunisation card", + "Proportion of children 0-59 months old who are fully immunised appropriate for their age based on recall or on immunisation card", + "Proportion of children 0-59 months old who received BCG based on immunisation card", + "Proportion of children 0-59 months old who received dose 1 of OPV based on immunisation card", + "Proportion of children 0-59 months old who received dose 2 of OPV based on immunisation card", + "Proportion of children 0-59 months old who received dose 3 of OPV based on immunisation card", + "Proportion of children 0-59 months old who received dose 4 of OPV based on immunisation card", + "Proportion of children 0-59 months old who received dose 1 of DPT based on immunisation card", + "Proportion of children 0-59 months old who received dose 2 of DPT based on immunisation card", + "Proportion of children 0-59 months old who received dose 3 of DPT based on immunisation card", + "Proportion of children 0-59 months old who received dose 1 of MMR based on immunisation card", + "Proportion of children 0-59 months old who received dose 2 of MMR based on immunisation card", + "Proportion of children 0-59 months old who received dose 1 of PCV based on immunisation card", + "Proportion of children 0-59 months old who received dose 2 of PCV based on immunisation card", + "Proportion of children 0-59 months old who received dose 3 of PCV based on immunisation card", + "Proportion of children 0-59 months old who received dose 1 of VORH based on immunisation card", + "Proportion of children 0-59 months old who received dose 2 of VORH based on immunisation card", + "Proportion of children 12-23 months old who are fully immunised based on immunisation card", + "Proportion of children 0-59 months old who are fully immunised appropriate for their age based on immunisation card", + "Proportion of children 6-59 months old who received at least one dose of vitamin A", + "Proportion of children 6-59 months old who did not receive any dose of vitamin A", + "Proportion of children 6-59 months old who received only one dose of vitamin A", + "Proportion of children 6-59 months old who received two doses of vitamin A", + "Proportion of children 12-59 months old who received deworming treatment", + "Mean meal frequency for the past 24 hours for children 6-23 months old", + "Proportion of children 6-23 months old who consumed dairy and dairy products in the past 24 hours", + "Proportion of children 6-23 months old who consumed starchy staples in the past 24 hours", + "Proportion of children 6-23 months old who consumed vitamin A-rich fruits and vegetables in the past 24 hours", + "Proportion of children 6-23 months old who consumed other fruits and vegetables in the past 24 hours", + "Proportion of children 6-23 months old who consumed legumes, nuts, and seeds in the past 24 hours", + "Proportion of children 6-23 months old who consumed meat, organ meat, poultry, and fish in the past 24 hours", + "Proportion of children 6-23 months old who consumed eggs in the past 24 hours", + "Mean food group score for children 6-23 months old", + "Proportion of children 0-23 months old who have ever breastfed", + "Proportion of children 0-23 months old who were initiated to breastfeeding early", + "Proportion of children 6-23 months old who are continuing to breastfeed", + "Proportion of children 0-5 months old who are exclusively breastfed", + "Mean ICFI score for children 6-23 months old", + "Proportion of children 6-23 months old who practice good/appropriate infant and child feeding", + "Proportion of children 0-23 months old who practice good/appropriate infant and child feeding", + "Mean height-for-age z-score of children 6-59 months old", + "Proportion of children 6-59 months old with height-for-age z-score less than -2", + "Proportion of children 6-59 months old with height-for-age z-score less than -2 and greater than or equal to -3", + "Proportion of children 6-59 months old with height-for-age z-score less than -3", + "Mean weight-for-age z-score of children 6-59 months old", + "Proportion of children 6-59 months old with weight-for-age z-score less than -2", + "Proportion of children 6-59 months old with weight-for-age z-score less than -2 and greater than or equal to -3", + "Proportion of children 6-59 months old with weight-for-age z-score less than -3", + "Mean weight-for-height z-score of children 6-59 months old", + "Proportion of children 6-59 months old with weight-for-height z-score less than -2", + "Proportion of children 6-59 months old with weight-for-height z-score less than -2 and greater than or equal to -3", + "Proportion of children 6-59 months old with weight-for-height z-score less than -3", + "Mean mid-upper arm circumference (cms) for children 6-59 months old", + "Proportion of children 6-59 months old with mid-upper arm circumference less than 12.5 cms", + "Proportion of children 6-59 months old with mid-upper arm circumference less than 12.5 cms and greater than or equal to 11.5 cms", + "Proportion of children 6-59 months old with mid-upper arm circumference less than 11.5 cms", + "Proportion of children 6-59 months old with nutritional oedema" + ) + ## Indicator set ----------------------------------------------------------- + indicator_set <- c( + rep("Period prevalence of childhood illnesses and treatment-seeking", 52), + rep("Child immunisation, vitamain A supplementation, and deworming coverage", 41), + rep("Meal frequency", 1), + rep("Food groups", 8), + rep("Breastfeeding practices", 4), + rep("Infant and young child feeding", 3), + rep("Child nutritional status", 17) + ) + + indicator_list <- data.frame( + id = seq_len(length(vars)), + indicator_group = "Child", + indicator_set = indicator_set, + indicator_variable = vars, + indicator = labs + ) + } + + indicator_list +} + diff --git a/R/create_results_tables_xlsx.R b/R/create_results_tables_xlsx.R new file mode 100644 index 0000000..5ae868a --- /dev/null +++ b/R/create_results_tables_xlsx.R @@ -0,0 +1,29 @@ +################################################################################ +# +#' +#' Create XLSX of indicator results +#' +# +################################################################################ + +create_results_xlsx <- function(path, + household, + carer, + woman, + child, + child_anthro) { + wb <- openxlsx::buildWorkbook( + x = list( + household = household, + carer = carer, + woman = woman, + child = child, + child_anthro = child_anthro + ), + asTable = TRUE, + colWidths = "auto" + ) + + openxlsx::saveWorkbook(wb = wb, file = path, overwrite = TRUE) +} + diff --git a/R/create_sofala_population.R b/R/create_sofala_population.R index 1997c2a..4fd29fa 100644 --- a/R/create_sofala_population.R +++ b/R/create_sofala_population.R @@ -27,17 +27,28 @@ create_sofala_district_population <- function(pdf_data) { matrix(ncol = 2) |> data.frame() |> (\(x) { names(x) <- c("district", "population"); x })() |> - (\(x) - { - x$district <- ifelse( - x$district == "Beira", "Cidade de Beira", - ifelse( - x$district == "Chirogoma", "Cheringoma", x$district - ) + dplyr::mutate( + district = ifelse( + district == "Beira", "Cidade de Beira", + ifelse( + district == "Chirogoma", "Cheringoma", district ) - x - } - )() + ), + population = as.integer(population) + ) + # + # + # (\(x) + # { + # x$district <- ifelse( + # x$district == "Beira", "Cidade de Beira", + # ifelse( + # x$district == "Chirogoma", "Cheringoma", x$district + # ) + # ) + # x + # } + # )() } diff --git a/R/interpolate_indicators.R b/R/interpolate_indicators.R new file mode 100644 index 0000000..c9b40cb --- /dev/null +++ b/R/interpolate_indicators.R @@ -0,0 +1,206 @@ + + + +create_sf_data <- function(.data) { + .data |> + subset(!is.na(spid)) |> + (\(x) + { + data.frame( + x, + do.call(rbind, x[["geolocation"]]) + ) + } + )() |> + dplyr::rename(latitude = X1, longitude = X2) |> + subset(select = -geolocation) |> + sf::st_as_sf(coords = c("longitude", "latitude"), crs = 4326) +} + + +create_sp_data <- function(.data) { + .data |> + subset(!is.na(spid)) |> + (\(x) + { + data.frame( + x, + do.call(rbind, x[["geolocation"]]) + ) + } + )() |> + dplyr::rename(latitude = X1, longitude = X2) |> + subset(select = -geolocation) |> + (\(x) + { + sp::SpatialPointsDataFrame( + coords = x[ , c("longitude", "latitude")], + data = x#, + #proj4string = CRS(proj) + ) + } + )() +} + +interpolate_indicator <- function(var, sf_data, int_points) { + sf_data <- sf_data[!is.na(sf_data[[var]]), ] + + gstat::idw( + formula = eval(parse(text = paste(var, "~", 1, sep = " "))), + locations = sf_data, newdata = int_points, idp = 2 + ) +} + + +interpolate_indicators <- function(vars, sf_data, int_points, indicator_list) { + vars <- as.list(indicator_list[["indicator_variable"]]) + sf_data <- rep(list(sf_data), length(vars)) + int_points <- rep(list(int_points), length(vars)) + + parallel::mcMap( + f = interpolate_indicator, + var = vars, + sf_data = sf_data, + int_points = int_points, + mc.cores = 4 + ) |> + (\(x) { names(x) <- vars; x } )() +} + + + +structure_interpolation_result <- function(int_df, var) { + int_df |> + sf::st_drop_geometry() |> + subset(select = var1.pred) |> + (\(x) { names(x) <- var; x } )() +} + +structure_interpolation_results <- function(int_list) { + int_df <- int_list + var <- as.list(names(int_list)) + + Map( + f = structure_interpolation_result, + int_df = int_df, + var = var + ) |> + dplyr::bind_cols() +} + + + +interpolate_indicators_household <- function(sf_data, int_points, + indicator_list) { + vars <- indicator_list[["indicator_variable"]] + + interpolate_indicators( + vars = vars, sf_data = sf_data, int_points = int_points + ) +} + + +interpolate_indicators_carer <- function(sf_data, int_points, indicator_list) { + vars <- c( + paste0("carer_", + c("age", "sex_1", "sex_2", "single", "married", "civil_union", + "divorced_separated", "widowed", "grade1", "grade2", "grade3", "grade4", + "grade5", "grade6", "grade7", "grade8", "grade9", "grade10", + "grade11", "grade12", "professional", "non_college", "college", + "literacy", "with_partner") + ), + paste0("partner_", + c("age", "grade1", "grade2", "grade3", "grade4", "grade5", "grade6", + "grade7", "grade8", "grade9", "grade10", "grade11", "grade12", + "professional", "non_college", "college", "literacy") + ), + paste0("income_source_", 1:6), paste0("income_amount_", 1:9), + paste0("occupation_carer_", 1:6), paste0("occupation_partner_", 1:7), + paste0("travel_modes_town_", 1:11), + paste0("travel_modes_health_facility_", 1:5), + paste0("travel_modes_local_markets_", 1:5), + paste0("travel_modes_water_sources_", 1:5), + paste0("travel_times_", + c("health_facility", "local_markets", "water_sources") + ), + paste0("ccare_danger_", 1:10), "ccare_danger_score", "ccare_participation", + paste0("ccare_barriers_", 1:5), paste0("pica_frequency_", 1:5), + paste0("play1", letters[1:7]), "play2", paste0("play3", letters[1:6]), + "see", "hear", + paste0("pica_response_", 1:5), "pica_perception" + ) + + interpolate_indicators( + vars = vars, sf_data = sf_data, int_points = int_points + ) +} + + +interpolate_indicators_woman <- function(sf_data, int_points) { + vars <- c( + paste0("delivery_location_", 1:5), "anc_four", "anc_well", "delivery_well", + paste0("delivery_assist_", 1:9), "delivery_return", + paste0("delivery_difficulty_", 1:6), "mother_days_to_pnc", + "mother_pnc_check", paste0("pnc_mother_", 0:3), "child_days_to_pnc", + "child_pnc_check", paste0("pnc_child_", 0:3), "nc_protect", + paste0("pnc_card_", 1:3), "preg_malaria", "preg_anaemia", "preg_more", + paste0("danger_", 1:10), "danger_all", paste0("labor_", 1:6), + paste0("newborn_", 1:8), + "mal_prevalence", "mal_no_treatment", + "mal_appropriate_treatment", "folate", "tt_any", "tt_two_more", + "idk1", "idk2", + paste0("pmtct", 1:3), "fp_use", "fp_wait_time_appropriate", + paste0("benefit_next_", 1:7), paste0("benefit_first_", 1:9), + paste0("multiparity_danger_", 1:9), "fp_wait_abort_appropriate", + "von1_no_choice", "von1_little_choice", "von1_some_choice", + "von1_lots_choices", "von2_no", "von2_little", "von2_enough", + "von2_a_lot", "von3_never", "von3_sometimes", "von3_almost", + "von3_always", "von4_freely", "von4_freely_consent", + "von4_husband_consent", "von4_someone_consent", + paste0("phq_", c("no_depression", "minimal_to_mild", "major", "severe")), + paste0("alcohol_frequency_", 1:5), "wdds", "mddw", + "bmi", "bmi_underweight", "bmi_overweight", "bmi_obese", + "muac_undernutrition" + ) + + interpolate_indicators( + vars = vars, sf_data = sf_data, int_points = int_points + ) +} + + +interpolate_indicators_child <- function(sf_data, int_points) { + vars <- c( + "diarrhoea_episode", "diarrhoea_treatment", + paste0("diarrhoea_poc_", 1:6), "diarrhoea_treatment_ors", + paste0("diarrhoea_treatment_", 1:10), + "rti_episode", "rti_treatment", paste0("rti_poc_", 1:6), + paste0("rti_treatment_", 1:5), + "fever_episode", "fever_treatment", paste0("fever_poc_", 1:6), + "fever_rdt", "fever_smear", "fever_test", "fever_test_result", + paste0("fever_malaria_", 1:7), "fever_malaria_intake", + "imm_card1", "imm_card2", "bcg_card_recall", "opv1_card_recall", + "opv2_card_recall", "opv3_card_recall", "opv4_card_recall", + "dpt1_card_recall", "dpt2_card_recall", "dpt3_card_recall", + "rub1_card_recall", "rub2_card_recall", "pcv1_card_recall", + "pcv2_card_recall", "pcv3_card_recall", "vorh1_card_recall", + "vorh2_card_recall", "imm_full_recall", "imm_appropriate_recall", + "bcg_card_only", "opv1_card_only", "opv2_card_only", "opv3_card_only", + "opv4_card_only", "dpt1_card_only", "dpt2_card_only", "dpt3_card_only", + "rub1_card_only", "rub2_card_only", "pcv1_card_only", "pcv2_card_only", + "pcv3_card_only", "vorh1_card_only", "vorh2_card_only", "imm_full_card", + "imm_appropriate_card", "vita_at_least_once", "vita_0", "vita_1", + "vita_2", "deworm", "meal_frequency", "fg_dairy", "fg_starch", "fg_vita", + "fg_other_fruit_veg", "fg_legumes", "fg_meat", "fg_eggs", "fg_score", + "bf_ever", "bf_early", "bf_continuing", "bf_exclusive", "icfi_score", + "icfi_good", "iycf_good", "hfaz", "global_stunting", "moderate_stunting", + "severe_stunting", "wfaz", "global_underweight", "moderate_underweight", + "severe_underweight", "wfhz", "global_wasting_whz", "moderate_wasting_whz", + "severe_wasting_whz", "mmuac", "global_wasting_muac", "moderate_wasting_muac", + "severe_wasting_muac", "oedema" + ) + + interpolate_indicators( + vars = vars, sf_data = sf_data, int_points = int_points + ) +} \ No newline at end of file diff --git a/R/plot_choropleth.R b/R/plot_choropleth.R new file mode 100644 index 0000000..b8e89bf --- /dev/null +++ b/R/plot_choropleth.R @@ -0,0 +1,90 @@ +################################################################################ +# +#' +#' Plot choropleth maps +#' +# +################################################################################ + +plot_choropleth_map <- function(var, + results_map, + main = NULL, + n = 11, + pal = viridis::viridis(n = n), + breaks = "equal", + file_path) { + check_vars <- tryCatch( + classInt::classIntervals( + var = results_map[[var]], + n = n, style = breaks + ), + error = function(e) e, + warning = function(w) w + ) + + if (inherits(check_vars, c("error", "warning"))) { + NULL + } else { + png(filename = file_path, width = 10, height = 10, units = "in", res = 200) + par(mar = c(0,0,0,0)) + + plot( + x = results_map[var], + main = NULL, + pal = pal, + nbreaks = n, + breaks = breaks, + key.pos = 4, + lwd = 1.5, + border = "gray70", + reset = FALSE + ) + + text( + x = sf::st_centroid(results_map) |> sf::st_coordinates(), + labels = results_map[["ADM2_PT"]], + col = "gray50" + ) + + title(main = main, cex.main = 0.85, line = -2) + + dev.off() + } +} + +plot_choropleth_maps <- function(var, + results_map, + n = 5, + pal = viridis::viridis(n = n), + breaks = "equal", + indicator_list) { + set <- indicator_list |> + subset(indicator_variable %in% var) |> + (\(x) + paste0( + tolower(x[["indicator_group"]]), "_", x[["id"]] + ) + )() + + file_paths <- paste0("outputs/choropleth/", set, "_", var, ".png") + + main <- indicator_list |> + subset(indicator_variable %in% var, select = indicator) |> + (\(x) x$indicator)() |> + stringr::str_wrap(width = 100) + + parallel::mcMap( + f = plot_choropleth_map, + var = as.list(var), + results_map = rep(list(results_map), length(var)), + main = as.list(main), + n = n, + pal = rep(list(pal), length(var)), + breaks = breaks, + file_path = as.list(file_paths) + ) +} + + + + diff --git a/R/plot_maps.R b/R/plot_maps.R new file mode 100644 index 0000000..2e0202d --- /dev/null +++ b/R/plot_maps.R @@ -0,0 +1,311 @@ + +get_div_colours <- colorRampPalette( + colors = RColorBrewer::brewer.pal(n = 7, name = "RdYlGn"), space = "Lab" +) + +get_seq_colours <- colorRampPalette( + colors = RColorBrewer::brewer.pal(n = 7, name = "YlOrRd"), space = "Lab" +) + +get_qual_colours <- colorRampPalette( + #colors = RColorBrewer::brewer.pal(n = 7, name = "BuPu"), space = "Lab" + colors = viridis::magma(n = 7), space = "Lab" +) + + +plot_divergent_map <- function(int_sf, + base_map = sofala_province, + main = NULL, + n = 11, + direction = "hi", + breaks = "equal", + file_path) { + png(filename = file_path,width = 10, height = 10, units = "in", res = 200) + par(mar = c(0,0,0,0)) + plot( + x = int_sf["var1.pred"], + main = NULL, + pal = ifelse(direction == "lo", rev(pal), pal), + nbreaks = n, + breaks = breaks, + key.pos = 4, + lty = 0 + ) + + plot(x = sf::st_geometry(base_map), lwd = 2, add = TRUE) + + title(main = main, cex.main = 0.85, line = -2) + + dev.off() +} + +plot_sequential_map <- function(int_sf, + base_map = sofala_province, + main = NULL, + n = 11, + breaks = "equal", + file_path) { + png(filename = file_path,width = 10, height = 10, units = "in", res = 200) + par(mar = c(0,0,0,0)) + plot( + x = int_sf["var1.pred"], + main = NULL, + pal = get_seq_colours(n = n), + nbreaks = n, + breaks = breaks, + key.pos = 4, + lty = 0 + ) + + plot(x = sf::st_geometry(base_map), lwd = 2, add = TRUE) + + title(main = main, cex.main = 0.85, line = -2) + + dev.off() +} + + +plot_prevalence_map <- function(int_sf, + base_map = sofala_province, + main = NULL, + n = 11, + breaks = "quantile", + file_path) { + png(filename = file_path,width = 10, height = 10, units = "in", res = 200) + par(mar = c(0,0,0,0)) + plot( + x = int_sf["var1.pred"], + main = NULL, + pal = get_seq_colours(n = n), + nbreaks = n, + breaks = breaks, + key.pos = 4, + lty = 0 + ) + + plot(x = sf::st_geometry(base_map), lwd = 2, add = TRUE) + + title(main = main, cex.main = 0.85, line = -2) + + dev.off() +} + +plot_qual_map <- function(int_sf, + base_map = sofala_province, + main = NULL, + n = 11, + pal = viridis::magma(n = n), + breaks = "equal", + file_path) { + png(filename = file_path,width = 10, height = 10, units = "in", res = 200) + par(mar = c(0,0,0,0)) + plot( + x = int_sf["var1.pred"], + main = NULL, + pal = pal, + nbreaks = n, + breaks = breaks, + key.pos = 4, + lty = 0, + cex = 0.5, + reset = FALSE + ) + + plot(x = sf::st_geometry(base_map), lwd = 2, add = TRUE) + + title(main = main, cex.main = 0.85, line = -1) + + dev.off() +} + + +plot_sequential_maps <- function(int_sf, + base_map = sofala_province, + n = 11, + breaks = "equal", + indicator_list) { + set <- paste0( + tolower(indicator_list[["indicator_group"]]), "_", indicator_list[["id"]] + ) + + file_paths <- paste0("outputs/interpolation/", set, "_", names(int_sf), ".png") + + main <- indicator_list |> + subset(indicator_variable %in% names(int_sf), select = indicator) |> + (\(x) x$indicator)() |> + stringr::str_wrap(width = 100) + + parallel::mcMap( + f = plot_sequential_map, + int_sf = int_sf, + base_map = rep(list(base_map), length(int_sf)), + main = as.list(main), + n = n, + breaks = breaks, + file_path = as.list(file_paths) + ) +} + + +plot_divergent_maps <- function(int_sf, + base_map = sofala_province, + n = 11, + pal = get_qual_colours(n = n), + breaks = "equal", + indicator_list) { + set <- indicator_list |> + subset(indicator_variable %in% names(int_sf)) |> + (\(x) + paste0( + tolower(x[["indicator_group"]]), "_", x[["id"]] + ) + )() + + file_paths <- paste0("outputs/interpolation/", set, "_", names(int_sf), ".png") + + main <- indicator_list |> + subset(indicator_variable %in% names(int_sf)) |> + (\(x) x$indicator)() |> + stringr::str_wrap(width = 100) + + direction <- indicator_list |> + subset(indicator_variable %in% names(int_sf)) |> + (\(x) x$direction)() + + parallel::mcMap( + f = plot_divergent_map, + int_sf = int_sf, + base_map = rep(list(base_map), length(int_sf)), + main = as.list(main), + n = n, + pal = rep(list(pal), length(int_sf)), + direction = as.list(direction), + breaks = breaks, + file_path = as.list(file_paths) + ) +} + +plot_anthro_maps <- function(int_sf, + base_map = sofal_provice, + n = 11, + breaks = "quantile", + indicator_list) { + set <- paste0( + tolower(indicator_list[["indicator_group"]]), "_", indicator_list[["id"]] + ) + + file_paths <- paste0("outputs/interpolation/", set, "_", names(int_sf), ".png") + + main <- indicator_list |> + subset(indicator_variable %in% names(int_sf), select = indicator) |> + (\(x) x$indicator)() |> + stringr::str_wrap(width = 100) + + parallel::mcMap( + f = plot_prevalence_map, + int_sf = int_sf, + base_map = rep(list(base_map), length(int_sf)), + main = as.list(main), + n = n, + breaks = breaks, + file_path = as.list(file_paths) + ) +} + +plot_qual_maps <- function(int_sf, + base_map = sofala_province, + n = 11, + pal = viridis::magma(n = n), + breaks = "equal", + indicator_list) { + set <- indicator_list |> + subset(indicator_variable %in% names(int_sf)) |> + (\(x) + paste0( + tolower(x[["indicator_group"]]), "_", x[["id"]] + ) + )() + + file_paths <- paste0("outputs/interpolation/", set, "_", names(int_sf), ".png") + + main <- indicator_list |> + subset(indicator_variable %in% names(int_sf), select = indicator) |> + (\(x) x$indicator)() |> + stringr::str_wrap(width = 100) + + indicator_list |> + subset(indicator_variable %in% names(int_sf), select = indicator) |> + (\(x) x$indicator)() |> + stringr::str_detect(pattern = "Mean") + + parallel::mcMap( + f = plot_qual_map, + int_sf = int_sf, + base_map = rep(list(base_map), length(int_sf)), + main = as.list(main), + n = n, + pal = rep(list(pal), length(int_sf)), + breaks = breaks, + file_path = as.list(file_paths) + ) +} + + +format_interpolation_result <- function(int_sf, prop) { + if (prop) { + int_sf[["var1.pred"]] <- int_sf[["var1.pred"]] * 100 + int_sf + } else { + int_sf + } +} + +format_interpolation_results <- function(int_sf, indicator_list) { + Map( + f = format_interpolation_result, + int_sf = int_sf, + prop = indicator_list |> + subset(indicator_variable %in% names(int_sf), select = indicator) |> + (\(x) x$indicator)() |> + stringr::str_detect(pattern = "Mean", negate = TRUE) |> + as.list() + ) +} + + +plot_interpolation_maps <- function(int_sf, + base_map = sofala_province, + n = 11, + breaks = "equal", + indicator_list) { + set <- paste0( + tolower(indicator_list[["indicator_group"]]), "_", indicator_list[["id"]] + ) + + file_paths <- paste0("outputs/interpolation/", set, "_", names(int_sf), ".png") + + main <- indicator_list |> + subset(indicator_variable %in% names(int_sf), select = indicator) |> + (\(x) x$indicator)() |> + stringr::str_wrap(width = 100) + + + parallel::mcMap( + f = lapply( + X = indicator_list$map_function, FUN = function(x) eval(parse(text = x)) + ), + int_sf = int_sf, + base_map = rep(list(base_map), length(int_sf)), + main = as.list(main), + n = n, + pal = lapply( + X = indicator_list$pal, FUN = function(x) eval(parse(text = x)) + ), + breaks = breaks, + file_path = as.list(file_paths) + ) +} + + + + diff --git a/R/recode_anthro_child.R b/R/recode_anthro_child.R index e9ef492..b178ac1 100644 --- a/R/recode_anthro_child.R +++ b/R/recode_anthro_child.R @@ -18,7 +18,11 @@ recode_anthro_child <- function(.data) { ifelse( cmuac == 159, 15.9, cmuac ) - ) + ), + cmuac = ifelse(age_months < 6 | age_months > 59, NA, cmuac), + cweight = ifelse(age_months < 6 | age_months > 59, NA, cweight), + cheight = ifelse(age_months < 6 | age_months > 59, NA, cheight), + oedema = ifelse(age_months < 6 | age_months > 59, NA, oedema) ) ## Calculate z-scores and flag records @@ -85,7 +89,8 @@ recode_anthro_child <- function(.data) { severe_wasting_whz = ifelse(wfhz < -3, 1, 0), global_wasting_muac = ifelse(cmuac < 12.5, 1, 0), moderate_wasting_muac = ifelse(cmuac >= 11.5 & cmuac < 12.5, 1, 0), - severe_wasting_muac = ifelse(cmuac < 11.5, 1, 0) + severe_wasting_muac = ifelse(cmuac < 11.5, 1, 0), + oedema = ifelse(oedema == 1, 1, 0) ) core_vars <- get_core_variables(raw_data_clean = .data) diff --git a/R/recode_anthro_mother.R b/R/recode_anthro_mother.R index c877bec..6e0a06d 100644 --- a/R/recode_anthro_mother.R +++ b/R/recode_anthro_mother.R @@ -10,7 +10,14 @@ recode_anthro_mother <- function(.data, bmi_labs = FALSE, muac_labs = FALSE) { x <- .data |> - subset(select = c(mother_age, mweight, mheight, mmuac, wh1)) + subset(select = c(mother_age, mweight, mheight, mmuac, wh1)) |> + dplyr::mutate( + mweight = ifelse(mother_age < 15 | mother_age > 49, NA, mweight), + mweight = ifelse(wh1 == 1, NA, mweight), + mheight = ifelse(mother_age < 15 | mother_age > 49, NA, mheight), + mheight = ifelse(wh1 == 1, NA, mheight), + mmuac = ifelse(mother_age < 15 | mother_age > 49, NA, mmuac) + ) ## Apply fixes form first round of BMI checks x$mheight[x$mheight == 1478.00] <- 147.80 @@ -56,6 +63,8 @@ recode_anthro_mother <- function(.data, x$mheight[x$mheight == 1.54] <- 154.00 x$mheight[x$mheight == 1.58] <- 158.00 x$mheight[x$mheight == 1.62] <- 162.00 + x$mheight[x$mheight == 1.51] <- 151.00 + x$mheight[x$mheight == 1.00] <- 100.00 x$mweight[x$mweight == 23.0] <- 53.0 x$mweight[x$mweight == 24.1] <- 54.1 x$mweight[x$mweight == 24.8] <- 54.8 diff --git a/R/recode_diarrhoea.R b/R/recode_diarrhoea.R index 35dc69f..98d7f0f 100644 --- a/R/recode_diarrhoea.R +++ b/R/recode_diarrhoea.R @@ -212,7 +212,7 @@ dia_recode <- function(vars, .data) { diarrhoea_episode = dia_recode_diagnosis(.data = dia_df), diarrhoea_treatment = dia_df[[vars[6]]], dia_recode_poc(.data = dia_df), - diarroea_treatment_ors = dia_recode_ors(.data = dia_df), + diarrhoea_treatment_ors = dia_recode_ors(.data = dia_df), dia_recode_treatment(.data = dia_df), dia_recode_liquids(.data = dia_df), dia_recode_foods(.data = dia_df) diff --git a/R/recode_food_groups.R b/R/recode_food_groups.R index a9f2d0c..eb55637 100644 --- a/R/recode_food_groups.R +++ b/R/recode_food_groups.R @@ -57,26 +57,27 @@ fg_recode_response <- function(x, na_values, binary = TRUE) { ## Recode responses to multiple food groups ------------------------------------ -fg_recode_responses <- function(vars, .data, - na_values = rep(list(9), 19), +fg_recode_responses <- function(vars, + .data, + na_values = c(8,9), binary = TRUE) { x <- .data[vars] Map( f = fg_recode_response, x = as.list(x), - na_values = na_values, - binary = as.list(c(TRUE, FALSE, rep(TRUE, 16), FALSE)) + na_values = rep(list(na_values), length(x)), + binary = binary ) |> - dplyr::bind_cols() |> - (\(x) - { - data.frame( - age_months = .data[["age_months"]], - x - ) - } - )() + dplyr::bind_cols() #|> + #(\(x) + # { + # data.frame( + # age_months = .data[["age_months"]], + # x + # ) + #} + #)() } ## Map food intake variables to child-specific food groups --------------------- @@ -131,16 +132,14 @@ fg_recode_group <- function(vars, ) } - ## Get variables - df <- .data[vars] - - ## Recode each variable to 1 and 0 - # for (i in vars) { - # df[i] <- recode_yes_no(df[[i]], na_values = c("8", "9")) - # } + x <- fg_recode_responses(vars = vars, .data = .data, na_values = c(8, 9)) |> + rowSums(na.rm = TRUE) - ## Recode food group to 1 and 0 - fg <- recode_yes_no(x = rowSums(df, na.rm = TRUE), detect = "no") + fg <- ifelse( + .data[["age_months"]] < 6 | .data[["age_months"]] >= 24, + NA, x + ) |> + recode_yes_no(detect = "no") } else { if (!food_group %in% c("eggs", "legumes")) { warning( @@ -153,7 +152,15 @@ fg_recode_group <- function(vars, } ## Calculate indicator - fg <- .data[[vars]] + x <- fg_recode_responses( + vars = vars, .data = .data, na_values = c(8, 9) + ) + + fg <- ifelse( + .data[["age_months"]] < 6 | .data[["age_months"]] >= 24, + NA, x[[vars]] + ) |> + recode_yes_no(detect = "no") } ## Return @@ -181,7 +188,7 @@ fg_recode_groups <- function(vars, f = fg_recode_group, vars = vars, .data = .data_list, - food_group = food_group + food_group = as.list(food_group) ) |> (\(x) { names(x) <- paste0("fg_", food_group); x })() |> dplyr::bind_rows() diff --git a/R/recode_hygiene.R b/R/recode_hygiene.R index d78cd75..3f847f3 100644 --- a/R/recode_hygiene.R +++ b/R/recode_hygiene.R @@ -45,19 +45,40 @@ hygiene_recode_events <- function(vars, .data, fill, na_rm = FALSE, prefix) { ) } +hygiene_recode_diaper <- function(vars, .data, fill, na_rm = FALSE, prefix) { + x <- .data[[vars]] + + split_select_multiples( + x = x, + fill = fill, + na_rm = na_rm, + prefix = prefix + ) +} + + ## Overall recode function ----------------------------------------------------- hygiene_recode <- function(vars, .data, na_values) { core_vars <- get_core_variables(raw_data_clean = .data) hygiene_df <- hygiene_recode_responses( - vars = vars, + vars = vars[c(1, 3:4, 6)], .data = .data, na_values = na_values - ) + ) |> + data.frame( + dplyr::mutate( + .data[vars[c(2, 5)]], + caha2 = ifelse(caha2 %in% c("88", "99"), NA, caha2), + lusd10 = ifelse(lusd10 %in% c("88", "99"), NA, lusd10) + ) + ) |> + dplyr::relocate(caha2, .before = caha3) |> + dplyr::relocate(lusd10, .before = lusd11) recoded_vars <- data.frame( - hygiene_wash_recent = ifelse(hygiene_df[[vars[1]]] == 2, 0, 1), + hygiene_wash_recent = ifelse(hygiene_df[[vars[1]]] == 1, 1, 0), hygiene_recode_events( vars = vars[2], .data = hygiene_df, @@ -65,9 +86,16 @@ hygiene_recode <- function(vars, .data, na_values) { na_rm = FALSE, prefix = "handwash_event" ), - hygiene_wash_appropriate = ifelse(hygiene_df[[vars[3]]] == 2, 0, 1), + hygiene_wash_appropriate = ifelse(hygiene_df[[vars[3]]] == 1, 1, 0), hygiene_child_defecation = ifelse(hygiene_df[[vars[4]]] %in% 1:2, 1, 0), - hygiene_child_disposal = ifelse(hygiene_df[[vars[5]]] %in% c(1, 7), 1, 0), + #hygiene_child_disposal = ifelse(hygiene_df[[vars[5]]] %in% c(1, 7), 1, 0), + hygiene_recode_diaper( + vars = vars[5], + .data = hygiene_df, + fill = 1:8, + na_rm = FALSE, + prefix = "diaper_disposal" + ), hygiene_child_diaper = ifelse(hygiene_df[[vars[6]]] == 1, 1, 0) ) diff --git a/R/recode_mental_health.R b/R/recode_mental_health.R index 1405bb5..cb9fbff 100644 --- a/R/recode_mental_health.R +++ b/R/recode_mental_health.R @@ -82,8 +82,15 @@ phq_recode_symptoms <- function(vars, .data, na_values) { } -phq_calculate_score <- function(phq_df, add = TRUE) { - phq <- rowSums(phq_df, na.rm = TRUE) +phq_calculate_score <- function(phq_df, .data, add = TRUE) { + phq <- rowSums(phq_df, na.rm = TRUE) |> + (\(x) + ifelse( + .data[["mother_carer_sex"]] == 1 | + .data[["mother_age"]] < 15 | + .data[["mother_age"]] > 49, NA, x + ) + )() if (add) { data.frame( @@ -101,23 +108,43 @@ phq_classify <- function(phq, add = FALSE, spread = FALSE) { #breaks <- c(1, 4, 9, 14, 19, 27) #labels <- c("minimal", "mild", "moderate", "moderate severe", "severe") breaks <- c(1, 10, 20, 24) - labels <- c("minimal to mild", "major", "severe") + labs <- c("minimal to mild", "major", "severe") phq_class <- cut( x = phq, breaks = breaks, - labels = labels, + labels = labs, include.lowest = TRUE, right = TRUE ) |> as.character() |> (\(x) ifelse(is.na(x), "no depression", x))() |> factor(levels = c("no depression", "minimal to mild", "major", "severe")) + phq_integer <- cut( + x = phq, + breaks = breaks, + labels = FALSE, + include.lowest = TRUE, right = TRUE + ) |> + (\(x) ifelse(is.na(x), 0, x))() + if (spread) { phq_class <- data.frame( phq_class = phq_class, - spread_vector_to_columns(x = phq_class, prefix = "phq") + spread_vector_to_columns(x = phq_integer, prefix = "phq") + ) + + names(phq_class) <- c( + "phq_class", + paste0( + "phq_", + stringr::str_replace_all( + string = c("no depression", labs), pattern = " ", replacement = "_" + ) + ) ) + + phq_class } if (add) { @@ -131,10 +158,13 @@ phq_classify <- function(phq, add = FALSE, spread = FALSE) { ## Recode alcohol frequency -alcohol_recode_frequency <- function(x, na_values, +alcohol_recode_frequency <- function(x, + age, + sex, + na_values, fill = 1:5, prefix = "alcohol_frequency") { - ifelse(x %in% na_values, NA, x) |> + ifelse(x %in% na_values | age < 15 | age > 49 | sex == 1, NA, x) |> spread_vector_to_columns(fill = 1:5, na_rm = FALSE, prefix = prefix) } @@ -157,11 +187,15 @@ phq_recode <- function(vars, ) alcohol_frequency <- alcohol_recode_frequency( - x = .data[["ment9"]], na_values = na_values + x = .data[["ment9"]], + age = .data[["mother_age"]], + sex = .data[["mother_carer_sex"]], + na_values = na_values ) + recoded_vars |> - phq_calculate_score(add = FALSE) |> + phq_calculate_score(.data = .data, add = FALSE) |> phq_classify(add = TRUE, spread = TRUE) |> (\(x) data.frame(core_vars, recoded_vars, x, alcohol_frequency))() } diff --git a/R/recode_mother_characteristics.R b/R/recode_mother_characteristics.R index ec3823a..263bd3d 100644 --- a/R/recode_mother_characteristics.R +++ b/R/recode_mother_characteristics.R @@ -74,6 +74,9 @@ carer_recode <- function(.data, x = .data[["mother_age"]], na_values = age_na_values ) + carer_sex <- .data[["mother_carer_sex"]] |> + spread_vector_to_columns(fill = 1:2, prefix = "carer_sex") + carer_marital_status <- carer_recode_marital_status( x = .data[["resp_marital_status"]], na_values = marital_na_values, @@ -104,7 +107,7 @@ carer_recode <- function(.data, ) data.frame( - core_vars, carer_age, carer_marital_status, carer_education, + core_vars, carer_age, carer_sex, carer_marital_status, carer_education, carer_with_partner, partner_age, partner_education ) } diff --git a/R/recode_natal_care.R b/R/recode_natal_care.R index 8bd1677..ae9ad4e 100644 --- a/R/recode_natal_care.R +++ b/R/recode_natal_care.R @@ -190,9 +190,9 @@ nc_recode <- function(vars, .data) { nc_recode_assist(vars = vars[5], .data = nc_df), delivery_return = nc_df[[vars[6]]], nc_recode_difficulties(vars = vars[8], .data = nc_df), - nc_recode_pnc(vars = vars[9:11], .data = nc_df, prefix = "pnc_mother") |> + nc_recode_pnc(vars = vars[12:14], .data = nc_df, prefix = "pnc_mother") |> (\(x) { names(x)[1:2] <- paste0("mother_", names(x)[1:2]); x } )(), - nc_recode_pnc(vars = vars[12:14], .data = nc_df, prefix = "pnc_child") |> + nc_recode_pnc(vars = vars[9:11], .data = nc_df, prefix = "pnc_child") |> (\(x) { names(x)[1:2] <- paste0("child_", names(x)[1:2]); x } )(), nc_protect = nc_df[[vars[15]]] ) diff --git a/R/recode_pica.R b/R/recode_pica.R index 09bd282..c41d557 100644 --- a/R/recode_pica.R +++ b/R/recode_pica.R @@ -68,9 +68,10 @@ pica_recode <- function(vars, .data, na_values) { recoded_vars <- data.frame( pica_probable = pica_recode_diagnosis(x = pica_df[[vars[1]]]), - pica_recode_frequency(x = pica_df[[vars[2]]]), + pica_recode_frequency(x = pica_df[[vars[1]]]), pica_recode_response(x = pica_df[[vars[2]]]), - pica_perception = pica_df[[vars[3]]] + pica_perception = pica_df[[vars[3]]] |> + (\(x) ifelse(x == 1, 1, 0))() ) data.frame(core_vars, recoded_vars) diff --git a/R/recode_sanitation.R b/R/recode_sanitation.R index d9476f9..0e7fcf2 100644 --- a/R/recode_sanitation.R +++ b/R/recode_sanitation.R @@ -105,25 +105,28 @@ san_recode_responses <- function(vars, .data, na_values) { san_recode_open <- function(vars, .data) { x <- .data[vars] - ifelse(x[[vars[1]]] == 0 | is.na(x[[vars[2]]]), 1, 0) + ifelse(x[[vars[1]]] == 0 | is.na(x[[vars[2]]]) | x[[vars[2]]] == 6, 1, 0) } san_recode_unimproved <- function(vars, .data) { x <- .data[[vars]] - ifelse(x == 5, 1, 0) + ifelse(x == 5, 1, 0) |> + (\(x) ifelse(is.na(x), 0, x))() } san_recode_limited <- function(vars, .data) { x <- .data[vars] - ifelse(x[[vars[1]]] != 5 & x[[vars[2]]] == 1, 1, 0) + ifelse(!x[[vars[2]]] %in% 5:6 & x[[vars[1]]] == 1, 1, 0) |> + (\(x) ifelse(is.na(x), 0, x))() } san_recode_basic <- function(vars, .data) { x <- .data[vars] - ifelse(x[[vars[1]]] == 5 & x[[vars[2]]] != 1, 1, 0) + ifelse(!x[[vars[2]]] %in% 5:6 & x[[vars[1]]] != 1, 1, 0) |> + (\(x) ifelse(is.na(x), 0, x))() } diff --git a/R/recode_vita.R b/R/recode_vita.R index 66f9b59..042806e 100644 --- a/R/recode_vita.R +++ b/R/recode_vita.R @@ -24,9 +24,9 @@ vita_recode <- function(.data) { (\(x) { ifelse(x %in% 4:5, NA, - ifelse( - x == 3, 0, 1 - ) + ifelse( + x == 3, 0, x + ) ) } )() |> @@ -42,7 +42,7 @@ vita_recode <- function(.data) { worm_recode <- function(.data) { ifelse( - .data[["vas3"]] == 8, NA, + .data[["vas3"]] == 8 | .data[["age_months"]] < 12, NA, ifelse( .data[["vas3"]] == 2, 0, 1 ) diff --git a/R/recode_water.R b/R/recode_water.R index 4f1be0d..8678be9 100644 --- a/R/recode_water.R +++ b/R/recode_water.R @@ -126,6 +126,20 @@ water_recode_responses <- function(vars, .data, na_values) { # ################################################################################ +water_recode_sources <- function(.data) { + .data |> + dplyr::mutate( + wt2 = ifelse( + wt2 == 13 & + wt2_other %in% c("Debaixo da ponte", "Debaixo da ponte "), 7, + ifelse( + wt2 == 13 & + wt2_other == "Pequenas bacias nas machambas de arroz na época chuvosa.", 10, wt2 + ) + ) + ) +} + water_recode_surface <- function(vars, .data) { x <- .data[[vars]] @@ -143,7 +157,8 @@ water_recode_limited <- function(vars, .data) { x <- .data[vars] ifelse( - x[[vars[1]]] %in% c(1:6, 8, 10, 12) & x[[vars[2]]] > 30, 1, 0 + x[[vars[1]]] %in% c(1:6, 8, 10, 12) & + x[[vars[2]]] > 30, 1, 0 ) } @@ -151,7 +166,9 @@ water_recode_basic <- function(vars, .data) { x <- .data[vars] ifelse( - x[[vars[1]]] %in% c(1:6, 8, 10, 12) & x[[vars[2]]] <= 30, 1, 0 + x[[vars[1]]] %in% c(1:6, 8, 10, 12) & + x[[vars[2]]] <= 30 & + x[[vars[3]]] == 1, 1, 0 ) } @@ -159,7 +176,9 @@ water_recode_sufficient <- function(vars, .data) { x <- .data[vars] ifelse( - x[[vars[1]]] %in% 1:2 & x[[vars[2]]] == 1, 1, 0 + x[[vars[1]]] %in% c(1:6, 8, 10, 12) & + x[[vars[2]]] <= 30 & + x[[vars[3]]] != 1, 1, 0 ) } @@ -249,10 +268,10 @@ water_recode <- function(vars, .data, na_values) { vars = c("wt2", "wt3a"), .data = water_df ), water_basic = water_recode_basic( - vars = c("wt2", "wt3a"), .data = water_df + vars = c("wt2", "wt3a", "wt4"), .data = water_df ), water_sufficient = water_recode_sufficient( - vars = c("wt2", "wt4"), .data = water_df + vars = c("wt2", "wt3a", "wt4"), .data = water_df ), water_recode_sufficiency( vars = c("wt4", "wt4a"), .data = water_df diff --git a/R/restructure_results_tables.R b/R/restructure_results_tables.R new file mode 100644 index 0000000..40a2bc9 --- /dev/null +++ b/R/restructure_results_tables.R @@ -0,0 +1,115 @@ +################################################################################ +# +#' +#' Restructure results tables +#' +# +################################################################################ + +## Spread table by districts (for table reporting) ----------------------------- + +spread_table_by_district <- function(df) { + df |> + subset(select = -sd) |> + tidyr::pivot_wider( + names_from = district, + values_from = c(estimate, lcl, ucl) + ) |> + (\(x) + x[ , c(1, 2, 3, 4:16 |> lapply(FUN = seq, to = 42, by = 13) |> unlist())] + )() +} + +## Spread table by districts for multiple indicators --------------------------- + +create_results_table_by_district <- function(results_table, format = TRUE) { + if (format) { + results_table <- results_table |> + dplyr::mutate( + estimate = ifelse( + stringr::str_detect(indicator, pattern = "Mean"), + round(estimate, digits = 3), + round(estimate * 100, digits = 2) + ), + lcl = ifelse( + stringr::str_detect(indicator, pattern = "Mean"), + round(lcl, digits = 3), + round(lcl * 100, digits = 2) + ), + ucl = ifelse( + stringr::str_detect(indicator, pattern = "Mean"), + round(ucl, digits = 3), + round(ucl * 100, digits = 2) + ) + ) + } + + df_list <- split( + x = results_table, + f = factor( + x = results_table[["indicator"]], + levels = unique(results_table[["indicator"]]) + ) + ) + + Map( + f = spread_table_by_district, + df = df_list + ) |> + dplyr::bind_rows() +} + +## Create table by indicator (for mapping) ------------------------------------- + +create_table_by_indicator <- function(df) { + df |> + dplyr::mutate( + estimate = ifelse( + stringr::str_detect(indicator, pattern = "Mean"), + round(estimate, digits = 3), + round(estimate * 100, digits = 2) + ), + lcl = ifelse( + stringr::str_detect(indicator, pattern = "Mean"), + round(lcl, digits = 3), + round(lcl * 100, digits = 2) + ), + ucl = ifelse( + stringr::str_detect(indicator, pattern = "Mean"), + round(ucl, digits = 3), + round(ucl * 100, digits = 2) + ) + ) |> + (\(x) + { + names(x)[5] <- unique(x$indicator_variable) + x + } + )() |> + subset( + select = c(-indicator_set, -indicator_variable, -indicator, -lcl, -ucl, -sd) + ) +} + +## Create table by multiple indicators ----------------------------------------- + +create_tables_by_indicator <- function(results_table) { + df_list <- split( + x = results_table, + f = factor( + x = results_table[["indicator"]], + levels = unique(results_table[["indicator"]]) + ) + ) + + Map( + f = create_table_by_indicator, + df = df_list + ) |> + (\(x) + Reduce( + f = function(a, b) merge(a, b), + x = x + ) + )() +} diff --git a/_targets.R b/_targets.R index 411ce33..e22c233 100644 --- a/_targets.R +++ b/_targets.R @@ -662,7 +662,7 @@ data_processed <- tar_plan( c(88, 99), c(88, 99), c(88, 99), c(7, 88, 99) ), - fill = list(1:6, 1:9, 1:6, 1:6), + fill = list(1:6, 1:9, 1:6, 1:7), na_rm = rep(list(FALSE), length(vars)), prefix = list( "income_source", "income_amount", @@ -671,7 +671,12 @@ data_processed <- tar_plan( label = rep(list(NULL), length(vars)) ), ### Time-to-travel ----------------------------------------------------------- - travel_recoded_data = travel_recode(raw_data_clean), + travel_recoded_data = travel_recode( + raw_data_clean |> + dplyr::mutate( + gi1 = travel_recode_mode_other(x = gi1, y = gi1_other) + ) + ), ### Play --------------------------------------------------------------------- play_recoded_data = play_recode( vars = paste0("play", c(paste0(1, letters[1:7]), 2, paste0(3, letters[1:6]))), @@ -687,43 +692,44 @@ data_processed <- tar_plan( ### Water -------------------------------------------------------------------- water_recoded_data = water_recode( vars = c("wt2", "wt3", "wt3a", "wt3b", "wt4", "wt4a", "wt5", "wt6"), - .data = raw_data_clean, - na_values = c(88, 99, 888, 999) + .data = raw_data_clean |> + water_recode_sources(), + na_values = c(88, 99, 888, 999, 885, 8884, 8889) ), - ### Sanitation + ### Sanitation --------------------------------------------------------------- san_recoded_data = san_recode( vars = paste0("lusd", 1:8), .data = raw_data_clean, na_values = c(8, 9, 88, 99, 888, 999) ), - ### Hygiene + ### Hygiene ------------------------------------------------------------------ hygiene_recoded_data = hygiene_recode( vars = c(paste0("caha", 1:3), paste0("lusd", 9:11)), .data = raw_data_clean, na_values = c(8, 9, 88, 99) ), - ### Treatment-seeking - fever + ### Treatment-seeking - fever ------------------------------------------------ fever_recoded_data = fever_recode( vars = c(paste0("fever", 1:6), "fever6a", "fever7"), .data = raw_data_clean ), - ### Treatment-seeking - diarrhoea + ### Treatment-seeking - diarrhoea -------------------------------------------- diarrhoea_recoded_data = dia_recode( vars = c("ort1", paste0("ort1", letters[1:3]), paste0("ort", 2:4), paste0("ort5", letters[1:5]), "ort6", "ort7"), .data = raw_data_clean ), - ### Treatment-seeking - respiratory tract infections + ### Treatment-seeking - respiratory tract infections ------------------------- rti_recoded_data = rti_recode( vars = c("ch1", "ch1a", paste0("ch", 2:5), "ch5a"), .data = raw_data_clean ), - ### Breastfeeding + ### Breastfeeding ------------------------------------------------------------ bf_vars_map = bf_map_vars(survey_codebook), bf_recoded_data = bf_recode(vars = bf_vars_map, .data = raw_data_clean), - ### Food groups + ### Food groups -------------------------------------------------------------- fg_vars_map = fg_map_vars( - dairy = c("food_yogurt", "food_cheese"), + dairy = c("liquid_milk", "liquid_milk_sweet", "food_yogurt", "food_cheese"), starch = c("food_rice", "food_potatoes"), vita = c("food_pumpkin", "food_mango"), other_fruit_veg = c("food_oth_veg", "food_oth_fruit"), @@ -734,19 +740,19 @@ data_processed <- tar_plan( fg_recoded_data = fg_recode( vars = fg_vars_map, .data = raw_data_clean ), - ### Meals + ### Meals -------------------------------------------------------------------- meal_recoded_data = meal_recode(vars = "food_num", .data = raw_data_clean), - ### IYCF + ### IYCF --------------------------------------------------------------------- iycf_recoded_data = iycf_recode( .data = raw_data_clean, bf_recoded_data, fg_recoded_data, meal_recoded_data ), - ### FIES + ### FIES --------------------------------------------------------------------- fies_recoded_data = fies_recode( vars = paste0("fies0", 1:8), .data = raw_data_clean ), - ### Food stocks + ### Food stocks -------------------------------------------------------------- stock_recoded_data = stock_recode( vars = c("reserve1", "reserve1a", "reserve2", "reserve2a", "reserve3", "reserve3a", "reserve4", "reserve4a", @@ -754,48 +760,48 @@ data_processed <- tar_plan( "reserve7", "reserve7a"), .data = raw_data_clean ), - ### Pregnancy + ### Pregnancy ---------------------------------------------------------------- preg_recoded_data = preg_recode( vars = c("wh1", "wh2", "wh3", "wh4", "wh5", "wh6", "wh7", "wh8", "preg1", "preg2", "preg3"), .data = raw_data_clean ), - ### PMTCT + ### PMTCT -------------------------------------------------------------------- pmtct_recoded_data = pmtct_recode( vars = paste0("pmtct", 1:3), .data = raw_data_clean ), - ### Pregnancy - mosquito net + ### Pregnancy - mosquito net ------------------------------------------------- pnet_recoded_data = pnet_recode( vars = paste0("idk", 1:2), .data = raw_data_clean ), - ### Pre- and post-natal check + ### Pre- and post-natal check ------------------------------------------------ nc_recoded_data = nc_recode( vars = c(paste0("spc", 1:2), paste0("spc2", letters[1:2]), paste0("spc", 3:5), "spc5a", "spc6", paste0("spc6", letters[1:2]), "spc7", paste0("spc7", letters[1:2]), "ther1"), .data = raw_data_clean ), - ### Other RH + ### Other RH ----------------------------------------------------------------- rh_recoded_data = rh_recode( vars = c(paste0("chm", 1:2), paste0("fansidar", 1:2), "fol1", paste0("tt", 1:2)), .data = raw_data_clean ), - ### Family planning + ### Family planning ---------------------------------------------------------- fp_recoded_data = fp_recode( vars = c("pf1", "bs1", "bs1a", "bs2", "bs3", "bs4", "abor1", "abor1a"), .data = raw_data_clean_translated ), - ### Housing characteristics + ### Housing characteristics -------------------------------------------------- house_recoded_data = housing_recode(.data = raw_data_clean), - ### Associations + ### Associations ------------------------------------------------------------- association_recoded_data = association_recode(.data = raw_data_clean), - ## Household assets + ## Household assets ---------------------------------------------------------- asset_recoded_data = asset_recode(.data = raw_data_clean), - ### Concatenate recoded datasets + ### Concatenate recoded datasets --------------------------------------------- recoded_data = merge_recoded_dataset( df_list = list( mother_anthro_recoded_data, child_anthro_recoded_data, @@ -809,36 +815,134 @@ data_processed <- tar_plan( iycf_recoded_data, fies_recoded_data, stock_recoded_data, preg_recoded_data, pmtct_recoded_data, pnet_recoded_data, nc_recoded_data, rh_recoded_data, fp_recoded_data, house_recoded_data, - association_recoded_data, asset_recoded_data + association_recoded_data, asset_recoded_data, pica_recoded_data ) ) |> dplyr::mutate( spid = as.integer(spid) - ) + ), + ### Indicator lists ---------------------------------------------------------- + household_indicators_list = create_indicator_list(id = "household"), + carer_indicators_list = create_indicator_list(id = "carer"), + woman_indicators_list = create_indicator_list(id = "woman"), + child_indicators_list = create_indicator_list(id = "child") ) - ## Analysis - estimation ------------------------------------------------------- analysis_bootstrap <- tar_plan( - ### Bootstrap ---------------------------------------------------------------- - bootstrap_test = boot_estimates( + ### Household indicators ----------------------------------------------------- + bootstrap_household_indicators = boot_estimates_household( .data = recoded_data, w = sofala_ea_population, - vars = "hdds", - labs = "Household dietary diversity score", - replicates = 399 + replicates = 999, + indicator_list = household_indicators_list + ), + province_household_indicators = calculate_province_estimates( + results_table = bootstrap_household_indicators, + pop = sofala_district_population + ), + ### Carer indicators --------------------------------------------------------- + bootstrap_carer_indicators = boot_estimates_carer( + .data = recoded_data, + w = sofala_ea_population, + replicates = 999, + indicator_list = carer_indicators_list + ), + province_carer_indicators = calculate_province_estimates( + results_table = bootstrap_carer_indicators, + pop = sofala_district_population + ), + ### Women indicators ----------------------------------------------- + bootstrap_woman_indicators = boot_estimates_woman( + .data = recoded_data, + w = sofala_ea_population, + replicates = 999, + indicator_list = woman_indicators_list + ), + province_woman_indicators = calculate_province_estimates( + results_table = bootstrap_woman_indicators, + pop = sofala_district_population + ), + ### Child indicators ----------------------------------------------- + bootstrap_child_indicators = boot_estimates_child( + .data = recoded_data, + w = sofala_ea_population, + replicates = 999, + indicator_list = child_indicators_list + ), + province_child_indicators = calculate_province_estimates( + results_table = bootstrap_child_indicators, + pop = sofala_district_population + ), + ### Child anthropometry indicators ------------------------------------------- + bootstrap_stunting_probit_indicators = boot_probits_stunting( + .data = recoded_data, + w = sofala_ea_population, + replicates = 999 + ), + bootstrap_underweight_probit_indicators = boot_probits_underweight( + .data = recoded_data, + w = sofala_ea_population, + replicates = 999 + ), + bootstrap_whz_probit_indicators = boot_probits_whz( + .data = recoded_data, + w = sofala_ea_population, + replicates = 999 + ), + bootstrap_muac_probit_indicators = boot_probits_muac( + .data = recoded_data, + w = sofala_ea_population, + replicates = 999 + ), + bootstrap_child_anthro_probit_indicators = rbind( + bootstrap_stunting_probit_indicators, + bootstrap_underweight_probit_indicators, + bootstrap_whz_probit_indicators, + bootstrap_muac_probit_indicators + ) |> + (\(x) x[order(x$district), ])(), + province_child_anthro_indicators = calculate_province_estimates( + results_table = bootstrap_child_anthro_probit_indicators, + pop = sofala_district_population ) - ) - + ## Analysis - spatial interpolation -------------------------------------------- analysis_spatial <- tar_plan( ### Base interpolation grid -------------------------------------------------- - sofala_int_points = sp::spsample( - x = sf::as_Spatial(sofala_province), n = 10000, type = "hexagonal" - ), - sofala_int_grid = sp::HexPoints2SpatialPolygons(sofala_int_points) + sofala_int_grid = sf::st_make_grid( + sofala_province, cellsize = 0.008, square = FALSE, flat_topped = TRUE, + ) |> + (\(x) x[sofala_province])() |> + sf::st_transform(crs = 4326), + sofala_int_points = sf::st_centroid(sofala_int_grid) |> + sf::st_transform(crs = 4326), + ### Convert recoded data to sp class ----------------------------------------- + recoded_data_sf = create_sf_data(recoded_data), + interpolation_test = interpolate_indicators( + var = c("global_stunting", "moderate_stunting"), + sf_data = recoded_data_sf, + int_points = sofala_int_points + ), + ### Interpolate household indicators ----------------------------------------- + interpolation_household_indicators = interpolate_indicators( + sf_data = recoded_data_sf, int_points = sofala_int_points, + indicator_list = household_indicators_list + ), + interpolation_carer_indicators = interpolate_indicators( + sf_data = recoded_data_sf, int_points = sofala_int_points, + indicator_list = carer_indicators_list + ), + interpolation_woman_indicators = interpolate_indicators( + sf_data = recoded_data_sf, int_points = sofala_int_points, + indicator_list = woman_indicators_list + ), + interpolation_child_indicators = interpolate_indicators( + sf_data = recoded_data_sf, int_points = sofala_int_points, + indicator_list = child_indicators_list + ) ) @@ -932,6 +1036,250 @@ outputs <- tar_plan( subset(select = -geolocation), file = "data/sofala_recoded_data.csv", row.names = FALSE + ), + ### Indicator lists CSV + tar_target( + name = household_indicators_list_csv, + command = write.csv( + x = household_indicators_list, + file = "outputs/household_indicators_list.csv", + row.names = FALSE + ), + cue = tar_cue("always") + ), + tar_target( + name = carer_indicators_list_csv, + command = write.csv( + x = carer_indicators_list, + file = "outputs/carer_indicators_list.csv", + row.names = FALSE + ), + cue = tar_cue("always") + ), + tar_target( + name = woman_indicators_list_csv, + command = write.csv( + x = woman_indicators_list, + file = "outputs/woman_indicators_list.csv", + row.names = FALSE + ), + cue = tar_cue("always") + ), + tar_target( + name = child_indicators_list_csv, + command = write.csv( + x = child_indicators_list, + file = "outputs/child_indicators_list.csv", + row.names = FALSE + ), + cue = tar_cue("always") + ), + ### Create formatted indicator results tables -------------------------------- + household_indicators_results_table = create_results_table_by_district( + results_table = bootstrap_household_indicators, format = TRUE + ), + carer_indicators_results_table = create_results_table_by_district( + results_table = bootstrap_carer_indicators, format = TRUE + ), + woman_indicators_results_table = create_results_table_by_district( + results_table = bootstrap_woman_indicators, format = TRUE + ), + child_indicators_results_table = create_results_table_by_district( + results_table = bootstrap_child_indicators, format = TRUE + ), + child_anthro_probit_results_table = create_results_table_by_district( + results_table = bootstrap_child_anthro_probit_indicators, format = TRUE + ), + indicator_results_districts_xlsx = create_results_xlsx( + path = "outputs/indicator_results_districts.xlsx", + household = household_indicators_results_table, + carer = carer_indicators_results_table, + woman = woman_indicators_results_table, + child = child_indicators_results_table, + child_anthro = child_anthro_probit_results_table + ), + indicator_results_overall_xlsx = create_results_xlsx( + path = "outputs/indicator_results_overall.xlsx", + household = province_household_indicators |> + dplyr::mutate( + estimate = ifelse( + stringr::str_detect(indicator, "Mean"), + round(estimate, digits = 3), + round(estimate * 100, 2) + ), + lcl = ifelse( + stringr::str_detect(indicator, "Mean"), + round(lcl, digits = 3), + round(lcl * 100, 2) + ), + ucl = ifelse( + stringr::str_detect(indicator, "Mean"), + round(ucl, digits = 3), + round(ucl * 100, 2) + ) + ), + carer = province_carer_indicators |> + dplyr::mutate( + estimate = ifelse( + stringr::str_detect(indicator, "Mean"), + round(estimate, digits = 3), + round(estimate * 100, 2) + ), + lcl = ifelse( + stringr::str_detect(indicator, "Mean"), + round(lcl, digits = 3), + round(lcl * 100, 2) + ), + ucl = ifelse( + stringr::str_detect(indicator, "Mean"), + round(ucl, digits = 3), + round(ucl * 100, 2) + ) + ), + woman = province_woman_indicators |> + dplyr::mutate( + estimate = ifelse( + stringr::str_detect(indicator, "Mean"), + round(estimate, digits = 3), + round(estimate * 100, 2) + ), + lcl = ifelse( + stringr::str_detect(indicator, "Mean"), + round(lcl, digits = 3), + round(lcl * 100, 2) + ), + ucl = ifelse( + stringr::str_detect(indicator, "Mean"), + round(ucl, digits = 3), + round(ucl * 100, 2) + ) + ), + child = province_child_indicators |> + dplyr::mutate( + estimate = ifelse( + stringr::str_detect(indicator, "Mean"), + round(estimate, digits = 3), + round(estimate * 100, 2) + ), + lcl = ifelse( + stringr::str_detect(indicator, "Mean"), + round(lcl, digits = 3), + round(lcl * 100, 2) + ), + ucl = ifelse( + stringr::str_detect(indicator, "Mean"), + round(ucl, digits = 3), + round(ucl * 100, 2) + ) + ), + child_anthro = province_child_anthro_indicators |> + dplyr::mutate( + estimate = ifelse( + stringr::str_detect(indicator, "Mean"), + round(estimate, digits = 3), + round(estimate * 100, 2) + ), + lcl = ifelse( + stringr::str_detect(indicator, "Mean"), + round(lcl, digits = 3), + round(lcl * 100, 2) + ), + ucl = ifelse( + stringr::str_detect(indicator, "Mean"), + round(ucl, digits = 3), + round(ucl * 100, 2) + ) + ) + ), + ### Create formatted indicator results tables for mapping -------------------- + household_indicators_map_table = create_tables_by_indicator( + #household_indicators_results_table + bootstrap_household_indicators + ), + carer_indicators_map_table = create_tables_by_indicator( + #carer_indicators_results_table + bootstrap_carer_indicators + ), + woman_indicators_map_table = create_tables_by_indicator( + #woman_indicators_results_table + bootstrap_woman_indicators + ), + child_indicators_map_table = create_tables_by_indicator( + #child_indicators_results_table + bootstrap_child_indicators + ), + ### Mapping outputs ---------------------------------------------------------- + household_interpolation_maps = plot_qual_maps( + int_sf = interpolation_household_indicators |> + format_interpolation_results(household_indicators_list), + base_map = sofala_province, + n = 101, + pal = viridis::viridis(n = 101, alpha = 0.6), + breaks = "equal", + indicator_list = household_indicators_list + ), + household_choropleth_maps = plot_choropleth_maps( + var = household_indicators_list$indicator_variable, + results_map = merge( + sofala_district, household_indicators_map_table, + by.x = "ADM2_PT", by.y = "district" + ), + n = 5, pal = viridis::viridis(n = 5), breaks = "equal", + indicator_list = household_indicators_list + ), + carer_interpolation_maps = plot_qual_maps( + int_sf = interpolation_carer_indicators |> + format_interpolation_results(carer_indicators_list), + base_map = sofala_province, + n = 101, + pal = viridis::viridis(n = 101, alpha = 0.6), + breaks = "equal", + indicator_list = carer_indicators_list + ), + carer_choropleth_maps = plot_choropleth_maps( + var = carer_indicators_list$indicator_variable, + results_map = merge( + sofala_district, carer_indicators_map_table, + by.x = "ADM2_PT", by.y = "district" + ), + n = 5, pal = viridis::viridis(n = 5), breaks = "equal", + indicator_list = carer_indicators_list + ), + woman_interpolation_maps = plot_qual_maps( + int_sf = interpolation_woman_indicators |> + format_interpolation_results(woman_indicators_list), + base_map = sofala_province, + n = 101, + pal = viridis::viridis(n = 101, alpha = 0.6), + breaks = "equal", + indicator_list = woman_indicators_list + ), + woman_choropleth_maps = plot_choropleth_maps( + var = woman_indicators_list$indicator_variable, + results_map = merge( + sofala_district, woman_indicators_map_table, + by.x = "ADM2_PT", by.y = "district" + ), + n = 5, pal = viridis::viridis(n = 5), breaks = "equal", + indicator_list = woman_indicators_list + ), + child_interpolation_maps = plot_qual_maps( + int_sf = interpolation_child_indicators |> + format_interpolation_results(child_indicators_list), + base_map = sofala_province, + n = 101, + pal = viridis::viridis(n = 101, alpha = 0.6), + breaks = "equal", + indicator_list = child_indicators_list + ), + child_choropleth_maps = plot_choropleth_maps( + var = child_indicators_list$indicator_variable, + results_map = merge( + sofala_district, child_indicators_map_table, + by.x = "ADM2_PT", by.y = "district" + ), + n = 5, pal = viridis::viridis(n = 5), breaks = "equal", + indicator_list = child_indicators_list ) ) @@ -1001,6 +1349,7 @@ reports <- tar_plan( ) ) + ## Deploy targets -------------------------------------------------------------- deploy <- tar_plan( ### Deploy daily progress report ---------------------------------------------