diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index e53251f3..8d2a48e9 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -33,7 +33,7 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - if: runner.os == 'macos' run: | @@ -41,7 +41,9 @@ jobs: brew services start mongodb-community@5.0 - if: runner.os == 'linux' - run: sudo systemctl restart mongod + run: | + sudo systemctl restart mongod + sudo apt-get install libcurl4-openssl-dev libssl-dev libsasl2-dev libharfbuzz-dev libfribidi-dev -y - uses: r-lib/actions/setup-r@v2 with: diff --git a/.github/workflows/deploy_docs.yaml b/.github/workflows/deploy_docs.yaml index 8ce03c82..d8488504 100644 --- a/.github/workflows/deploy_docs.yaml +++ b/.github/workflows/deploy_docs.yaml @@ -31,6 +31,11 @@ jobs: - uses: r-lib/actions/setup-r@v2 - uses: r-lib/actions/setup-pandoc@v1 + - if: runner.os == 'linux' + run: | + sudo apt-get install libcurl4-openssl-dev libssl-dev libsasl2-dev libharfbuzz-dev libfribidi-dev -y + + - name: Query dependencies run: | diff --git a/NAMESPACE b/NAMESPACE index 1ae12460..869b1075 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -167,6 +167,7 @@ export(modify_loop_column_names) export(modify_loop_name) export(new_indicator) export(ntfp_calories_and_values) +export(ntfp_preprocessing) export(ntfp_sold_and_consumed_calculation) export(ntfp_total_individual) export(ntfp_totals) diff --git a/R/CurrencyConversion.R b/R/CurrencyConversion.R index b4acc211..efdc168b 100644 --- a/R/CurrencyConversion.R +++ b/R/CurrencyConversion.R @@ -184,7 +184,9 @@ convert_all_currencies <- function(data, country_column = "country", year_column # "year"=c("2016","2016","2021", "2014", "2016", NA, "2020") # ))) subset_data <- data %>% dplyr::select(c(country_column, year_column)) - combinations <- tibble::as_tibble(table(subset_data)) %>% + + + combinations <- tibble::as_tibble(table(subset_data,useNA="always")) %>% dplyr::filter(n > 0) %>% dplyr::select(-c("n")) @@ -193,8 +195,8 @@ convert_all_currencies <- function(data, country_column = "country", year_column for (i in 1:nrow(combinations)) { conversion_data <- currency_conversion_factor(year=combinations[i, year_column], country_code=combinations[i, country_column]) - conversion_factors <- c(conversion_factors, conversion_data["conversion_factor"]) - conversion_years <- c(conversion_years, conversion_data["conversion_year"]) + conversion_factors <- c(conversion_factors, conversion_data[["conversion_factor"]]) + conversion_years <- c(conversion_years, conversion_data[["conversion_year"]]) } combinations$conversion_factor <- unlist(conversion_factors) @@ -206,7 +208,9 @@ convert_all_currencies <- function(data, country_column = "country", year_column data[[year_column]] <- as.numeric(data[[year_column]]) combinations$year <- as.numeric(combinations$year) - data_with_conversions <- dplyr::left_join(data, combinations, by = matching_list) + combinations <- combinations[!duplicated(combinations),] + + data_with_conversions <- dplyr::left_join(data, combinations, by = matching_list,) data <- add_column_after_specific_column( data = data, diff --git a/R/NTFP.R b/R/NTFP.R index 0f40ad27..61c4bd5e 100644 --- a/R/NTFP.R +++ b/R/NTFP.R @@ -1,4 +1,101 @@ +#' NTFP Preprocessing +#' +#' For forest product surveys, honey +#' does not fit into the conventional NTFP loops. +#' This means we cannot make use of existing NTFP calculations. +#' +#' This script adds an "extra loop" to a NTFP dataset, one +#' that allows for the calculation of honey based-indicators. +#' +#' @param tree_aid_df A dataset containing (or not) questions from NTFP modules +#' +#' @return +#' @export +#' +#' @examples +ntfp_preprocessing <-function(tree_aid_df + ){ + + + missing_columns <- suppressWarnings(check_columns_in_data(tree_aid_df, + loop_columns = "fp_name", + individual_columns = "id_rhomis_dataset", + warning="Won't conduct NTFP preprocessing, NTFP module not present")) + + if(length(missing_columns)>0){ + + return(tree_aid_df) + + } + + fp_column_numbers <- find_number_of_loops(tree_aid_df, "fp_name") + extra_loop <- fp_column_numbers + 1 + + non_honey_columns <- fp_products[names(fp_products)!="honey"] + + non_honey_columns <- lapply(non_honey_columns, function(x){ + x <- x[names(x) %in% "base_name"==F] + }) + non_honey_columns <- as.character(unlist(non_honey_columns)) + non_honey_columns <- unique(non_honey_columns) + + missing_ntfp_cols <- suppressWarnings(check_columns_in_data(tree_aid_df,loop_columns = non_honey_columns)) + non_honey_columns <- non_honey_columns[non_honey_columns %in% missing_ntfp_cols==F] + + new_non_honey_columns <- paste0(non_honey_columns,"_",extra_loop) + + + dummy_honey_columns <- fp_products[names(fp_products)=="honey"] + dummy_honey_columns <- as.character(unlist(dummy_honey_columns)) + dummy_honey_columns <- dummy_honey_columns[!is.na(dummy_honey_columns)] + new_dummy_honey_columns <- lapply(c(1:fp_column_numbers),function(i){ + paste0(dummy_honey_columns,"_",i) + }) %>% unlist() + new_dummy_honey_columns <- new_dummy_honey_columns[new_dummy_honey_columns %in% new_non_honey_columns==F] + + new_columns <- c(new_dummy_honey_columns,new_non_honey_columns) + new_dummy_columns <- new_columns[duplicated(new_columns)==F] + + new_dummy_columns <- sapply(new_dummy_columns,function(x){ + rep(NA,nrow(tree_aid_df)) + },simplify=F) %>% dplyr::bind_cols() + + new_dummy_columns <- new_dummy_columns[colnames(new_dummy_columns) %in% colnames(tree_aid_df)==F] + + tree_aid_df <- dplyr::bind_cols(tree_aid_df,new_dummy_columns) + + + + real_honey_columns <- fp_products[names(fp_products)=="honey"] + real_honey_columns <- as.character(unlist(real_honey_columns)) + real_honey_columns <- real_honey_columns[!is.na(real_honey_columns)] + + real_honey_columns <- sapply(real_honey_columns,function(x){ + if (x %in% colnames(tree_aid_df)){ + return(tree_aid_df[[x]]) + }else{ + return(rep(NA,nrow(tree_aid_df))) + } + + },simplify=F) %>% dplyr::bind_cols() + + extra_fp_col <- paste0("fp_name_",extra_loop) + tree_aid_df[[extra_fp_col]][!is.na(real_honey_columns$honey_amount)] <- "bees" + + colnames(real_honey_columns) <- paste0(colnames(real_honey_columns),"_",extra_loop) + + real_honey_columns <- real_honey_columns[colnames(real_honey_columns) %in% colnames(tree_aid_df)==F] + + + tree_aid_df <- dplyr::bind_cols(tree_aid_df,real_honey_columns) + + + + return(tree_aid_df) + +} + #' Convert NTFP Units #' @@ -141,6 +238,9 @@ fp_proportions_all <- function( prop_column, new_column_name ){ + if (is.null(use_column) | is.null(prop_column)){ + return(tree_aid_df) + } #Checking whether the columns are in the dataset missing_columns <- check_columns_in_data(tree_aid_df, loop_columns = c(use_column, prop_column), diff --git a/R/RunAll.R b/R/RunAll.R index aee2e763..364de21f 100644 --- a/R/RunAll.R +++ b/R/RunAll.R @@ -211,6 +211,10 @@ load_rhomis_csv <- function(file_path, overwrite = overwrite ) + # Checks whether NTFP columns exist, and does some preprocessing to + # Reformat data + rhomis_data <- ntfp_preprocessing(rhomis_data) + return(rhomis_data) } diff --git a/R/UnitsAndConversions.R b/R/UnitsAndConversions.R index 94cf5fc7..fd7bf275 100644 --- a/R/UnitsAndConversions.R +++ b/R/UnitsAndConversions.R @@ -317,14 +317,14 @@ load_all_db_units <- function(unit_list, database = "rhomis", projectID = "core_ if (unit_name %in% c("crop_name_to_std", "livestock_name_to_std")) { # evaluate the string denoting the variable name to be used - var <- eval(parse(text = unit_name)) + var <- eval(parse(text = paste0("rhomis::",unit_name))) # make dummy tibble conversions <- tibble::as_tibble(list("survey_value" = var, "conversion" = var)) } else { conversions <- make_per_project_conversion_tibble( proj_id_vector = id_rhomis_dataset, - unit_conv_tibble = eval(parse(text = unit_name)) + unit_conv_tibble = eval(parse(text = paste0("rhomis::",unit_name))) ) conversions$unit_type <- unit_name @@ -437,8 +437,8 @@ check_existing_conversions <- function(list_of_df) { new_list <- sapply(names(list_of_df), function(x) { if (x %in% c("crop_name_to_std", "livestock_name_to_std")) { conversion <- tibble::as_tibble(list( - "survey_value" = eval(parse(text = x)), - "conversion" = eval(parse(text = x)) + "survey_value" = eval(parse(text = paste0("rhomis::",x))), + "conversion" = eval(parse(text = paste0("rhomis::",x))) )) df_with_existing_conversions <- dplyr::left_join(list_of_df[[x]], @@ -449,7 +449,7 @@ check_existing_conversions <- function(list_of_df) { dplyr::rename("conversion" = "conversion.y") } else { df_with_existing_conversions <- dplyr::left_join(list_of_df[[x]], - eval(parse(text = x)), + eval(parse(text = paste0("rhomis::",x))), by = ("survey_value" = "survey_value") ) %>% dplyr::select("unit_type", "id_rhomis_dataset", "survey_value", "conversion.y") %>% @@ -482,7 +482,7 @@ check_existing_calorie_conversions <- function(data) { new_list <- sapply(names(list_of_dfs), function(x) { df_with_existing_conversions <- dplyr::left_join(list_of_dfs[[x]], - eval(parse(text = x)), + eval(parse(text = paste0("rhomis::",x))), by = ("survey_value" <- "survey_value") ) %>% dplyr::select("unit_type", "id_rhomis_dataset", "survey_value", "conversion.y") %>% @@ -580,7 +580,7 @@ load_local_units <- function(units_folder, id_rhomis_dataset, unit_type="primary # if (unit_type=="primary"){ # unit_list <- as.character(pkg.env$unit_file_names) # } - # + # # if (unit_type=="secondary"){ # unit_list <- names(pkg.env$secondary_units) # } @@ -604,7 +604,7 @@ load_local_units <- function(units_folder, id_rhomis_dataset, unit_type="primary if (unit_file %in% c("crop_name_to_std", "livestock_name_to_std")) { # evaluate the string denoting the variable name to be used - var <- eval(parse(text = unit_file)) + var <- eval(parse(text = paste0("rhomis::",unit_file))) # make dummy tibble conversions <- tibble::as_tibble(list("survey_value" = var, "conversion" = var)) @@ -613,7 +613,7 @@ load_local_units <- function(units_folder, id_rhomis_dataset, unit_type="primary unit_conv_tibble = conversions ) } else { - var <- eval(parse( text = unit_file)) + var <- eval(parse( text = paste0("rhomis::",unit_file))) # make dummy tibble conversions <- make_per_project_conversion_tibble( @@ -682,7 +682,7 @@ load_calorie_conversions <- function(base_folder, id_rhomis_dataset) { # create conversion tibble calorie_conversion <- make_per_project_conversion_tibble( proj_id_vector = id_rhomis_dataset, - unit_conv_tibble = eval(parse(text = paste0(produce, "_calories"))) + unit_conv_tibble = eval(parse(text = paste0("rhomis::",produce, "_calories"))) ) } diff --git a/R/ValueCalculations.R b/R/ValueCalculations.R index 70d58366..3e4765ad 100644 --- a/R/ValueCalculations.R +++ b/R/ValueCalculations.R @@ -115,8 +115,8 @@ value_calculations <- function(processed_data, ) if ("mean_crop_price_lcu_per_kg" %in% names(prices) & length(missing_columns) == 0) { - if (!is.null(prices[["mean_crop_price_lcu_per_kg"]]) & nrow(prices[["mean_crop_price_lcu_per_kg"]])>0){ - + if (!is.null(prices[["mean_crop_price_lcu_per_kg"]]) ){ + if(nrow(prices[["mean_crop_price_lcu_per_kg"]])>0){ # processed_data <- remove_existing_loop_if_exists(processed_data, "value_crop_consumed_lcu") processed_data <- value_or_calorie_calculations_item_consumed( @@ -131,6 +131,7 @@ value_calculations <- function(processed_data, data = processed_data, name_column = "crop_name", column_prefixes = "value_crop_consumed_lcu", types = "num" )[[1]] + } } diff --git a/R/config_package_vars.R b/R/config_package_vars.R index e644f779..1fd1059b 100644 --- a/R/config_package_vars.R +++ b/R/config_package_vars.R @@ -73,7 +73,9 @@ set_conversion_file_names <- function(){ "leaves_sold_frequency", "bark_sold_frequency", "roots_sold_frequency", - "gum_sold_frequency" + "gum_sold_frequency", + "shea_butter_sold_frequency", + "shea_butter_sold_amount_units_other" ) @@ -132,8 +134,8 @@ set_conversion_file_names <- function(){ eggs_sold_price_timeunits = c("eggs_sold_price_timeunits_other"), fertiliser_units = c("fertiliser_units_other"), - fp_amount_units = c("fruit_amount_units","nut_amount_units","leaves_amount_units","bark_amount_units","roots_amount_units", "gum_amount_units"), - fp_income_units = c("fruit_sold_frequency","nut_sold_frequency","leaves_sold_frequency","bark_sold_frequency","roots_sold_frequency", "gum_sold_frequency") + fp_amount_units = c("fruit_amount_units","nut_amount_units","leaves_amount_units","bark_amount_units","roots_amount_units", "gum_amount_units", "shea_butter_sold_frequency"), + fp_income_units = c("fruit_sold_frequency","nut_sold_frequency","leaves_sold_frequency","bark_sold_frequency","roots_sold_frequency", "gum_sold_frequency","shea_butter_sold_amount_units_other") ) diff --git a/data-raw/ntfp-types.R b/data-raw/ntfp-types.R index b721d033..9a520c18 100644 --- a/data-raw/ntfp-types.R +++ b/data-raw/ntfp-types.R @@ -1,6 +1,38 @@ fp_products <- list( + honey=list( + fp_name = "fp_name", + base_name="honey", + + #Info needed for shea_butter calculations + amount = "honey_amount", + amount_units = "honey_amount_units", + amount_units_other = "honey_amount_units_other", + + # Info needed for proportions calculations + use_column = "honey_use", + sold_prop_column = "honey_sold_prop", + consumed_column = "honey_consumed_prop", + processed_column = NULL, + + income_column = "honey_sold_income", + income_frequency = "honey_sold_price_quantityunits", + sold_frequency_other_column = "honey_sale_freq_units_other", + + consume_gender=NULL, + sell_gender="honey_who_sell", + sell_income_gender="honey_sold_income_who", + + processed_sold_column = NULL, + processed_eaten_column = NULL, + + process_sold_income_column = NULL, + process_sold_frequency_column = NULL, + process_sold_frequency_other_column = NULL + ), + + fruit=list( base_name="fruit", fp_name = "fp_name", @@ -219,6 +251,8 @@ fp_products <- list( ) + + ) usethis::use_data(fp_products, overwrite = T) diff --git a/data/fp_products.rda b/data/fp_products.rda index 720ae1a7..046726ed 100644 Binary files a/data/fp_products.rda and b/data/fp_products.rda differ diff --git a/man/fp_products.Rd b/man/fp_products.Rd index 4c360b79..714aeb84 100644 --- a/man/fp_products.Rd +++ b/man/fp_products.Rd @@ -5,7 +5,7 @@ \alias{fp_products} \title{FP Products} \format{ -An object of class \code{list} of length 7. +An object of class \code{list} of length 8. } \source{ NA diff --git a/man/ntfp_preprocessing.Rd b/man/ntfp_preprocessing.Rd new file mode 100644 index 00000000..bcff4abb --- /dev/null +++ b/man/ntfp_preprocessing.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/NTFP.R +\name{ntfp_preprocessing} +\alias{ntfp_preprocessing} +\title{NTFP Preprocessing} +\usage{ +ntfp_preprocessing(tree_aid_df) +} +\arguments{ +\item{tree_aid_df}{A dataset containing (or not) questions from NTFP modules} +} +\description{ +For forest product surveys, honey +does not fit into the conventional NTFP loops. +This means we cannot make use of existing NTFP calculations. +} +\details{ +This script adds an "extra loop" to a NTFP dataset, one +that allows for the calculation of honey based-indicators. +} diff --git a/renv.lock b/renv.lock index e7db85da..58c8bae8 100644 --- a/renv.lock +++ b/renv.lock @@ -270,10 +270,10 @@ }, "gert": { "Package": "gert", - "Version": "1.6.0", + "Version": "1.9.2", "Source": "Repository", "Repository": "CRAN", - "Hash": "98c014c4c933f23ea5a0321a4d0b588b" + "Hash": "9122b3958e749badb5c939f498038b57" }, "getopt": { "Package": "getopt", @@ -536,10 +536,10 @@ }, "purrr": { "Package": "purrr", - "Version": "0.3.4", + "Version": "1.0.1", "Source": "Repository", "Repository": "CRAN", - "Hash": "97def703420c8ab10d8f0e6c72101e02" + "Hash": "d71c815267c640f17ddbf7f16144b4bb" }, "rappdirs": { "Package": "rappdirs",