review comparison chart

unhcr-americas · Mar 27, 2024 · f80018e · f80018e
1 parent 422a276
commit f80018e
Show file tree

Hide file tree

Showing 153 changed files with 1,909 additions and 3,404 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -25,6 +25,7 @@ Imports:
     grid,
     here,
     knitr,
+    lubridate,
     magrittr,
     patchwork,
     purrr,

diff --git a/NAMESPACE b/NAMESPACE
@@ -17,6 +17,7 @@ export(show_sectors)
 export(show_sectors_rbm)
 export(show_top_donors)
 export(show_transaction_flow)
+export(template_compare)
 export(template_prez)
 import(cowplot)
 import(dplyr)

diff --git a/R/compare_resource_result.R b/R/compare_resource_result.R
diff --git a/R/globals.R b/R/globals.R
@@ -44,5 +44,14 @@ globalVariables(unique(c(
   # show_expenditure: 
   "commitment", "expenditure", 
   # show_outcome_result: 
-  "transaction_value2"
-))) 
+  "transaction_value2",# compare_resource_result: 
+  "indlevel", "iso3c", "result_indicator_actual_dimension_1", "result_indicator_actual_dimension_2", "result_indicator_actual_location_ref", "result_indicator_actual_value_1", "result_indicator_actual_value_2", "sector_code", "unhcr_region", "xmax", "xmin", "ymax", "ymin", 
+  # show_indicators: 
+  "result_indicator_actual_dimension_1", "result_indicator_actual_dimension_2", "result_indicator_actual_location_ref", "result_indicator_actual_value_1", "result_indicator_actual_value_2", 
+  # show_indicators_time: 
+  "result_indicator_actual_dimension_1", "result_indicator_actual_dimension_2", "result_indicator_actual_location_ref", "result_indicator_actual_value_1", "result_indicator_actual_value_2", 
+  # show_outcome_result: 
+  "result_indicator_actual_dimension_1", "result_indicator_actual_dimension_2", "result_indicator_actual_location_ref", "result_indicator_actual_value_1", "result_indicator_actual_value_2", 
+  # show_transaction_flow: 
+  "Earmarking", "Provider", "Type", "value", "Year"
+)))
diff --git a/R/show_expenditure.R b/R/show_expenditure.R
@@ -57,7 +57,9 @@ show_expenditure <- function(year,
          dplyr::left_join(iati::dataActivity, by= c("iati_identifier"))  
 
   dfB <- iati::dataBudget |> 
-         dplyr::left_join(iati::dataActivity, by= c("iati_identifier"))  
+         dplyr::left_join(iati::dataActivity, by= c("iati_identifier")) |>
+         dplyr::rename("year_iati" = "year")|>
+         dplyr::mutate(year = lubridate::year(lubridate::as_date(budget_period_start)))
 
   if (!is.null(programme_lab)) {
     thisprogramme_lab <- programme_lab
@@ -129,7 +131,7 @@ show_expenditure <- function(year,
    df2 <-  df1   |>  
         dplyr::left_join(df |> dplyr::select(- year), by = c("iati_identifier")) |>
         dplyr::left_join( dfB , by= c("iati_identifier"))  |>
-     dplyr::select(iati_identifier, year,  budget_value,   expenditure, commitment ) 
+        dplyr::select(iati_identifier, year,  budget_value,   expenditure, commitment ) 
 
     # Error catching -- Check if we weight
     #weight_by <-  c("refugees", "oip") 

diff --git a/R/show_indicators.R b/R/show_indicators.R
@@ -198,21 +198,21 @@ show_indicators <- function(year,
                         progress_baseline < -15     ~ "red",
                                                    TRUE ~ ""),
 
-                      gap_green =  round( ( threshold_green - actual ) / 
+                      gap_green =  round( (  actual - threshold_green ) / 
                                            dplyr::if_else(threshold_green == 0, 1, threshold_green) * 
                                            dplyr::if_else(threshold_green == 0, 1, 100)  ,2 ),
                       gap_green = dplyr::if_else(result_indicator_ascending == 0, 
                                                          gap_green * -1, 
                                                          gap_green), 
 
-                      gap_orange =  round( ( threshold_orange - actual ) / 
+                      gap_orange =  round( ( actual - threshold_orange  ) / 
                                            dplyr::if_else(threshold_orange == 0, 1, threshold_orange) * 
                                            dplyr::if_else(threshold_orange == 0, 1, 100)  ,2 ), 
                       gap_orange = dplyr::if_else(result_indicator_ascending == 0, 
                                                          gap_orange * -1, 
                                                          gap_orange), 
 
-                      gap_red =  round( ( threshold_red - actual ) / 
+                      gap_red =  round( ( actual  -  threshold_red ) / 
                                            dplyr::if_else(threshold_red == 0, 1, threshold_red) * 
                                            dplyr::if_else(threshold_red == 0, 1, 100)  ,2 ),
                       gap_red = dplyr::if_else(result_indicator_ascending == 0, 

diff --git a/R/show_indicators_time.R b/R/show_indicators_time.R
@@ -203,21 +203,21 @@ show_indicators_time <- function(year,
                         progress_baseline < -15     ~ "red",  
                                                    TRUE ~ ""),
 
-                      gap_green =  round( ( threshold_green - actual ) / 
+                      gap_green =  round( (  actual - threshold_green ) / 
                                            dplyr::if_else(threshold_green == 0, 1, threshold_green) * 
                                            dplyr::if_else(threshold_green == 0, 1, 100)  ,2 ),
                       gap_green = dplyr::if_else(result_indicator_ascending == 0, 
                                                          gap_green * -1, 
                                                          gap_green), 
 
-                      gap_orange =  round( ( threshold_orange - actual ) / 
+                      gap_orange =  round( ( actual - threshold_orange  ) / 
                                            dplyr::if_else(threshold_orange == 0, 1, threshold_orange) * 
                                            dplyr::if_else(threshold_orange == 0, 1, 100)  ,2 ), 
                       gap_orange = dplyr::if_else(result_indicator_ascending == 0, 
                                                          gap_orange * -1, 
                                                          gap_orange), 
 
-                      gap_red =  round( ( threshold_red - actual ) / 
+                      gap_red =  round( ( actual  -  threshold_red ) / 
                                            dplyr::if_else(threshold_red == 0, 1, threshold_red) * 
                                            dplyr::if_else(threshold_red == 0, 1, 100)  ,2 ),
                       gap_red = dplyr::if_else(result_indicator_ascending == 0, 

diff --git a/R/show_outcome_result.R b/R/show_outcome_result.R
@@ -180,21 +180,21 @@ show_outcome_result <- function(year,
                         progress_baseline < -15     ~ "red",  
                                                    TRUE ~ ""),
 
-                      gap_green =  round( ( threshold_green - actual ) / 
+                      gap_green =  round( (  actual - threshold_green ) / 
                                            dplyr::if_else(threshold_green == 0, 1, threshold_green) * 
                                            dplyr::if_else(threshold_green == 0, 1, 100)  ,2 ),
                       gap_green = dplyr::if_else(result_indicator_ascending == 0, 
                                                          gap_green * -1, 
                                                          gap_green), 
 
-                      gap_orange =  round( ( threshold_orange - actual ) / 
+                      gap_orange =  round( ( actual - threshold_orange  ) / 
                                            dplyr::if_else(threshold_orange == 0, 1, threshold_orange) * 
                                            dplyr::if_else(threshold_orange == 0, 1, 100)  ,2 ), 
                       gap_orange = dplyr::if_else(result_indicator_ascending == 0, 
                                                          gap_orange * -1, 
                                                          gap_orange), 
 
-                      gap_red =  round( ( threshold_red - actual ) / 
+                      gap_red =  round( ( actual  -  threshold_red ) / 
                                            dplyr::if_else(threshold_red == 0, 1, threshold_red) * 
                                            dplyr::if_else(threshold_red == 0, 1, 100)  ,2 ),
                       gap_red = dplyr::if_else(result_indicator_ascending == 0, 

diff --git a/R/template_compare.R b/R/template_compare.R
@@ -0,0 +1,44 @@
+# WARNING - Generated by {fusen} from dev/dev_unhcr_programme.Rmd: do not edit by hand
+
+
+# usethis::use_rmarkdown_template(
+#   template_name = "iati_compare",
+#   template_dir = NULL,
+#   template_description = "Compare",
+#   template_create_dir = TRUE
+# )
+
+
+#' Generate a summary powerpoint
+#' 
+#' @param year A numeric value or a vector of numeric value to filter on year. Note that data pre-2022 are using a different set of indicators
+#' @param ctr_name A character vector corresponding to the name of the country.
+#' @param folder folder within your project where to put the generated report. 
+#'              Folder will be created if it does not exist
+#' 
+#' @importFrom unhcrdown pptx_slides
+#' @importFrom dplyr filter select pull
+#' @importFrom rmarkdown render
+#' @importFrom here here
+#' @importFrom countrycode countrycode
+#' @importFrom stringr str_replace_all
+#' 
+#' @return nothing the file for the report is generated
+#' 
+#' @export 
+#'
+#' @examples
+#' # iati::template_compare(year = 2022, folder = "dev/Result")
+template_compare <- function(year = 2022,
+                          folder = "Compare") {
+
+  ## Create the outfolder if it does not exist
+  output_dir <- paste0(getwd(),"/",folder)
+  if (!dir.exists(output_dir)) {dir.create(output_dir)}
+
+  rmarkdown::render(
+    system.file("rmarkdown/templates/iati_compare/skeleton/skeleton.Rmd", package = "iati"),
+    output_file = here::here(folder, paste0('Result_Resource',
+                                            '-', year, '.pptx') ),
+    params = list(year = year)  )
+}
diff --git a/R/template_prez.R b/R/template_prez.R
@@ -35,19 +35,31 @@
 #' #                     folder = "dev/Prez")
 #'
 #' # ## Generate for all operation specific region
-#' # region <- "The Americas"
+#' # reg <- iati::dataActivity |>
+#' #   dplyr::select( unhcr_region) |>
+#' #   dplyr::filter(! is.na(unhcr_region)) |>
+#' #   dplyr::distinct() |>
+#' #   dplyr::pull() 
 #' # 
-#' # countries <- iati::dataActivity |> 
-#' #        dplyr::filter( unhcr_region ==  region) |>
-#' #        dplyr::select(ctr_name) |>
-#' #        dplyr::distinct() |>
-#' #        dplyr::pull()
+#' # thisfolder <- "dev/SMR" 
 #' # 
-#' # for ( ctr in countries) {
-#' #     cat(paste0(ctr, "\n"))
-#' #     iati::template_prez(year = 2022, 
-#' #                     ctr_name = ctr,
-#' #                     folder = "dev/Prez")  }
+#' # for (region in reg) { 
+#' #       cat(paste0( region,   "\n"))
+#' #
+#' #       # region <- "The Americas"   
+#' #       countries <- iati::dataActivity |>
+#' #         dplyr::filter( unhcr_region ==  region) |>
+#' #         dplyr::select(ctr_name) |>
+#' #         dplyr::distinct() |>
+#' #         dplyr::pull() 
+#' #       
+#' #       for ( ctr in countries) {
+#' #         cat(paste0("Generating for ", ctr, "\n"))
+#' #         iati::template_prez(year = 2022,
+#' #                             ctr_name = ctr,
+#' #                             folder =  thisfolder)  
+#' #         }
+#' #     }
 template_prez <- function(year = 2022,
                           ctr_name,   
                           folder = "Prez") {

diff --git a/data-raw/build.R b/data-raw/build.R
@@ -509,6 +509,47 @@ save(dataTransaction, file =  "data/dataTransaction.RData")
 #by using R CMD build --resave-data
 tools::resaveRdaFiles(here::here("data","dataTransaction.RData"),compress="xz")
 
+
+
+### Mapping ####
+# mapping_result <- readxl::read_excel("data-raw/mapping/mapping.xlsx", 
+#                                      sheet = "result_list") |>
+#   dplyr::mutate( sector_rbm = result_map2) |>
+#   dplyr::select( result_title,  sector_rbm, area_id  )
+# 
+# sinew::makeOxygen(mapping_result, add_fields = "source")
+# 
+# save(mapping_result, file =  "data/mapping_result.RData")
+# dput(names(mapping_result))
+# 
+# 
+# 
+# mapping_sector <- readxl::read_excel("data-raw/mapping/mapping.xlsx", 
+#                                      sheet = "result_sector")  |>
+#   dplyr::mutate( sector_rbm = result_map2...7,
+#                  sector_vocabulary_name = sector_vocabulary_name...2) |>
+#   dplyr::select( sector_desc,sector_vocabulary_name,  sector_rbm, area_id  )
+# 
+# sinew::makeOxygen(mapping_sector , add_fields = "source")
+# 
+# save(mapping_sector , file =  "data/mapping_sector.RData")
+# dput(names(mapping_result))
+# 
+# dput(names(mapping_sector))
+# 
+# mapping_sdg <- readxl::read_excel("data-raw/mapping/mapping.xlsx", 
+#                                   sheet = "area_sdg")  
+# sinew::makeOxygen(mapping_sdg , add_fields = "source")
+# 
+# save(mapping_sdg , file =  "data/mapping_sdg.RData")
+# 
+# 
+# mapping_indicator <- readxl::read_excel("data-raw/mapping/mapping.xlsx", 
+#                                         sheet = "mapping_indicator")
+# sinew::makeOxygen(mapping_indicator, add_fields = "source")
+# 
+# save(mapping_indicator , file =  "data/mapping_indicator.RData")
+
 ## code table need to change name... 
 
 # 

diff --git a/data/mapping_sector.RData b/data/mapping_sector.RData