From 6c2aea237e96d8963ec4632045188c21ce764310 Mon Sep 17 00:00:00 2001 From: dzvoti Date: Tue, 21 May 2024 14:55:30 +0100 Subject: [PATCH 01/12] feat: Add `createFortifiableFoodItemsTable` function - Added `createFortifiableFoodItemsTable` function to process food group, food genus, and food vehicle data from Excel sheets. - The function identifies fortifiable food groups and items, returning a table with vehicle IDs and fortifiable portions. - Utilizes dplyr for data manipulation and readxl for reading Excel files. - Includes documentation with roxygen2 for easy understanding and usage. --- R/createFortifiableFoodItemsTable.R | 67 +++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) create mode 100644 R/createFortifiableFoodItemsTable.R diff --git a/R/createFortifiableFoodItemsTable.R b/R/createFortifiableFoodItemsTable.R new file mode 100644 index 0000000..f1fb7ca --- /dev/null +++ b/R/createFortifiableFoodItemsTable.R @@ -0,0 +1,67 @@ +#' Create Fortifiable Food Items Table +#' +#' This function loads food group, food genus, and food vehicle data from Excel sheets, +#' processes the data to identify fortifiable food groups and items, and returns a table +#' of fortifiable food items with associated vehicle IDs and fortifiable portions. +#' +#' @return A data frame containing fortifiable food items with their respective vehicle IDs +#' and fortifiable portions. +#' @importFrom readxl read_excel +#' @importFrom dplyr select mutate case_when left_join +#' @export +#' @keywords internal +#' +#' @examples +#' \dontrun{ +#' fortifiable_food_items <- createFortifiableFoodItemsTable() +#' } +createFortifiableFoodItemsTable <- function( + food_file = "data/sd123/food group genus vehicle data.xlsx", + food_groups_sheet = "food_group", + food_genus_sheet = "food_genus", + food_vehicle_sheet = "food_vehicle") { + # Load data + food_groups <- readxl::read_excel(food_file, sheet = food_groups_sheet) + food_genus <- readxl::read_excel(food_file, sheet = food_genus_sheet) + food_vehicle <- readxl::read_excel(food_file, sheet = food_vehicle_sheet) + + # Create columns for food_vehicle_id and fortifiable_portion + # Create fortificants at food group level and merge with food_vehicle + fortifiable_food_groups <- food_groups |> + dplyr::select(food_group_id, food_group_name) |> + dplyr::mutate( + food_vehicle_id = dplyr::case_when( + food_group_id == "2035" ~ 1, + food_group_id == "2028" ~ 4, + food_group_id == "2037" ~ 2, + food_group_id == "2020" ~ 4, + TRUE ~ NA_integer_ + ), + fortifiable_portion = dplyr::case_when( + food_group_id == "2035" & food_vehicle_id == 1 ~ 100, + food_group_id == "2028" & food_vehicle_id == 4 ~ 100, + food_group_id == "2020" & food_vehicle_id == 4 ~ 50, + TRUE ~ NA_integer_ + ) + ) |> + dplyr::left_join(food_vehicle, by = "food_vehicle_id") + + # Merge fortifiable_food_groups with food_genus + fortifiable_food_items <- food_genus |> + dplyr::left_join(fortifiable_food_groups, by = c("food_group_id", "food_group_name")) + + # Override fortifiable_portion for food_genus with multiple fortificants + fortifiable_food_items <- fortifiable_food_items |> + dplyr::mutate( + fortifiable_portion = dplyr::case_when( + food_genus_id == "F0020.06" & food_vehicle_id == 1 ~ 80, + food_genus_id == "23140.03.02" & food_vehicle_id == 1 ~ 0, + "bread" %in% food_genus_name & food_vehicle_id == 1 ~ 75, # Katie email. 08-May-2024 + food_genus_name == "buns" & food_vehicle_id == 1 ~ 33, + TRUE ~ fortifiable_portion + ) + ) + + # Return fortifiable_food_items + return(fortifiable_food_items) +} From e0ed4e6ca19ed35b45aa1a279251e9886964b841 Mon Sep 17 00:00:00 2001 From: dzvoti Date: Fri, 7 Jun 2024 11:52:59 +0100 Subject: [PATCH 02/12] feat: Comprehensive function for calculating pre and post lsff summaries using afe method --- R/calculate_pre_and_post_lsff_summaries_afe.R | 257 ++++++++++++++++++ 1 file changed, 257 insertions(+) create mode 100644 R/calculate_pre_and_post_lsff_summaries_afe.R diff --git a/R/calculate_pre_and_post_lsff_summaries_afe.R b/R/calculate_pre_and_post_lsff_summaries_afe.R new file mode 100644 index 0000000..3cc7367 --- /dev/null +++ b/R/calculate_pre_and_post_lsff_summaries_afe.R @@ -0,0 +1,257 @@ +#' Calculate Baseline Nutrient Inadequacy (AFE Method) +#' +#' This function calculates the baseline inadequacy of nutrients for different administrative groups using the Adequate Food Energy (AFE) Method. +#' +#' @param householdConsumptionDf A dataframe containing household consumption data. Must contain columns: "householdId", "amountConsumedInG", "memberCount". +#' @param householdDetailsDf A dataframe containing household details. Must contain column: "householdId". +#' @param nctListDf A dataframe containing nutrient composition tables. Must contain columns: "nutrient", "foodId". +#' @param intakeThresholdsDf A dataframe containing intake thresholds for nutrients. Must contain columns: "nutrient", "CND". +#' @param aggregationGroup A character vector of administrative groups to aggregate the data. Must not be empty. Defaults to c("admin0Name", "admin1Name"). +#' @param MNList A character vector of nutrients to be included in the analysis. If empty, defaults to a comprehensive list of nutrients. +#' +#' @return A dataframe with the baseline inadequacy of nutrients for the specified administrative groups. +#' @export +#' +#' @examples +#' \dontrun{ +#' calculateBaselineInadequacyAfe( +#' householdConsumptionDf = householdConsumption, +#' householdDetailsDf = householdDetails, +#' nctListDf = nctList, +#' intakeThresholdsDf = intakeThresholds, +#' aggregationGroup = c("admin0Name", "admin1Name"), +#' MNList = c("Ca", "Carbohydrates") +#' ) +#' } +calculate_pre_and_post_lsff_summaries_afe <- function( + householdConsumptionDf = householdConsumption, + householdDetailsDf = householdDetails, + nctListDf = nctList, + intakeThresholdsDf = intakeThresholds, + aggregationGroup = c("admin0Name", "admin1Name"), + fortifiableFoodItemsDf = createFortifiableFoodItemsTable(), + foodVehicleName = "wheat flour", + years = c(2021:2024), + # MNList = c("Ca", "Carbohydrates", "Cu", "Energy", "Fat", "Fe", "Fibre", "I", "IP6", "Mg", "Protein", "Se", "Zn", "Ash", "B6", "B2", "D", "N", "K", "P", "Moisture", "Cholesterol", "E", "Na", "A", "C", "B12", "B1", "B3", "B9", "B5", "B7", "Mn"), + MNList = "A") { + # Define required columns + requiredConsumptionCols <- c("householdId", "amountConsumedInG") + requiredDetailsCols <- c("householdId", "memberCount") + requiredNctCols <- c("micronutrientId") + requiredIntakeCols <- c("nutrient", "CND") + + # Check if MNList is a character vector + if (!is.character(MNList)) { + stop("MNList must be a character vector e.g. c('A', 'Ca')") + } + + # Check if aggregationGroup is a character vector + if (!is.character(aggregationGroup)) { + stop("aggregationGroup must be a character vector e.g. c('admin0Name', 'admin1Name')") + } + + # Check if MNList and aggregationGroup are not empty + if (length(aggregationGroup) == 0) { + stop("aggregationGroup cannot be empty") + } + + # Check if input dataframes have required columns + if (!all(requiredConsumptionCols %in% names(householdConsumptionDf))) { + stop(paste("householdConsumptionDf must contain the following columns:", paste(requiredConsumptionCols, collapse = ", "))) + } + + if (!all(requiredDetailsCols %in% names(householdDetailsDf))) { + stop(paste("householdDetailsDf must contain the following column:", paste(requiredDetailsCols, collapse = ", "))) + } + + if (!all(requiredNctCols %in% names(nctListDf))) { + stop(paste("nctListDf must contain the following columns:", paste(requiredNctCols, collapse = ", "))) + } + + if (!all(requiredIntakeCols %in% names(intakeThresholdsDf))) { + stop(paste("intakeThresholdsDf must contain the following columns:", paste(requiredIntakeCols, collapse = ", "))) + } + + # Use the createMasterNct function to create a master NCT + masterNCT <- effectivenessCalculations::createMasterNct(nctList) + + # Filter the fortifiable food items to get the food vehicle + fortifiableFoodVehicle <- fortifiableFoodItemsDf |> + dplyr::filter(food_vehicle_name == foodVehicleName) + + ## Create a wider format for the intakeThresholds + earThreshholds <- intakeThresholdsDf |> + dplyr::select(nutrient, ear) |> + # Remove rows where ear is NA + dplyr::filter(!is.na(ear)) |> + # Leave thresholds for the nutrients in the MNList + dplyr::filter(nutrient %in% MNList) |> + tidyr::pivot_wider(names_from = nutrient, values_from = ear) |> + # Convert all columns to numeric + dplyr::mutate_all(as.numeric) |> + # Add a suffix of "ear" to the column names + dplyr::rename_with(~ paste0(., "SupplyEarThreshold"), dplyr::everything()) + + # Process the consumption data + # Load the consumption data + enrichedHouseholdConsumption <- householdConsumptionDf |> + # Not necessary by its a personal preference + tibble::as_tibble() |> + # Join the household details to the consumption data (Joining columns with the same name) + dplyr::left_join(householdDetailsDf) |> + # Join the master NCT to the consumption data + dplyr::left_join(masterNCT) |> + dplyr::left_join(fortifiableFoodVehicle, by = c("foodGenusId" = "food_genus_id")) |> + # Convert all columns needed for calculations to numeric + dplyr::mutate_at(c("amountConsumedInG", "afeFactor", "fortifiable_portion", MNList), as.numeric) |> + dplyr::mutate(dplyr::across(MNList, ~ . / afeFactor), amountConsumedInGAfe = amountConsumedInG / afeFactor) |> + dplyr::bind_cols(earThreshholds) + + + # Calculate HH count summaries + HHCountSummaries <- enrichedHouseholdConsumption |> + dplyr::group_by(dplyr::across(dplyr::all_of(aggregationGroup))) |> + dplyr::distinct(householdId) |> + dplyr::summarise(householdsCount = dplyr::n()) + + # Fortification vehicle reach summaries + fortificationVehicleReach <- enrichedHouseholdConsumption |> + dplyr::group_by(dplyr::across(dplyr::all_of(aggregationGroup))) |> + dplyr::filter(!is.na(food_vehicle_name)) |> + dplyr::distinct(householdId) |> + dplyr::summarize(fortification_vehicle_reach_hh_count = dplyr::n()) + + # Mean and median fortification vehicle amounts consumed + fortificationVehicleAmountsConsumedAfe <- enrichedHouseholdConsumption |> + dplyr::filter(!is.na(food_vehicle_name)) |> + dplyr::group_by(householdId) |> + dplyr::summarize(median_fortification_vehicle_amountConsumedInGAfe = median(amountConsumedInGAfe, na.rm = TRUE), mean_fortification_vehicle_amountConsumedInGAfe = mean(amountConsumedInGAfe, na.rm = TRUE)) |> + dplyr::left_join(householdDetailsDf) |> + dplyr::group_by(dplyr::across(dplyr::all_of(aggregationGroup))) |> + dplyr::summarize( + median_fortification_vehicle_amountConsumedInGAfe = median(median_fortification_vehicle_amountConsumedInGAfe, na.rm = TRUE), mean_fortification_vehicle_amountConsumedInGAfe = mean(mean_fortification_vehicle_amountConsumedInGAfe, na.rm = TRUE) + ) + + # Average daily consumption per AFE + amountConsumedPerDayAfe <- enrichedHouseholdConsumption |> + dplyr::group_by(householdId) |> + dplyr::summarize( + dailyAmountConsumedPerAfeInG = sum(amountConsumedInG / 100 * afeFactor, na.rm = TRUE) + ) |> + dplyr::left_join(householdDetailsDf) |> + dplyr::group_by(dplyr::across(dplyr::all_of(aggregationGroup))) |> + dplyr::summarize( + meanDailyAmountConsumedPerAfeInG = mean(dailyAmountConsumedPerAfeInG, na.rm = TRUE), + medianDailyAmountConsumedPerAfeInG = median(dailyAmountConsumedPerAfeInG, na.rm = TRUE) + ) + + # Amount consumed containing fortificant + amountConsumedContainingFortificant <- enrichedHouseholdConsumption |> + dplyr::group_by(householdId) |> + dplyr::filter(!is.na(food_vehicle_name)) |> + dplyr::summarize( + dailyAmountConsumedPerAfeInG = sum(amountConsumedInG / afeFactor, na.rm = TRUE) + ) |> + dplyr::left_join(householdDetailsDf) |> + dplyr::group_by(dplyr::across(dplyr::all_of(aggregationGroup))) |> + dplyr::summarize( + meanDailyamountConsumedContainingFortificantInG = mean(dailyAmountConsumedPerAfeInG, na.rm = TRUE), + medianDailyAmountConsumedContainingFortificantInG = median(dailyAmountConsumedPerAfeInG, na.rm = TRUE) + ) + + # Merge the summaries + initialSummaries <- HHCountSummaries |> + dplyr::left_join(fortificationVehicleReach) |> + dplyr::left_join(amountConsumedPerDayAfe) |> + dplyr::left_join(amountConsumedContainingFortificant) |> + dplyr::left_join(fortificationVehicleAmountsConsumedAfe) + + + + for (nutrient in MNList) { + enrichedHouseholdConsumption[paste0(nutrient, "_BaseSupply")] <- enrichedHouseholdConsumption[nutrient] / 100 * enrichedHouseholdConsumption["amountConsumedInG"] + + for (year in years) { + # Calculate the supply of the nutrient with LSFF per food item + enrichedHouseholdConsumption[paste0(nutrient, "_", year, "_LSFFSupply")] <- enrichedHouseholdConsumption[paste0(nutrient, "_BaseSupply")] * yearAverageFortificationLevel(fortification_vehicle = foodVehicleName, Year = year, MN = nutrient) * enrichedHouseholdConsumption["fortifiable_portion"] / 100 + } + } + + # aggregate nutrient supplies by household + nutrientSupply <- enrichedHouseholdConsumption |> + dplyr::group_by(householdId) |> + dplyr::summarize( + dplyr::across(dplyr::ends_with("_BaseSupply"), ~ sum(.x, na.rm = TRUE), .names = "{.col}"), + dplyr::across(dplyr::ends_with("_LSFFSupply"), ~ sum(.x, na.rm = TRUE), .names = "{.col}") + ) + + # Calculate mean and median nutrient supplies + # TODO: These were checked and are consistent with the maps tool. + medianNutrientSupplySummaries <- nutrientSupply |> + dplyr::left_join(householdDetailsDf) |> + dplyr::group_by(dplyr::across(dplyr::all_of(aggregationGroup))) |> + dplyr::summarize( + dplyr::across(dplyr::ends_with("_BaseSupply"), ~ round(mean(.x, na.rm = TRUE), 0), .names = "{.col}MeanSupply"), + dplyr::across(dplyr::ends_with("_BaseSupply"), ~ round(median(.x, na.rm = TRUE), 0), .names = "{.col}MedianSupply") + ) + + # Add _BaseSupply and _LSFFSupply for each nutrient and year combo + for (nutrient in MNList) { + for (year in years) { + nutrientSupply[paste0(nutrient, "_", year, "_BaseAndLSFFTotalSupply")] <- nutrientSupply[paste0(nutrient, "_BaseSupply")] + nutrientSupply[paste0(nutrient, "_", year, "_LSFFSupply")] + } + } + + # Remerge the household details + enrichedNutrientSupply <- nutrientSupply |> + # corce afefactor to numeric + dplyr::left_join(householdDetailsDf) |> + dplyr::bind_cols(earThreshholds) + + + # Create adequacy columns for each Baseline and LSFF nutrient supply + # NOTE: This code is not pretty and can be improved. It works for now + for (nutrient in MNList) { + if (!is.na(effectivenessCalculations::getMnThresholds(intakeThresholds, nutrient, "ear"))) { + enrichedNutrientSupply[paste0(nutrient, "_base_supply_ear_inadequacy")] <- ifelse(enrichedNutrientSupply[paste0(nutrient, "_BaseSupply")] >= effectivenessCalculations::getMnThresholds(intakeThresholdsDf, nutrient, "ear"), 0, 1) + } + for (year in years) { + if (!is.na(effectivenessCalculations::getMnThresholds(intakeThresholds, nutrient, "ear"))) { + enrichedNutrientSupply[paste0(nutrient, "_", year, "_base_and_lsff_ear_inadequacy")] <- ifelse(enrichedNutrientSupply[paste0(nutrient, "_", year, "_BaseAndLSFFTotalSupply")] >= effectivenessCalculations::getMnThresholds(intakeThresholdsDf, nutrient, "ear"), 0, 1) + } + } + } + + # Check if the intake is above the Upper Limit + for (nutrient in MNList) { + if (!is.na(effectivenessCalculations::getMnThresholds(intakeThresholds, nutrient, "ul"))) { + enrichedNutrientSupply[paste0(nutrient, "_base_ul_exceedance")] <- ifelse(enrichedNutrientSupply[paste0(nutrient, "_BaseSupply")] > effectivenessCalculations::getMnThresholds(intakeThresholdsDf, nutrient, "ul"), 1, 0) + } + for (year in years) { + if (!is.na(effectivenessCalculations::getMnThresholds(intakeThresholds, nutrient, "ul"))) { + enrichedNutrientSupply[paste0(nutrient, "_", year, "_base_and_lsff_ul_exceedance")] <- ifelse(enrichedNutrientSupply[paste0(nutrient, "_", year, "_BaseAndLSFFTotalSupply")] > effectivenessCalculations::getMnThresholds(intakeThresholdsDf, nutrient, "ul"), 1, 0) + } + } + } + + # Create adequacy summaries + inadequacySummarries <- enrichedNutrientSupply |> + dplyr::left_join(householdDetailsDf) |> + dplyr::group_by(dplyr::across(dplyr::all_of(aggregationGroup))) |> + dplyr::summarize( + dplyr::across(dplyr::ends_with("_base_supply_ear_inadequacy"), ~ sum(.x, na.rm = TRUE), .names = "{.col}_count"), + dplyr::across(dplyr::ends_with("_base_ul_exceedance"), ~ sum(.x, na.rm = TRUE), .names = "{.col}_count") + ) |> + dplyr::left_join(initialSummaries) |> + dplyr::mutate(dplyr::across(dplyr::ends_with("_count"), ~ round((.x * 100 / householdsCount), 2), .names = "{.col}_perc")) + + # Get the column order for the data + columnOrder <- sort(names(inadequacySummarries)) + + # Reorder the columns for better readability + finalSummarries <- inadequacySummarries |> + dplyr::select(dplyr::all_of(columnOrder)) |> + dplyr::select(aggregationGroup, householdsCount, dplyr::everything()) + + return(finalSummarries) +} From a3113d004c0b4159e402ed65cdfcda48be0af876 Mon Sep 17 00:00:00 2001 From: dzvoti Date: Fri, 7 Jun 2024 12:01:51 +0100 Subject: [PATCH 03/12] Updated documentation for calculate_pre_and_post_lsff_summaries function - Revised and expanded the function's documentation to provide clearer descriptions of parameters and return value. - Specified default values for parameters where applicable. - Included an example usage section in the documentation. - Ensured all required columns for input dataframes are clearly outlined and validated within the function. --- R/calculate_pre_and_post_lsff_summaries_afe.R | 43 +++++++++---------- 1 file changed, 21 insertions(+), 22 deletions(-) diff --git a/R/calculate_pre_and_post_lsff_summaries_afe.R b/R/calculate_pre_and_post_lsff_summaries_afe.R index 3cc7367..91b90d6 100644 --- a/R/calculate_pre_and_post_lsff_summaries_afe.R +++ b/R/calculate_pre_and_post_lsff_summaries_afe.R @@ -1,29 +1,35 @@ -#' Calculate Baseline Nutrient Inadequacy (AFE Method) +#' Calculate Pre and Post LSFF Nutrient Summaries #' -#' This function calculates the baseline inadequacy of nutrients for different administrative groups using the Adequate Food Energy (AFE) Method. +#' This function calculates summaries of nutrient inadequacy before and after large-scale food fortification (LSFF) for different administrative groups using the Adult Female Equivalent (AFE) Method. #' -#' @param householdConsumptionDf A dataframe containing household consumption data. Must contain columns: "householdId", "amountConsumedInG", "memberCount". -#' @param householdDetailsDf A dataframe containing household details. Must contain column: "householdId". -#' @param nctListDf A dataframe containing nutrient composition tables. Must contain columns: "nutrient", "foodId". +#' @param householdConsumptionDf A dataframe containing household consumption data. Must contain columns: "householdId", "amountConsumedInG". +#' @param householdDetailsDf A dataframe containing household details. Must contain columns: "householdId", "memberCount". +#' @param nctListDf A dataframe containing nutrient composition tables. Must contain column: "nutrient". #' @param intakeThresholdsDf A dataframe containing intake thresholds for nutrients. Must contain columns: "nutrient", "CND". #' @param aggregationGroup A character vector of administrative groups to aggregate the data. Must not be empty. Defaults to c("admin0Name", "admin1Name"). -#' @param MNList A character vector of nutrients to be included in the analysis. If empty, defaults to a comprehensive list of nutrients. +#' @param fortifiableFoodItemsDf A dataframe containing fortifiable food items. Generated using the function `createFortifiableFoodItemsTable()`. +#' @param foodVehicleName A character string specifying the name of the food vehicle for fortification. Defaults to "wheat flour". +#' @param years A numeric vector specifying the years for which LSFF is analyzed. Defaults to 2021:2024. +#' @param MNList A character vector of nutrients to be included in the analysis. Defaults to "A". Must not be empty. #' -#' @return A dataframe with the baseline inadequacy of nutrients for the specified administrative groups. +#' @return A dataframe with the summaries of nutrient inadequacy for the specified administrative groups before and after LSFF. #' @export #' #' @examples #' \dontrun{ -#' calculateBaselineInadequacyAfe( +#' calculate_pre_and_post_lsff_summaries( #' householdConsumptionDf = householdConsumption, #' householdDetailsDf = householdDetails, #' nctListDf = nctList, #' intakeThresholdsDf = intakeThresholds, #' aggregationGroup = c("admin0Name", "admin1Name"), -#' MNList = c("Ca", "Carbohydrates") +#' fortifiableFoodItemsDf = createFortifiableFoodItemsTable(), +#' foodVehicleName = "wheat flour", +#' years = c(2021:2024), +#' MNList = c("A", "Ca") #' ) #' } -calculate_pre_and_post_lsff_summaries_afe <- function( +calculate_pre_and_post_lsff_summaries <- function( householdConsumptionDf = householdConsumption, householdDetailsDf = householdDetails, nctListDf = nctList, @@ -32,7 +38,6 @@ calculate_pre_and_post_lsff_summaries_afe <- function( fortifiableFoodItemsDf = createFortifiableFoodItemsTable(), foodVehicleName = "wheat flour", years = c(2021:2024), - # MNList = c("Ca", "Carbohydrates", "Cu", "Energy", "Fat", "Fe", "Fibre", "I", "IP6", "Mg", "Protein", "Se", "Zn", "Ash", "B6", "B2", "D", "N", "K", "P", "Moisture", "Cholesterol", "E", "Na", "A", "C", "B12", "B1", "B3", "B9", "B5", "B7", "Mn"), MNList = "A") { # Define required columns requiredConsumptionCols <- c("householdId", "amountConsumedInG") @@ -107,7 +112,6 @@ calculate_pre_and_post_lsff_summaries_afe <- function( dplyr::mutate(dplyr::across(MNList, ~ . / afeFactor), amountConsumedInGAfe = amountConsumedInG / afeFactor) |> dplyr::bind_cols(earThreshholds) - # Calculate HH count summaries HHCountSummaries <- enrichedHouseholdConsumption |> dplyr::group_by(dplyr::across(dplyr::all_of(aggregationGroup))) |> @@ -166,8 +170,6 @@ calculate_pre_and_post_lsff_summaries_afe <- function( dplyr::left_join(amountConsumedContainingFortificant) |> dplyr::left_join(fortificationVehicleAmountsConsumedAfe) - - for (nutrient in MNList) { enrichedHouseholdConsumption[paste0(nutrient, "_BaseSupply")] <- enrichedHouseholdConsumption[nutrient] / 100 * enrichedHouseholdConsumption["amountConsumedInG"] @@ -177,7 +179,7 @@ calculate_pre_and_post_lsff_summaries_afe <- function( } } - # aggregate nutrient supplies by household + # Aggregate nutrient supplies by household nutrientSupply <- enrichedHouseholdConsumption |> dplyr::group_by(householdId) |> dplyr::summarize( @@ -204,19 +206,16 @@ calculate_pre_and_post_lsff_summaries_afe <- function( # Remerge the household details enrichedNutrientSupply <- nutrientSupply |> - # corce afefactor to numeric dplyr::left_join(householdDetailsDf) |> dplyr::bind_cols(earThreshholds) - # Create adequacy columns for each Baseline and LSFF nutrient supply - # NOTE: This code is not pretty and can be improved. It works for now for (nutrient in MNList) { - if (!is.na(effectivenessCalculations::getMnThresholds(intakeThresholds, nutrient, "ear"))) { + if (!is.na(effectivenessCalculations::getMnThresholds(intakeThresholdsDf, nutrient, "ear"))) { enrichedNutrientSupply[paste0(nutrient, "_base_supply_ear_inadequacy")] <- ifelse(enrichedNutrientSupply[paste0(nutrient, "_BaseSupply")] >= effectivenessCalculations::getMnThresholds(intakeThresholdsDf, nutrient, "ear"), 0, 1) } for (year in years) { - if (!is.na(effectivenessCalculations::getMnThresholds(intakeThresholds, nutrient, "ear"))) { + if (!is.na(effectivenessCalculations::getMnThresholds(intakeThresholdsDf, nutrient, "ear"))) { enrichedNutrientSupply[paste0(nutrient, "_", year, "_base_and_lsff_ear_inadequacy")] <- ifelse(enrichedNutrientSupply[paste0(nutrient, "_", year, "_BaseAndLSFFTotalSupply")] >= effectivenessCalculations::getMnThresholds(intakeThresholdsDf, nutrient, "ear"), 0, 1) } } @@ -224,11 +223,11 @@ calculate_pre_and_post_lsff_summaries_afe <- function( # Check if the intake is above the Upper Limit for (nutrient in MNList) { - if (!is.na(effectivenessCalculations::getMnThresholds(intakeThresholds, nutrient, "ul"))) { + if (!is.na(effectivenessCalculations::getMnThresholds(intakeThresholdsDf, nutrient, "ul"))) { enrichedNutrientSupply[paste0(nutrient, "_base_ul_exceedance")] <- ifelse(enrichedNutrientSupply[paste0(nutrient, "_BaseSupply")] > effectivenessCalculations::getMnThresholds(intakeThresholdsDf, nutrient, "ul"), 1, 0) } for (year in years) { - if (!is.na(effectivenessCalculations::getMnThresholds(intakeThresholds, nutrient, "ul"))) { + if (!is.na(effectivenessCalculations::getMnThresholds(intakeThresholdsDf, nutrient, "ul"))) { enrichedNutrientSupply[paste0(nutrient, "_", year, "_base_and_lsff_ul_exceedance")] <- ifelse(enrichedNutrientSupply[paste0(nutrient, "_", year, "_BaseAndLSFFTotalSupply")] > effectivenessCalculations::getMnThresholds(intakeThresholdsDf, nutrient, "ul"), 1, 0) } } From be88e2b40c59c2c4f7be47e6f55cb12cbc484c22 Mon Sep 17 00:00:00 2001 From: dzvoti Date: Fri, 7 Jun 2024 12:52:16 +0100 Subject: [PATCH 04/12] Add `yearAverageFortificationLevel` function to calculate average fortification levels - Created `yearAverageFortificationLevel` function to extract year specific average fortification levels. - Deafults to load average fortification levels from a CSV file if not available. - The function returns the average fortification level for a specific year and micronutrient. - Added documentation for the function, including parameters, return value, and an example usage. - The function reads data from "data/average_fortification_levels.csv" using readr and here packages. --- R/loadAverageFortificationLevels.R | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) create mode 100644 R/loadAverageFortificationLevels.R diff --git a/R/loadAverageFortificationLevels.R b/R/loadAverageFortificationLevels.R new file mode 100644 index 0000000..63de47c --- /dev/null +++ b/R/loadAverageFortificationLevels.R @@ -0,0 +1,20 @@ +#' Year Average Fortification Level +#' +#' This function loads the average fortification levels from a CSV file located in the data directory, +#' and then returns the average fortification level for a specific year and micronutrient. +#' +#' @param fortification_vehicle A string specifying the fortification vehicle. +#' @param Year An integer specifying the year. +#' @param MN A string specifying the micronutrient. +#' @param fortificationLevels A dataframe containing the average fortification levels. +#' @return A numeric value representing the average fortification level for the specified year and micronutrient. +#' @examples +#' @keywords internal +#' \dontrun{ +#' avgFortificationLevel <- yearAverageFortificationLevel("salt", 2024, "iodine") +#' } +yearAverageFortificationLevel <- function(fortification_vehicle, Year, MN, fortificationLevels = readr::read_csv(here::here("data/average_fortification_levels.csv"))) { + yearAverageFortificationLevel <- fortificationLevels[fortificationLevels$Year == Year, MN][[1]] + + return(yearAverageFortificationLevel) +} From 6d0644a54e67263e63511ff9beede5ee407c032f Mon Sep 17 00:00:00 2001 From: dzvoti Date: Fri, 7 Jun 2024 12:55:53 +0100 Subject: [PATCH 05/12] Fix documentation typo in calculate_pre_and_post_lsff_summaries function - Corrected the column name in the @param description for intakeThresholdsDf from "CND" to "ear". - Ensured the documentation accurately reflects the required columns for each input dataframe. --- R/calculate_pre_and_post_lsff_summaries_afe.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/calculate_pre_and_post_lsff_summaries_afe.R b/R/calculate_pre_and_post_lsff_summaries_afe.R index 91b90d6..fd34bca 100644 --- a/R/calculate_pre_and_post_lsff_summaries_afe.R +++ b/R/calculate_pre_and_post_lsff_summaries_afe.R @@ -5,7 +5,7 @@ #' @param householdConsumptionDf A dataframe containing household consumption data. Must contain columns: "householdId", "amountConsumedInG". #' @param householdDetailsDf A dataframe containing household details. Must contain columns: "householdId", "memberCount". #' @param nctListDf A dataframe containing nutrient composition tables. Must contain column: "nutrient". -#' @param intakeThresholdsDf A dataframe containing intake thresholds for nutrients. Must contain columns: "nutrient", "CND". +#' @param intakeThresholdsDf A dataframe containing intake thresholds for nutrients. Must contain columns: "nutrient", "ear". #' @param aggregationGroup A character vector of administrative groups to aggregate the data. Must not be empty. Defaults to c("admin0Name", "admin1Name"). #' @param fortifiableFoodItemsDf A dataframe containing fortifiable food items. Generated using the function `createFortifiableFoodItemsTable()`. #' @param foodVehicleName A character string specifying the name of the food vehicle for fortification. Defaults to "wheat flour". @@ -29,7 +29,7 @@ #' MNList = c("A", "Ca") #' ) #' } -calculate_pre_and_post_lsff_summaries <- function( +calculate_pre_and_post_lsff_summaries_afe <- function( householdConsumptionDf = householdConsumption, householdDetailsDf = householdDetails, nctListDf = nctList, From b8fd97b4b48e96dbab9541bb114d38120f0aceb1 Mon Sep 17 00:00:00 2001 From: dzvoti Date: Fri, 7 Jun 2024 13:00:07 +0100 Subject: [PATCH 06/12] Fix typo in getMnThresholds function example - Corrected the example data frame in the getMnThresholds function documentation. - Ensured the example accurately reflects the correct micronutrient names ("vitaminA", "vitaminB", "vitaminC"). - Updated the example to provide clear guidance on using the getMnThresholds function. --- R/getMnThresholds.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/getMnThresholds.R b/R/getMnThresholds.R index 040d33c..95322fd 100644 --- a/R/getMnThresholds.R +++ b/R/getMnThresholds.R @@ -10,8 +10,10 @@ #' #' @examples #' \dontrun{ -#' intakeThresholds <- data.frame(nutrient = c("vitaminA", "vitaminB", "vitaminC"), -#' ear = c(0.5, 0.6, 0.7), ul = c(1, 1.2, 1.3), unitAdequacy = c(0.8, 0.9, 1)) +#' intakeThresholds <- data.frame( +#' nutrient = c("vitaminA", "vitaminB", "vitaminC"), +#' ear = c(0.5, 0.6, 0.7), ul = c(1, 1.2, 1.3), unitAdequacy = c(0.8, 0.9, 1) +#' ) #' thresholds <- getMnThresholds(intakeThresholds, "vitaminA", "ul") #' } #' From 0edea0e1e019202b038fc0b1a87c307544f85bbe Mon Sep 17 00:00:00 2001 From: dzvoti Date: Fri, 7 Jun 2024 13:11:43 +0100 Subject: [PATCH 07/12] chore: documentation updates through `document()` function --- ...lculate_pre_and_post_lsff_summaries_afe.Rd | 58 +++++++++++++++++++ man/createFortifiableFoodItemsTable.Rd | 28 +++++++++ man/getMnThresholds.Rd | 6 +- man/yearAverageFortificationLevel.Rd | 36 ++++++++++++ 4 files changed, 126 insertions(+), 2 deletions(-) create mode 100644 man/calculate_pre_and_post_lsff_summaries_afe.Rd create mode 100644 man/createFortifiableFoodItemsTable.Rd create mode 100644 man/yearAverageFortificationLevel.Rd diff --git a/man/calculate_pre_and_post_lsff_summaries_afe.Rd b/man/calculate_pre_and_post_lsff_summaries_afe.Rd new file mode 100644 index 0000000..3cb22a5 --- /dev/null +++ b/man/calculate_pre_and_post_lsff_summaries_afe.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/calculate_pre_and_post_lsff_summaries_afe.R +\name{calculate_pre_and_post_lsff_summaries_afe} +\alias{calculate_pre_and_post_lsff_summaries_afe} +\title{Calculate Pre and Post LSFF Nutrient Summaries} +\usage{ +calculate_pre_and_post_lsff_summaries_afe( + householdConsumptionDf = householdConsumption, + householdDetailsDf = householdDetails, + nctListDf = nctList, + intakeThresholdsDf = intakeThresholds, + aggregationGroup = c("admin0Name", "admin1Name"), + fortifiableFoodItemsDf = createFortifiableFoodItemsTable(), + foodVehicleName = "wheat flour", + years = c(2021:2024), + MNList = "A" +) +} +\arguments{ +\item{householdConsumptionDf}{A dataframe containing household consumption data. Must contain columns: "householdId", "amountConsumedInG".} + +\item{householdDetailsDf}{A dataframe containing household details. Must contain columns: "householdId", "memberCount".} + +\item{nctListDf}{A dataframe containing nutrient composition tables. Must contain column: "nutrient".} + +\item{intakeThresholdsDf}{A dataframe containing intake thresholds for nutrients. Must contain columns: "nutrient", "ear".} + +\item{aggregationGroup}{A character vector of administrative groups to aggregate the data. Must not be empty. Defaults to c("admin0Name", "admin1Name").} + +\item{fortifiableFoodItemsDf}{A dataframe containing fortifiable food items. Generated using the function \code{createFortifiableFoodItemsTable()}.} + +\item{foodVehicleName}{A character string specifying the name of the food vehicle for fortification. Defaults to "wheat flour".} + +\item{years}{A numeric vector specifying the years for which LSFF is analyzed. Defaults to 2021:2024.} + +\item{MNList}{A character vector of nutrients to be included in the analysis. Defaults to "A". Must not be empty.} +} +\value{ +A dataframe with the summaries of nutrient inadequacy for the specified administrative groups before and after LSFF. +} +\description{ +This function calculates summaries of nutrient inadequacy before and after large-scale food fortification (LSFF) for different administrative groups using the Adult Female Equivalent (AFE) Method. +} +\examples{ +\dontrun{ +calculate_pre_and_post_lsff_summaries( + householdConsumptionDf = householdConsumption, + householdDetailsDf = householdDetails, + nctListDf = nctList, + intakeThresholdsDf = intakeThresholds, + aggregationGroup = c("admin0Name", "admin1Name"), + fortifiableFoodItemsDf = createFortifiableFoodItemsTable(), + foodVehicleName = "wheat flour", + years = c(2021:2024), + MNList = c("A", "Ca") +) +} +} diff --git a/man/createFortifiableFoodItemsTable.Rd b/man/createFortifiableFoodItemsTable.Rd new file mode 100644 index 0000000..6666313 --- /dev/null +++ b/man/createFortifiableFoodItemsTable.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/createFortifiableFoodItemsTable.R +\name{createFortifiableFoodItemsTable} +\alias{createFortifiableFoodItemsTable} +\title{Create Fortifiable Food Items Table} +\usage{ +createFortifiableFoodItemsTable( + food_file = "data/sd123/food group genus vehicle data.xlsx", + food_groups_sheet = "food_group", + food_genus_sheet = "food_genus", + food_vehicle_sheet = "food_vehicle" +) +} +\value{ +A data frame containing fortifiable food items with their respective vehicle IDs +and fortifiable portions. +} +\description{ +This function loads food group, food genus, and food vehicle data from Excel sheets, +processes the data to identify fortifiable food groups and items, and returns a table +of fortifiable food items with associated vehicle IDs and fortifiable portions. +} +\examples{ +\dontrun{ +fortifiable_food_items <- createFortifiableFoodItemsTable() +} +} +\keyword{internal} diff --git a/man/getMnThresholds.Rd b/man/getMnThresholds.Rd index 4af2d25..03ef3df 100644 --- a/man/getMnThresholds.Rd +++ b/man/getMnThresholds.Rd @@ -21,8 +21,10 @@ This function retrieves the thresholds for a specified micronutrient from a data } \examples{ \dontrun{ -intakeThresholds <- data.frame(nutrient = c("vitaminA", "vitaminB", "vitaminC"), - ear = c(0.5, 0.6, 0.7), ul = c(1, 1.2, 1.3), unitAdequacy = c(0.8, 0.9, 1)) +intakeThresholds <- data.frame( + nutrient = c("vitaminA", "vitaminB", "vitaminC"), + ear = c(0.5, 0.6, 0.7), ul = c(1, 1.2, 1.3), unitAdequacy = c(0.8, 0.9, 1) +) thresholds <- getMnThresholds(intakeThresholds, "vitaminA", "ul") } diff --git a/man/yearAverageFortificationLevel.Rd b/man/yearAverageFortificationLevel.Rd new file mode 100644 index 0000000..f60ab7f --- /dev/null +++ b/man/yearAverageFortificationLevel.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/loadAverageFortificationLevels.R +\name{yearAverageFortificationLevel} +\alias{yearAverageFortificationLevel} +\title{Year Average Fortification Level} +\usage{ +yearAverageFortificationLevel( + fortification_vehicle, + Year, + MN, + fortificationLevels = + readr::read_csv(here::here("data/average_fortification_levels.csv")) +) +} +\arguments{ +\item{fortification_vehicle}{A string specifying the fortification vehicle.} + +\item{Year}{An integer specifying the year.} + +\item{MN}{A string specifying the micronutrient.} + +\item{fortificationLevels}{A dataframe containing the average fortification levels.} +} +\value{ +A numeric value representing the average fortification level for the specified year and micronutrient. +} +\description{ +This function loads the average fortification levels from a CSV file located in the data directory, +and then returns the average fortification level for a specific year and micronutrient. +} +\examples{ +\dontrun{ +avgFortificationLevel <- yearAverageFortificationLevel("wheat flour", 2024, "A") +} +} +\keyword{internal} From fa0edd64cc6f3da15ceedc2e2a29da3ceeb6d9df Mon Sep 17 00:00:00 2001 From: dzvoti Date: Fri, 7 Jun 2024 13:12:22 +0100 Subject: [PATCH 08/12] `README` file update to reflect new functionality --- README.Rmd | 71 ++++++++++-------------------------------------- README.md | 80 ++++++++++++------------------------------------------ 2 files changed, 33 insertions(+), 118 deletions(-) diff --git a/README.Rmd b/README.Rmd index 7b96cce..5bdefc5 100644 --- a/README.Rmd +++ b/README.Rmd @@ -34,67 +34,26 @@ You can install the development version of effectivenessCalculations from [GitHu devtools::install_github("dzvoti/effectivenessCalculations") ``` -## Baseline Inadequacy Statistics Example +## Basic Examples -This is a basic example which shows you how to calculate the baseline inadequacy for a micronutrient. The function `calculateBaselineInadequacyAfe` calculates the baseline inadequacy for a micronutrient.The function `calculateBaselineInadequacyCND` calculates the baseline inadequacy based on nutrient density. - - +### Calculate pre and post fortification intake supplies, fortification vehicle reach and Inadequacy Summaries -### Baseline Inadequacy Based on apparent intake per Adult Female Equivalent(AFE) +This is how to calculate the pre and post fortification intake supplies, fortification vehicle reach and Inadequacy Summaries. The function `calculate_pre_and_post_lsff_summaries_afe` calculates the pre and post fortification intake supplies, fortification vehicle reach and Inadequacy Summaries. -```{r calculateBaselineInadequacy(AFE), eval=FALSE,warning=FALSE,message=FALSE} +```{r eval=FALSE} library(effectivenessCalculations) -# Calculate baseline inadequacy for a micronutrient -calculateBaselineInadequacyAfe( - MNList = c("A"), - householdConsumptionDf = householdConsumption, - householdDetailsDf = householdDetails, - nctListDf = nctList, - intakeThresholdsDf = intakeThresholds, - aggregationGroup = c("admin0Name", "admin1Name") -) -``` - -### Baseline Inadequacy Based on Based on nutrient density - -```{r calculateBaselineInadequacy(NutrientDensity),eval=FALSE,warning=FALSE,message=FALSE} -# Calculate baseline inadequacy for a micronutrient -calculateBaselineInadequacyCND( - MNList = c("A"), - householdConsumptionDf = householdConsumption, - householdDetailsDf = householdDetails, - nctListDf = nctList, - intakeThresholdsDf = intakeThresholds, - aggregationGroup = c("admin0Name", "admin1Name") -) -``` - -## Food Vehicle Household Reach Example -This is how to calculate the household reach for a food vehicle. The function `calculateFoodVehicleHouseholdReach` calculates the household reach for a food vehicle. - -### Calculate Household Reach for a Food Vehicle -```{r FoodVehicleHouseholdReach, eval=FALSE,warning=FALSE,message=FALSE} -# Calculate household reach for each food vehicle -calculateFoodVehicleHouseholdReach( - householdConsumptionDf = householdConsumption, - householdDetailsDf = householdDetails, - fortifiableFoodItemsDf = fortifiable_food_items, - foodVehicleName = "wheat flour", - aggregationGroup = c("admin0Name", "admin1Name") -) + calculate_pre_and_post_lsff_summaries_afe( + householdConsumptionDf = householdConsumption, + householdDetailsDf = householdDetails, + nctListDf = nctList, + intakeThresholdsDf = intakeThresholds, + aggregationGroup = c("admin0Name", "admin1Name"), + fortifiableFoodItemsDf = createFortifiableFoodItemsTable(), + foodVehicleName = "wheat flour", + years = c(2021:2024), + MNList = c("A") + ) ``` - diff --git a/README.md b/README.md index 97f993e..e66b43a 100644 --- a/README.md +++ b/README.md @@ -27,72 +27,28 @@ from [GitHub](https://github.com/dzvoti/effectivenessCalculations) with: devtools::install_github("dzvoti/effectivenessCalculations") ``` -## Baseline Inadequacy Statistics Example +## Basic Examples -This is a basic example which shows you how to calculate the baseline -inadequacy for a micronutrient. The function -`calculateBaselineInadequacyAfe` calculates the baseline inadequacy for -a micronutrient.The function `calculateBaselineInadequacyCND` calculates -the baseline inadequacy based on nutrient density. - - +### Calculate pre and post fortification intake supplies, fortification vehicle reach and Inadequacy Summaries -### Baseline Inadequacy Based on apparent intake per Adult Female Equivalent(AFE) +This is how to calculate the pre and post fortification intake supplies, +fortification vehicle reach and Inadequacy Summaries. The function +`calculate_pre_and_post_lsff_summaries_afe` calculates the pre and post +fortification intake supplies, fortification vehicle reach and +Inadequacy Summaries. ``` r library(effectivenessCalculations) -# Calculate baseline inadequacy for a micronutrient -calculateBaselineInadequacyAfe( - MNList = c("A"), - householdConsumptionDf = householdConsumption, - householdDetailsDf = householdDetails, - nctListDf = nctList, - intakeThresholdsDf = intakeThresholds, - aggregationGroup = c("admin0Name", "admin1Name") -) -``` - -### Baseline Inadequacy Based on Based on nutrient density - -``` r -# Calculate baseline inadequacy for a micronutrient -calculateBaselineInadequacyCND( - MNList = c("A"), - householdConsumptionDf = householdConsumption, - householdDetailsDf = householdDetails, - nctListDf = nctList, - intakeThresholdsDf = intakeThresholds, - aggregationGroup = c("admin0Name", "admin1Name") -) -``` -## Food Vehicle Household Reach Example - -This is how to calculate the household reach for a food vehicle. The -function `calculateFoodVehicleHouseholdReach` calculates the household -reach for a food vehicle. - - -### Calculate Household Reach for a Food Vehicle - -``` r -# Calculate household reach for each food vehicle -calculateFoodVehicleHouseholdReach( - householdConsumptionDf = householdConsumption, - householdDetailsDf = householdDetails, - fortifiableFoodItemsDf = fortifiable_food_items, - foodVehicleName = "wheat flour", - aggregationGroup = c("admin0Name", "admin1Name") -) + calculate_pre_and_post_lsff_summaries_afe( + householdConsumptionDf = householdConsumption, + householdDetailsDf = householdDetails, + nctListDf = nctList, + intakeThresholdsDf = intakeThresholds, + aggregationGroup = c("admin0Name", "admin1Name"), + fortifiableFoodItemsDf = createFortifiableFoodItemsTable(), + foodVehicleName = "wheat flour", + years = c(2021:2024), + MNList = c("A") + ) ``` From d19872c883e17fc85a432085deb7197f46368907 Mon Sep 17 00:00:00 2001 From: dzvoti Date: Fri, 7 Jun 2024 13:15:07 +0100 Subject: [PATCH 09/12] fix: fixed bug making example not work in the `yearAverageFortificationLevel` function --- R/loadAverageFortificationLevels.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/loadAverageFortificationLevels.R b/R/loadAverageFortificationLevels.R index 63de47c..fbc9b30 100644 --- a/R/loadAverageFortificationLevels.R +++ b/R/loadAverageFortificationLevels.R @@ -9,10 +9,10 @@ #' @param fortificationLevels A dataframe containing the average fortification levels. #' @return A numeric value representing the average fortification level for the specified year and micronutrient. #' @examples -#' @keywords internal #' \dontrun{ -#' avgFortificationLevel <- yearAverageFortificationLevel("salt", 2024, "iodine") +#' avgFortificationLevel <- yearAverageFortificationLevel("wheat flour", 2024, "A") #' } +#' @keywords internal yearAverageFortificationLevel <- function(fortification_vehicle, Year, MN, fortificationLevels = readr::read_csv(here::here("data/average_fortification_levels.csv"))) { yearAverageFortificationLevel <- fortificationLevels[fortificationLevels$Year == Year, MN][[1]] From 790db383e82463b21a98da6a9f4a2fa2c426e388 Mon Sep 17 00:00:00 2001 From: dzvoti Date: Fri, 7 Jun 2024 13:15:26 +0100 Subject: [PATCH 10/12] chore: auto `NAMESPACE` generation --- NAMESPACE | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 7588de7..abf3b8a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,12 +6,19 @@ export(calculateBaselinePrevalenceHighIntakeRiskAfe) export(calculateConsPerAfe) export(calculateFoodVehicleHouseholdReach) export(calculateMNsContent) +export(calculate_pre_and_post_lsff_summaries_afe) export(checkData) +export(createFortifiableFoodItemsTable) export(createMasterNct) export(enforceNumeric) export(getMnThresholds) export(loadCsvFiles) export(load_rda_files) export(previewData) +importFrom(dplyr,case_when) +importFrom(dplyr,left_join) +importFrom(dplyr,mutate) +importFrom(dplyr,select) +importFrom(readxl,read_excel) importFrom(stats,median) importFrom(utils,head) From 4f2739f6f2429c74d04aa65639f316e114b8241e Mon Sep 17 00:00:00 2001 From: dzvoti Date: Fri, 7 Jun 2024 13:16:07 +0100 Subject: [PATCH 11/12] chore: update `.gitignore` to ignore `R/calculateMnFoodVehicleHhReach.R` unused file --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index b189c0b..17f8eee 100644 --- a/.gitignore +++ b/.gitignore @@ -52,3 +52,4 @@ rsconnect/ data/ excludeR/ .Rproj.user +R/calculateMnFoodVehicleHhReach.R From 22da1ee078b2cbec8ec228024c19b284e7ae4659 Mon Sep 17 00:00:00 2001 From: dzvoti Date: Fri, 7 Jun 2024 13:16:23 +0100 Subject: [PATCH 12/12] Increment version number to 1.0.0 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index ee088fe..27b0bcc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: effectivenessCalculations Title: Micronutrient Action Policy Support Tool Effectiveness Calculations -Version: 0.2.0 +Version: 1.0.0 Authors@R: person("Liberty", "Mlambo", , "liberty.mlambo@nottingham.ac.uk", role = c("aut", "cre","cph"), comment = c(ORCID = "0000-0003-3740-1345"))