Merge branch 'main' into main

.github/workflows/R-CMD-check.yaml

@@ -33,15 +33,17 @@ jobs:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
       - if: runner.os == 'macos'
         run: |
           brew install [email protected]
           brew services start [email protected]
 
       - 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:

.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: |

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)

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,

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),

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)
 }
 

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")))
             )
         }
 

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]]
+            }
         }
 
 

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")
 
     )
 

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)