diff --git a/NAMESPACE b/NAMESPACE index 8daef9f..ed63f66 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,8 +7,10 @@ export(show_donors) export(show_earmarking) export(show_expenditure) export(show_indicators) +export(show_indicators_time) export(show_partnership) export(show_sectors) +export(show_sectors_rbm) export(show_top_donors) import(dplyr) import(ggplot2) diff --git a/R/data.R b/R/data.R index 04cd6ba..d5db019 100644 --- a/R/data.R +++ b/R/data.R @@ -355,9 +355,30 @@ #'} "dataRelated_activity" +#### Mapping table ######### +#' @title mapping_result +#' @description Mapping Results to UNHCR 2022 RBM Framework +#' @format A data frame with 107 rows and 2 variables: +#' \describe{ +#' \item{\code{result_title}}{character result_title} +#' \item{\code{sector_rbm}}{character sector_rbm} +#'} +#' @source \url{https://www.unhcr.org/what-we-do/build-better-futures/compass/} +"mapping_result" +#' @title mapping_sector +#' @description Mapping Sector to UNHCR 2022 RBM Framework +#' @format A data frame with 83 rows and 3 variables: +#' \describe{ +#' \item{\code{sector_desc}}{character COLUMN_DESCRIPTION} +#' \item{\code{sector_vocabulary_name}}{character COLUMN_DESCRIPTION} +#' \item{\code{sector_rbm}}{character COLUMN_DESCRIPTION} +#'} +#' @source \url{https://www.unhcr.org/what-we-do/build-better-futures/compass} +"mapping_sector" + #### All code list doc ############ diff --git a/R/globals.R b/R/globals.R index 29275eb..5d16285 100644 --- a/R/globals.R +++ b/R/globals.R @@ -28,5 +28,7 @@ globalVariables(unique(c( # show_partnership: "Accountable", # show_top_donors: - "transaction_provider_org" + "transaction_provider_org", + # show_sectors_rbm: + "sector_rbm", "sector_vocabulary_name", "year2" ))) \ No newline at end of file diff --git a/R/show_budget_gap.R b/R/show_budget_gap.R index 9c6efe1..f7634c7 100644 --- a/R/show_budget_gap.R +++ b/R/show_budget_gap.R @@ -2,10 +2,19 @@ #' show_budget_gap #' +#' UNHCR budgets are needs-based: it represents the total amount +#' of money that would be required were UNHCR to meet all of the needs that it is seeking to address. +#' #' @param year A numeric value corresponding to the first year of focus until the most recent year within the dataset. #' @param programme_lab A character vector corresponding to the name of the programme. #' @param iati_identifier_ops A character vector corresponding to the name of the operation. #' @param ctr_name A character vector corresponding to the name of the country. +#' @param weight_by list of population group to weight the budget - +#' "refugees", "asylum_seekers", +#' "returned_refugees" "idps", +#' "returned_idps", "stateless", +#' "ooc", "oip" +#' default is null. #' #' @import ggplot2 #' @import dplyr @@ -18,10 +27,17 @@ #' @examples #' show_budget_gap(year = 2018, #' ctr_name = "Brazil") +#' +#' +#' +#' show_budget_gap(year = 2018, +#' ctr_name = "Brazil", +#' weight_by = c("refugees", "oip")) show_budget_gap <- function(year, programme_lab = NULL, iati_identifier_ops = NULL, - ctr_name = NULL ) { + ctr_name = NULL , + weight_by = NULL ) { # Check if only one argument is passed @@ -72,6 +88,55 @@ show_budget_gap <- function(year, dplyr::mutate(budget_gap = (budget_value - transaction_value) / budget_value *100) + + if ( !is.null(weight_by) && !all(weight_by %in% c("refugees", "asylum_seekers", + "returned_refugees", "idps", + "returned_idps", "stateless", + "ooc", "oip" )) ) { + stop("weight_by is used but the population filter is not correctly set up...\n + it should be among: refugees, asylum_seekers, returned_refugees, idps, + returned_idps, stateless, ooc, oip") + } + + ## Calculate weight + if (!is.null(weight_by) && !is.null(ctr_name) ) { + ctrstat <- refugees::population |> + dplyr::filter( year>= thisyear & + coa_name == thisctr_name) |> + dplyr::group_by(year, coa_name) |> + dplyr::summarise(refugees = sum(refugees, na.rm = TRUE), + asylum_seekers = sum(asylum_seekers, na.rm = TRUE), + returned_refugees = sum(returned_refugees, na.rm = TRUE), + idps = sum(idps, na.rm = TRUE), + returned_idps = sum(returned_idps , na.rm = TRUE), + stateless = sum(stateless, na.rm = TRUE), + ooc = sum( ooc, na.rm = TRUE), + oip = sum(oip, na.rm = TRUE)) |> + dplyr::select(year, coa_name, all_of(weight_by) ) |> + dplyr::mutate(year = as.factor(year) ) |> + dplyr::mutate( weight = rowSums( + dplyr::across(tidyselect::where(is.numeric)))) + + df2 <- df2 |> + dplyr::left_join(ctrstat |> + dplyr::select(year, weight) , by = c("year")) |> + dplyr::mutate(budget_value = round(budget_value / weight,1), + transaction_value = round(transaction_value / weight,1))|> + dplyr::mutate(budget_gap = (budget_value - transaction_value) / budget_value *100) + + } + + subtitt <- if( is.null(weight_by)) { + paste0("In ", programme_lab, ctr_name,iati_identifier_ops, " recorded since ", year,"") + } else { + paste0("Weighted by total number of individual ", + paste(weight_by, collapse = ', '), + " in ", + programme_lab, ctr_name,iati_identifier_ops, " as recorded since ", year,"") + } + + + p <- df2 |> # dplyr::filter(transaction_value_USD <= 1000000 & transaction_value_USD > 1000) |> @@ -90,10 +155,10 @@ show_budget_gap <- function(year, legend = FALSE)+ ggplot2::labs( title = paste0( "Budget Gap (in %)"), - subtitle = paste0("In ", programme_lab, ctr_name,iati_identifier_ops, " recorded since ", year,""), + subtitle = subtitt , x = "", y = "", - caption = "Data Source: UNHCR IATI (International Aid Transparency Initiative)" ) + caption = "Data Source: UNHCR IATI (International Aid Transparency Initiative). UNHCR budget is needs-based. It represents the total amount of money that would be required were UNHCR to meet all of the needs that it is seeking to address." ) return(p) diff --git a/R/show_earmarking.R b/R/show_earmarking.R index 5b49bf2..0c4879e 100644 --- a/R/show_earmarking.R +++ b/R/show_earmarking.R @@ -2,7 +2,20 @@ #' Title #' -#' @description What’s the breakdown of Earmarking Type (Un-earmarked, Tightly earmarked, etc.) from Donor Funds by Year? +#' @description What’s the breakdown of Earmarking Type (Un-earmarked, Tightly earmarked, etc.) \ +#' from Donor Funds by Year? +#' Where possible, UNHCR prefers to receive unearmarked funds, as this allows the agency +#' greater flexibility in allocating its resources as new needs emerge during the course of the year. +#' Should that not be possible, funds can also be softly earmarked. This could mean funds that +#' can be spent anywhere within a region or for a particular situation (for example, funds that have +#' to be spent to assist refugees from Syria, but which can be spent in any country hosting such +#' refugees). Earmarked funds would be a contribution that corresponds to a specific country but +#' can be spent on anything within that operation’s programme. Finally, tightly earmarked funds +#' are those that specify an activity or a population within a country’s programme. +#' +#' UNHCR charges an ISC - Indirect Support Costs - rate of 6.5% on all of its earmarked contributions. +#' This covers management and administration costs at HQ and programme support costs +#' incurred at HQ and Regional Bureaux. #' #' @param year A numeric value corresponding to the first year of focus until the most recent year within the dataset. #' @param programme_lab A character vector corresponding to the name of the programme. diff --git a/R/show_expenditure.R b/R/show_expenditure.R index 42258bf..92c90e9 100644 --- a/R/show_expenditure.R +++ b/R/show_expenditure.R @@ -157,7 +157,7 @@ show_expenditure <- function(year, subtitle = subtitt, x = "", y = "", - caption = "Data Source: UNHCR IATI (International Aid Transparency Initiative)" ) + caption = "Data Source: UNHCR IATI (International Aid Transparency Initiative). UNHCR budget is needs-based. It represents the total amount of money that would be required were UNHCR to meet all of the needs that it is seeking to address." ) return(p) } diff --git a/R/show_indicators_time.R b/R/show_indicators_time.R new file mode 100644 index 0000000..9d1764d --- /dev/null +++ b/R/show_indicators_time.R @@ -0,0 +1,304 @@ +# WARNING - Generated by {fusen} from dev/dev_unhcr_programme.Rmd: do not edit by hand + +#' show_indicators_time +#' +#' How much indicators evolve over time against thresholds? +#' +#' @param year A numeric value corresponding to the first year of focus until the most recent year within the dataset. +#' @param programme_lab A character vector corresponding to the name of the programme. +#' @param iati_identifier_ops A character vector corresponding to the name of the operation. +#' @param ctr_name A character vector corresponding to the name of the country. +#' @param result_type_name either "Impact" "Outcome" "Output" - default is "Outcome" +#' @param type "deviation" showing difference between target and actual - or +#' "progress" showing difference between baseline and actual +#' +#' @import ggplot2 +#' @import dplyr +#' @import scales +#' @import unhcrthemes +#' @importFrom stats reorder +#' +#' @export +#' +#' @return a graph +#' @examples +#' show_indicators_time(year = 2020, +#' ctr_name = "Brazil", +#' result_type_name = "Outcome", +#' type = "deviation" +#' ) +#' show_indicators_time(year = 2022, +#' ctr_name = "Brazil", +#' result_type_name = "Impact", +#' type = "deviation" +#' ) +#' show_indicators_time(year = 2019, +#' ctr_name = "Brazil", +#' result_type_name = "Output", +#' type = "deviation" +#' ) +#' show_indicators_time(year = 2022, +#' ctr_name = "Brazil", +#' result_type_name = "Outcome", +#' type = "progress" +#' ) +#' show_indicators_time(year = 2022, +#' ctr_name = "Brazil", +#' result_type_name = "Impact", +#' type = "progress" +#' ) +#' show_indicators_time(year = 2019, +#' ctr_name = "Brazil", +#' result_type_name = "Output", +#' type = "progress" +#' ) +show_indicators_time <- function(year, + programme_lab = NULL, + iati_identifier_ops = NULL, + ctr_name = NULL , + result_type_name = "Outcome", + type = "deviation") { + + + # Check if only one argument is passed + if (!is.null(programme_lab) && !is.null(iati_identifier_ops)) { + stop("Please pass only one of the arguments programme_lab or iati_identifier_ops.") + } else if (!is.null(programme_lab) && !is.null(ctr_name)) { + stop("Please pass only one of the arguments programme_lab or ctr_name.") + } else if (!is.null(iati_identifier_ops) && !is.null(ctr_name)) { + stop("Please pass only one of the arguments iati_identifier_ops or ctr_name.") + } + + df <- iati::dataResult |> + dplyr::left_join(iati::dataActivity, by= c("iati_identifier")) + + if (!is.null(programme_lab)) { + thisprogramme_lab <- programme_lab + thisyear <- year + thisresult_type_name <- result_type_name + df <- df |> + # levels(as.factor(df$result_type_name )) + dplyr::filter( programmme_lab == thisprogramme_lab & + year >= thisyear & + result_type_name == thisresult_type_name) |> + dplyr::left_join(iati::mapping_result, by= c("result_title")) |> + dplyr::distinct() + + } else if (!is.null(iati_identifier_ops)) { + thisiati_identifier_ops <- iati_identifier_ops + thisyear <- year + thisresult_type_name <- result_type_name + df <- df |> + dplyr::filter(iati_identifier_ops == thisiati_identifier_ops & + year >= thisyear & + result_type_name == thisresult_type_name) |> + dplyr::left_join(iati::mapping_result, by= c("result_title")) |> + dplyr::distinct() + + } else if (!is.null(ctr_name)) { + thisctr_name <- ctr_name + thisyear <- year + thisresult_type_name <- result_type_name + df <- df |> + dplyr::filter( ctr_name == thisctr_name & + year >= thisyear & + result_type_name == thisresult_type_name) |> + dplyr::left_join(iati::mapping_result, by= c("result_title")) |> + dplyr::distinct() + } + + ## in order to compare indictors alltogether in the same country, we need to normalise them + ## one way is to compute the distance to the target... + ## names(df) + + #table(df$result_indicator_ascending, useNA = "ifany") + df1 <- df |> + dplyr::select(result_type_name , result_title, sector_rbm, + indicator_measure_name, result_indicator_title, + year, + + result_indicator_baseline_value, + result_indicator_actual_value, + result_indicator_target_value, + result_indicator_target_value_1, + + result_indicator_baseline_location_ref, + result_indicator_baseline_dimension_1, + result_indicator_baseline_dimension_value_1, + result_indicator_baseline_dimension_2, + result_indicator_baseline_dimension_value_2, + result_indicator_ascending) |> + + ## Quick fix in case ascending is not documented... + dplyr::mutate( result_indicator_ascending = dplyr::if_else( is.na(result_indicator_ascending), + + "1", + result_indicator_ascending)) |> + + dplyr::mutate( actual = as.numeric(result_indicator_actual_value), + baseline = as.numeric(result_indicator_baseline_value), + target = as.numeric(result_indicator_target_value), + ## Reshape the indicator label... + operation = as.character(glue::glue("{result_indicator_title} / {result_indicator_target_value_1}") ), + # operation = as.character(glue::glue("{result_indicator_title} / {result_title} - + # {result_indicator_target_value_1}") ), + + + ## Calculating deviation to target + deviation_actual_target = round( ( actual - target ) / + dplyr::if_else(target == 0, 1, target) * + dplyr::if_else(target == 0, 1, 100) ,2 ), + + ## Account for indicator direction + deviation_actual_target = dplyr::if_else(result_indicator_ascending == 0, + deviation_actual_target * -1, + deviation_actual_target), + + deviation_color = dplyr::case_when( + deviation_actual_target >= -1 ~ "green", + deviation_actual_target < -1 & deviation_actual_target >= -15 ~ "orange", + deviation_actual_target < -15 ~ "red", + TRUE ~ ""), + ## Calculating progress to baseline.. + progress_baseline = round( ( actual - baseline) / + dplyr::if_else(baseline == 0, 1, baseline) * + dplyr::if_else(baseline == 0, 1, 100) ,2 ), + ## Account for indicator direction + progress_baseline = dplyr::if_else(result_indicator_ascending == 0, + progress_baseline * -1, + progress_baseline), + progress_color = dplyr::case_when( + progress_baseline >= -1 ~ "green", + progress_baseline < -1 & progress_baseline >= -15 ~ "orange", + progress_baseline < -15 ~ "red", + TRUE ~ "") + + ) + + ### Type of chart to build... + if(type == "deviation") { + + df1 <- df1 |> + ## Filter out - when no data... + dplyr::filter (! (is.na(actual))) |> + dplyr::filter (! (is.na(target))) |> + dplyr::filter (! (is.nan(deviation_actual_target))) |> + #dplyr::arrange(desc(actual)) + dplyr::group_by( result_indicator_title) |> + dplyr::arrange(desc( actual), .by_group=TRUE ) |> + dplyr::ungroup(result_indicator_title) + + ## case there's no data at all + if( nrow(df1) == 0) { + info <- paste0("No deviation - actual to target - \n comparative analysis \n could be produced for \n", + result_type_name, " indicator values \n in ", + programme_lab, ctr_name,iati_identifier_ops, " for year: ", year) + p <- ggplot2::ggplot() + + ggplot2::annotate("text", x = 1, y = 1, size = 12, + label = info ) + + ggplot2::theme_void() + + } else if(nrow(df1)> 0) { + ## and now the plot + p <- ggplot2::ggplot( df1, + ggplot2::aes(x = year, + y = deviation_actual_target, + #shape = indicator_measure_name, + color = sector_rbm)) + + ggplot2::geom_jitter(position=position_jitter(0.2), + shape = 17, + size = 3) + + ggplot2::stat_summary(fun.data=mean_sdl, #mult=1, + geom="pointrange", color="grey", size = 3) + + geom_hline(yintercept= 0, color="red") + + # ggplot2::scale_color_viridis_d(option = "inferno", na.value = "grey50") + + ggplot2::scale_colour_brewer(palette = "Paired") + + ggplot2::scale_y_continuous( label = scales::label_number(accuracy = 1, + scale_cut = scales::cut_short_scale(), + suffix = "%") )+ + ggplot2::scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 120)) + + unhcrthemes::theme_unhcr(font_size = 22, + axis_text_size = 9, + grid = "Y", + axis = "y") + + ggplot2::theme( legend.direction = "vertical", + legend.box = "horizontal", + legend.position = "right")+ + + ggplot2::labs( x = "", y = "" , + title = stringr::str_wrap( + paste0( result_type_name, " Indicators ", + programme_lab, ctr_name,iati_identifier_ops ) , + 100), + subtitle = stringr::str_wrap( paste0( + "Deviation between reported \"Actual\" value and programmatic \"Target\" (in %)" ) , + 110), + caption = stringr::str_wrap( + "Data Source: UNHCR IATI (International Aid Transparency Initiative)" , + 110) ) + } + } else if( type == "progress") { + + df1 <- df1 |> + ## Filter out - when no data... + dplyr::filter (! (is.na(actual))) |> + dplyr::filter (! (is.na(baseline))) |> + dplyr::filter (! (is.nan(progress_baseline))) |> + #dplyr::arrange(desc(actual)) + dplyr::group_by( result_indicator_title) |> + dplyr::arrange(desc( actual), .by_group=TRUE ) |> + dplyr::ungroup(result_indicator_title) + + ## case there's no data at all + if( nrow(df1) == 0) { + info <- paste0("No progress - actual to baseline - \n comparative analysis \n could be produced for \n", + result_type_name, " indicator values \n in ", + programme_lab, ctr_name,iati_identifier_ops, " for year: ", year) + p <- ggplot2::ggplot() + + ggplot2::annotate("text", x = 1, y = 1, size = 12, + label = info ) + + ggplot2::theme_void() + + } else if(nrow(df1)> 0) { + ## and now the plot + p <- ggplot2::ggplot( df1, + ggplot2::aes(x = year, + y = progress_baseline, + #shape = indicator_measure_name, + color = sector_rbm)) + + ggplot2::geom_jitter(position=position_jitter(0.2), + shape = 17, + size = 3) + + ggplot2::stat_summary(fun.data=mean_sdl, #mult=1, + geom="pointrange", color="grey", size = 3) + + geom_hline(yintercept= 0, color="red") + + # ggplot2::scale_color_viridis_d(option = "inferno", na.value = "grey50") + + ggplot2::scale_colour_brewer(palette = "Paired") + + ggplot2::scale_y_continuous( label = scales::label_number(accuracy = 1, + scale_cut = scales::cut_short_scale(), + suffix = "%") )+ + ggplot2::scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 120)) + + unhcrthemes::theme_unhcr(font_size = 22, + axis_text_size = 9, + grid = "Y", + axis = "y") + + ggplot2::theme( legend.direction = "vertical", + legend.box = "horizontal", + legend.position = "right")+ + + ggplot2::labs( x = "", y = "" , + title = stringr::str_wrap( + paste0( result_type_name, " Indicators ", + programme_lab, ctr_name,iati_identifier_ops ) , + 100), + subtitle = stringr::str_wrap( paste0( + "Deviation between reported \"Actual\" value and programmatic \"Target\" (in %)" ) , + 110), + caption = stringr::str_wrap( + "Data Source: UNHCR IATI (International Aid Transparency Initiative)" , + 110) ) + } + } + return(p) + +} diff --git a/R/show_sectors.R b/R/show_sectors.R index 66a5b94..2652121 100644 --- a/R/show_sectors.R +++ b/R/show_sectors.R @@ -4,7 +4,7 @@ #' #' @description What are the most funded sectors per country (Expenditure evolution per impact /outcome area)? #' -#' @param year A numeric value corresponding to the first year of focus until the most recent year within the dataset. +#' @param year A numeric value or a list of value. #' @param programme_lab A character vector corresponding to the name of the programme. #' @param iati_identifier_ops A character vector corresponding to the name of the operation. #' @param ctr_name A character vector corresponding to the name of the country. @@ -19,16 +19,30 @@ #' @export #' @return a graph #' @examples -#' #' knitr::kable( iati::dataSector |> #' dplyr::select( sector_vocabulary_name, sector_vocabulary_description) |> -#' dplyr::distinct()) -#' -#' show_sectors(year = 2018, -#' programme_lab = NULL, -#' iati_identifier_ops = NULL, -#' ctr_name = "Syria", -#' sector_vocabulary_name = "Reporting Organisation 2") +#' dplyr::distinct() |> +#' dplyr::filter(!(is.na(sector_vocabulary_name)))) +#' show_sectors( +#' year = c(2020, 2021, 2022), +#' ctr_name = "Brazil", +#' sector_vocabulary_name = "Reporting Organisation") +#' show_sectors( +#' year = 2022, +#' ctr_name = "Brazil", +#' sector_vocabulary_name = "Reporting Organisation 2") +#' show_sectors( +#' year = c(2020, 2021, 2022), +#' ctr_name = "Brazil", +#' sector_vocabulary_name = "Reporting Organisation 2") +#' show_sectors( +#' year = c(2017,2018,2019,2020,2021, 2022), +#' ctr_name = "Brazil", +#' sector_vocabulary_name = "Humanitarian Global Clusters (Inter-Agency Standing Committee)") +#' show_sectors( +#' year = c(2017,2018,2019,2020,2021, 2022), +#' ctr_name = "Brazil", +#' sector_vocabulary_name = "OECD DAC CRS Purpose Codes (5 digit)") show_sectors <- function(year, programme_lab = NULL, iati_identifier_ops = NULL, @@ -52,24 +66,27 @@ show_sectors <- function(year, thisyear <- year thissector_vocabulary <- sector_vocabulary df <- df |> + dplyr::mutate(year = factor(year)) |> dplyr::filter(programmme_lab == thiprogramme_lab & - year > thisyear & + year %in% thisyear & sector_vocabulary_name == thissector_vocabulary_name) } else if (!is.null(iati_identifier_ops)) { thisiati_identifier_ops <- iati_identifier_ops thisyear <- year thissector_vocabulary_name <- sector_vocabulary_name df <- df |> + dplyr::mutate(year = factor(year)) |> dplyr::filter(iati_identifier_ops == thisiati_identifier_ops & - year > thisyear & + year %in% thisyear & sector_vocabulary_name == thissector_vocabulary_name) } else if (!is.null(ctr_name)) { thisctr_name <- ctr_name thisyear <- year thissector_vocabulary_name <- sector_vocabulary_name df <- df |> + dplyr::mutate(year = factor(year)) |> dplyr::filter(ctr_name == thisctr_name & - year > thisyear & + year %in% thisyear & sector_vocabulary_name == thissector_vocabulary_name) } @@ -85,13 +102,17 @@ show_sectors <- function(year, ggplot2::aes(x = stats::reorder(sector_desc, sector_pct), y = sector_pct )) + - unhcrthemes::theme_unhcr(grid = TRUE, axis = "Y", axis_title = "Sector Percentage") + - ggplot2::geom_bar(stat = "identity") + + # unhcrthemes::theme_unhcr(grid = TRUE, axis = "Y", axis_title = "Sector Percentage") + + unhcrthemes::theme_unhcr(grid = "X", axis = "y", axis_title = "X", font_size = 18) + + + ggplot2::geom_bar(stat = "identity", fill = "#0072BC") + ggplot2::coord_flip()+ ggplot2::facet_wrap( ggplot2::vars(year)) + ggplot2::scale_fill_viridis_d(option = "inferno", na.value = "grey50") + ggplot2::scale_y_continuous(expand = ggplot2::expansion(mult = c(0, .1)), labels = scales::label_number(scale_cut = scales::cut_short_scale())) + - ggplot2::labs(title = "Share of budget per sectors for the selected year", + ggplot2::labs(title = "Share of Budget per Sectors (%)", + subtitle = paste0("Recorded in ", programme_lab, ctr_name,iati_identifier_ops, + " based on vocabulary: ", sector_vocabulary_name), x = "Sectors", y = "% of Total Funding", caption = "Data Source: UNHCR IATI (International Aid Transparency Initiative)") diff --git a/R/show_sectors_rbm.R b/R/show_sectors_rbm.R new file mode 100644 index 0000000..14c3004 --- /dev/null +++ b/R/show_sectors_rbm.R @@ -0,0 +1,143 @@ +# WARNING - Generated by {fusen} from dev/dev_unhcr_programme.Rmd: do not edit by hand + + +#' show_sectors_rbm +#' +#' @description What are the most funded sectors per country based on new RBM framework +#' +#' @param year A numeric value or a list of value. +#' @param programme_lab A character vector corresponding to the name of the programme. +#' @param iati_identifier_ops A character vector corresponding to the name of the operation. +#' @param ctr_name A character vector corresponding to the name of the country. +#' +#' @import ggplot2 +#' @import dplyr +#' @import scales +#' @import unhcrthemes +#' @importFrom stats reorder +#' +#' @export +#' @return a graph +#' @examples +#' show_sectors_rbm( year = c(2017, 2018, 2019, 2020, 2021, 2022), +#' ctr_name = "Brazil") +show_sectors_rbm <- function(year, + programme_lab = NULL, + iati_identifier_ops = NULL, + ctr_name = NULL ){ + # Check if only one argument is passed + if (!is.null(programme_lab) && !is.null(iati_identifier_ops)) { + stop("Please pass only one of the arguments programme_lab or iati_identifier_ops.") + } else if (!is.null(programme_lab) && !is.null(ctr_name)) { + stop("Please pass only one of the arguments programme_lab or ctr_name.") + } else if (!is.null(iati_identifier_ops) && !is.null(ctr_name)) { + stop("Please pass only one of the arguments iati_identifier_ops or ctr_name.") + } + + # Join dataActivity and dataSector on iati_identifier + df <- iati::dataSector |> + dplyr::left_join(iati::dataActivity, by = c("iati_identifier")) + + if (!is.null(programme_lab)) { + thisprogramme_lab <- programme_lab + thisyear <- year + df <- df |> + dplyr::mutate(year = factor(year)) |> + dplyr::filter(programmme_lab == thiprogramme_lab & + year %in% thisyear & + sector_vocabulary_name == "Reporting Organisation 2") |> + dplyr::left_join(iati::mapping_sector, by= c("sector_desc")) + } else if (!is.null(iati_identifier_ops)) { + thisiati_identifier_ops <- iati_identifier_ops + thisyear <- year + df <- df |> + dplyr::mutate(year = factor(year)) |> + dplyr::filter(iati_identifier_ops == thisiati_identifier_ops & + year %in% thisyear & + sector_vocabulary_name == "Reporting Organisation 2") |> + dplyr::left_join(iati::mapping_sector, by= c("sector_desc")) + } else if (!is.null(ctr_name)) { + thisctr_name <- ctr_name + thisyear <- year + df <- df |> + dplyr::mutate(year = factor(year)) |> + dplyr::filter(ctr_name == thisctr_name & + year %in% thisyear & + sector_vocabulary_name == "Reporting Organisation 2") |> + dplyr::left_join(iati::mapping_sector, by= c("sector_desc")) + } + + df <- df |> + dplyr::group_by(sector_desc, sector_rbm, year) |> + dplyr::summarise(sector_pct = mean( as.numeric(sector_pct)) ) |> + dplyr::group_by( sector_rbm, year) |> + dplyr::summarise(sector_pct = sum(sector_pct, rm.na = TRUE)) |> + # dplyr::summarise(sector_pct = sum(sector_pct, na.rm = TRUE)/sum(df$sector_pct, na.rm = TRUE)*100) |> + # top_n(5, wt = sector_pct) |> + dplyr::mutate(sector_rbm = as.factor(sector_rbm)) + + + ## Now joining budget & Expenditure to make the chart more informative... + df_bud <- iati::dataTransaction |> + dplyr::left_join(iati::dataActivity, by= c("iati_identifier")) + + if (!is.null(programme_lab)) { + thisprogramme_lab <- programme_lab + thisyear <- year + df_bud <- df_bud |> + # levels(as.factor(df$programmme_lab)) + dplyr::filter( programmme_lab == thisprogramme_lab & + year %in% thisyear & + transaction_type_name == "Expenditure") + } else if (!is.null(iati_identifier_ops)) { + thisiati_identifier_ops <- iati_identifier_ops + thisyear <- year + df_bud <- df_bud |> + dplyr::filter(iati_identifier_ops == thisiati_identifier_ops & + year %in% thisyear & + transaction_type_name == "Expenditure") + } else if (!is.null(ctr_name)) { + thisctr_name <- ctr_name + thisyear <- year + df_bud <- df_bud |> + dplyr::filter( ctr_name == thisctr_name & + year %in% thisyear & + transaction_type_name == "Expenditure") + } + + df_bud2 <- df_bud |> + dplyr::group_by(iati_identifier, year) |> + dplyr::summarise(transaction_value= sum(transaction_value, na.rm = TRUE)) |> + dplyr::left_join(iati::dataBudget |> + dplyr::mutate(budget_value= as.numeric(budget_value)) |> + dplyr::group_by(iati_identifier) |> + dplyr::summarise(budget_value= sum(budget_value, na.rm = TRUE)) + , by= c("iati_identifier")) |> + dplyr::select(iati_identifier, year,budget_value, transaction_value ) |> + dplyr::mutate( year2 = glue::glue('{year} - Bud:{scales::label_number(accuracy = .2, scale_cut = scales::cut_short_scale())(budget_value)}$/ Exp:{scales::label_number(accuracy = .2, scale_cut = scales::cut_short_scale())(transaction_value)}$ ')) + + df <- df |> + dplyr::left_join(df_bud2, by = c("year")) + + + + p <- ggplot2::ggplot(data = df, + ggplot2::aes(x = stats::reorder(sector_rbm, sector_pct), + y = sector_pct + )) + + # unhcrthemes::theme_unhcr(grid = TRUE, axis = "Y", axis_title = "Sector Percentage") + + unhcrthemes::theme_unhcr(grid = "X", axis = "y", axis_title = "X", font_size = 18) + + + ggplot2::geom_bar(stat = "identity", fill = "#0072BC") + + ggplot2::coord_flip()+ + ggplot2::facet_wrap( ggplot2::vars(year2)) + + ggplot2::scale_fill_viridis_d(option = "inferno", na.value = "grey50") + + ggplot2::scale_y_continuous(expand = ggplot2::expansion(mult = c(0, .1)), labels = scales::label_number(scale_cut = scales::cut_short_scale())) + + ggplot2::labs(title = "Share of Budget per Sectors (%)", + subtitle = paste0("Recorded in ", programme_lab, ctr_name,iati_identifier_ops, + " based on UNHCR Results Framework "), + x = "Sectors", y = "% of Total Funding", + caption = "Data Source: UNHCR IATI (International Aid Transparency Initiative). UNHCR budget is needs-based. It represents the total amount of money that would be required were UNHCR to meet all of the needs that it is seeking to address.") + + return(p) +} diff --git a/_pkgdown.yml b/_pkgdown.yml index 942add9..5b6e169 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -15,6 +15,10 @@ reference: desc: Lookup tables contents: - starts_with("code") +- title: Mapping + desc: Mapping tables + contents: + - starts_with("mapping") - title: Reference desc: UNHCR Geographci Referential contents: diff --git a/data/mapping_result.RData b/data/mapping_result.RData new file mode 100644 index 0000000..82a13ed Binary files /dev/null and b/data/mapping_result.RData differ diff --git a/data/mapping_sector.RData b/data/mapping_sector.RData new file mode 100644 index 0000000..6f551c9 Binary files /dev/null and b/data/mapping_sector.RData differ diff --git a/dev/dev_unhcr_programme.Rmd b/dev/dev_unhcr_programme.Rmd index 45edc04..5f028c2 100644 --- a/dev/dev_unhcr_programme.Rmd +++ b/dev/dev_unhcr_programme.Rmd @@ -304,7 +304,20 @@ test_that("show_top_donors works", { ```{r function-show_earmarking} #' Title #' -#' @description What’s the breakdown of Earmarking Type (Un-earmarked, Tightly earmarked, etc.) from Donor Funds by Year? +#' @description What’s the breakdown of Earmarking Type (Un-earmarked, Tightly earmarked, etc.) \ +#' from Donor Funds by Year? +#' Where possible, UNHCR prefers to receive unearmarked funds, as this allows the agency +#' greater flexibility in allocating its resources as new needs emerge during the course of the year. +#' Should that not be possible, funds can also be softly earmarked. This could mean funds that +#' can be spent anywhere within a region or for a particular situation (for example, funds that have +#' to be spent to assist refugees from Syria, but which can be spent in any country hosting such +#' refugees). Earmarked funds would be a contribution that corresponds to a specific country but +#' can be spent on anything within that operation’s programme. Finally, tightly earmarked funds +#' are those that specify an activity or a population within a country’s programme. +#' +#' UNHCR charges an ISC - Indirect Support Costs - rate of 6.5% on all of its earmarked contributions. +#' This covers management and administration costs at HQ and programme support costs +#' incurred at HQ and Regional Bureaux. #' #' @param year A numeric value corresponding to the first year of focus until the most recent year within the dataset. #' @param programme_lab A character vector corresponding to the name of the programme. @@ -673,7 +686,7 @@ show_expenditure <- function(year, subtitle = subtitt, x = "", y = "", - caption = "Data Source: UNHCR IATI (International Aid Transparency Initiative)" ) + caption = "Data Source: UNHCR IATI (International Aid Transparency Initiative). UNHCR budget is needs-based. It represents the total amount of money that would be required were UNHCR to meet all of the needs that it is seeking to address." ) return(p) } @@ -701,10 +714,19 @@ test_that("show_expenditure works", { ```{r function-show_budget_gap} #' show_budget_gap #' +#' UNHCR budgets are needs-based: it represents the total amount +#' of money that would be required were UNHCR to meet all of the needs that it is seeking to address. +#' #' @param year A numeric value corresponding to the first year of focus until the most recent year within the dataset. #' @param programme_lab A character vector corresponding to the name of the programme. #' @param iati_identifier_ops A character vector corresponding to the name of the operation. #' @param ctr_name A character vector corresponding to the name of the country. +#' @param weight_by list of population group to weight the budget - +#' "refugees", "asylum_seekers", +#' "returned_refugees" "idps", +#' "returned_idps", "stateless", +#' "ooc", "oip" +#' default is null. #' #' @import ggplot2 #' @import dplyr @@ -717,7 +739,8 @@ test_that("show_expenditure works", { show_budget_gap <- function(year, programme_lab = NULL, iati_identifier_ops = NULL, - ctr_name = NULL ) { + ctr_name = NULL , + weight_by = NULL ) { # Check if only one argument is passed @@ -768,6 +791,55 @@ show_budget_gap <- function(year, dplyr::mutate(budget_gap = (budget_value - transaction_value) / budget_value *100) + + if ( !is.null(weight_by) && !all(weight_by %in% c("refugees", "asylum_seekers", + "returned_refugees", "idps", + "returned_idps", "stateless", + "ooc", "oip" )) ) { + stop("weight_by is used but the population filter is not correctly set up...\n + it should be among: refugees, asylum_seekers, returned_refugees, idps, + returned_idps, stateless, ooc, oip") + } + + ## Calculate weight + if (!is.null(weight_by) && !is.null(ctr_name) ) { + ctrstat <- refugees::population |> + dplyr::filter( year>= thisyear & + coa_name == thisctr_name) |> + dplyr::group_by(year, coa_name) |> + dplyr::summarise(refugees = sum(refugees, na.rm = TRUE), + asylum_seekers = sum(asylum_seekers, na.rm = TRUE), + returned_refugees = sum(returned_refugees, na.rm = TRUE), + idps = sum(idps, na.rm = TRUE), + returned_idps = sum(returned_idps , na.rm = TRUE), + stateless = sum(stateless, na.rm = TRUE), + ooc = sum( ooc, na.rm = TRUE), + oip = sum(oip, na.rm = TRUE)) |> + dplyr::select(year, coa_name, all_of(weight_by) ) |> + dplyr::mutate(year = as.factor(year) ) |> + dplyr::mutate( weight = rowSums( + dplyr::across(tidyselect::where(is.numeric)))) + + df2 <- df2 |> + dplyr::left_join(ctrstat |> + dplyr::select(year, weight) , by = c("year")) |> + dplyr::mutate(budget_value = round(budget_value / weight,1), + transaction_value = round(transaction_value / weight,1))|> + dplyr::mutate(budget_gap = (budget_value - transaction_value) / budget_value *100) + + } + + subtitt <- if( is.null(weight_by)) { + paste0("In ", programme_lab, ctr_name,iati_identifier_ops, " recorded since ", year,"") + } else { + paste0("Weighted by total number of individual ", + paste(weight_by, collapse = ', '), + " in ", + programme_lab, ctr_name,iati_identifier_ops, " as recorded since ", year,"") + } + + + p <- df2 |> # dplyr::filter(transaction_value_USD <= 1000000 & transaction_value_USD > 1000) |> @@ -786,10 +858,10 @@ show_budget_gap <- function(year, legend = FALSE)+ ggplot2::labs( title = paste0( "Budget Gap (in %)"), - subtitle = paste0("In ", programme_lab, ctr_name,iati_identifier_ops, " recorded since ", year,""), + subtitle = subtitt , x = "", y = "", - caption = "Data Source: UNHCR IATI (International Aid Transparency Initiative)" ) + caption = "Data Source: UNHCR IATI (International Aid Transparency Initiative). UNHCR budget is needs-based. It represents the total amount of money that would be required were UNHCR to meet all of the needs that it is seeking to address." ) return(p) @@ -799,6 +871,12 @@ show_budget_gap <- function(year, ```{r example-show_budget_gap, message=FALSE, warning=FALSE, fig.retina = 2, fig.width = 8, fig.asp = 0.618, fig.align = "center", out.width = "90%"} show_budget_gap(year = 2018, ctr_name = "Brazil") + + + +show_budget_gap(year = 2018, + ctr_name = "Brazil", + weight_by = c("refugees", "oip")) ``` ```{r tests-show_budget_gap} @@ -1057,21 +1135,26 @@ knitr::kable( iati::dataSector |> dplyr::select( sector_vocabulary_name, sector_vocabulary_description) |> dplyr::distinct() |> dplyr::filter(!(is.na(sector_vocabulary_name)))) -show_sectors(year = c(2020, 2021, 2022), - ctr_name = "Brazil", - sector_vocabulary_name = "Reporting Organisation") -show_sectors(year = 2022, - ctr_name = "Brazil", - sector_vocabulary_name = "Reporting Organisation 2") -show_sectors(year = c(2020, 2021, 2022), - ctr_name = "Brazil", - sector_vocabulary_name = "Reporting Organisation 2") -show_sectors(year = c(2017,2018,2019,2020,2021, 2022), - ctr_name = "Brazil", - sector_vocabulary_name = "Humanitarian Global Clusters (Inter-Agency Standing Committee)") -show_sectors(year = c(2017,2018,2019,2020,2021, 2022), - ctr_name = "Brazil", - sector_vocabulary_name = "OECD DAC CRS Purpose Codes (5 digit)") +show_sectors( + year = c(2020, 2021, 2022), + ctr_name = "Brazil", + sector_vocabulary_name = "Reporting Organisation") +show_sectors( + year = 2022, + ctr_name = "Brazil", + sector_vocabulary_name = "Reporting Organisation 2") +show_sectors( + year = c(2020, 2021, 2022), + ctr_name = "Brazil", + sector_vocabulary_name = "Reporting Organisation 2") +show_sectors( + year = c(2017,2018,2019,2020,2021, 2022), + ctr_name = "Brazil", + sector_vocabulary_name = "Humanitarian Global Clusters (Inter-Agency Standing Committee)") +show_sectors( + year = c(2017,2018,2019,2020,2021, 2022), + ctr_name = "Brazil", + sector_vocabulary_name = "OECD DAC CRS Purpose Codes (5 digit)") ``` ```{r tests-show_sectors} @@ -1079,7 +1162,162 @@ test_that("show_sectors works", { expect_true(inherits(show_sectors, "function")) }) ``` + + +## show_sectors_rbm + +```{r function-show_sectors_rbm} + +#' show_sectors_rbm +#' +#' @description What are the most funded sectors per country based on new RBM framework +#' +#' @param year A numeric value or a list of value. +#' @param programme_lab A character vector corresponding to the name of the programme. +#' @param iati_identifier_ops A character vector corresponding to the name of the operation. +#' @param ctr_name A character vector corresponding to the name of the country. +#' +#' @import ggplot2 +#' @import dplyr +#' @import scales +#' @import unhcrthemes +#' @importFrom stats reorder +#' +#' @export +#' @return a graph +show_sectors_rbm <- function(year, + programme_lab = NULL, + iati_identifier_ops = NULL, + ctr_name = NULL ){ + # Check if only one argument is passed + if (!is.null(programme_lab) && !is.null(iati_identifier_ops)) { + stop("Please pass only one of the arguments programme_lab or iati_identifier_ops.") + } else if (!is.null(programme_lab) && !is.null(ctr_name)) { + stop("Please pass only one of the arguments programme_lab or ctr_name.") + } else if (!is.null(iati_identifier_ops) && !is.null(ctr_name)) { + stop("Please pass only one of the arguments iati_identifier_ops or ctr_name.") + } + + # Join dataActivity and dataSector on iati_identifier + df <- iati::dataSector |> + dplyr::left_join(iati::dataActivity, by = c("iati_identifier")) + + if (!is.null(programme_lab)) { + thisprogramme_lab <- programme_lab + thisyear <- year + df <- df |> + dplyr::mutate(year = factor(year)) |> + dplyr::filter(programmme_lab == thiprogramme_lab & + year %in% thisyear & + sector_vocabulary_name == "Reporting Organisation 2") |> + dplyr::left_join(iati::mapping_sector, by= c("sector_desc")) + } else if (!is.null(iati_identifier_ops)) { + thisiati_identifier_ops <- iati_identifier_ops + thisyear <- year + df <- df |> + dplyr::mutate(year = factor(year)) |> + dplyr::filter(iati_identifier_ops == thisiati_identifier_ops & + year %in% thisyear & + sector_vocabulary_name == "Reporting Organisation 2") |> + dplyr::left_join(iati::mapping_sector, by= c("sector_desc")) + } else if (!is.null(ctr_name)) { + thisctr_name <- ctr_name + thisyear <- year + df <- df |> + dplyr::mutate(year = factor(year)) |> + dplyr::filter(ctr_name == thisctr_name & + year %in% thisyear & + sector_vocabulary_name == "Reporting Organisation 2") |> + dplyr::left_join(iati::mapping_sector, by= c("sector_desc")) + } + + df <- df |> + dplyr::group_by(sector_desc, sector_rbm, year) |> + dplyr::summarise(sector_pct = mean( as.numeric(sector_pct)) ) |> + dplyr::group_by( sector_rbm, year) |> + dplyr::summarise(sector_pct = sum(sector_pct, rm.na = TRUE)) |> + # dplyr::summarise(sector_pct = sum(sector_pct, na.rm = TRUE)/sum(df$sector_pct, na.rm = TRUE)*100) |> + # top_n(5, wt = sector_pct) |> + dplyr::mutate(sector_rbm = as.factor(sector_rbm)) + + + ## Now joining budget & Expenditure to make the chart more informative... + df_bud <- iati::dataTransaction |> + dplyr::left_join(iati::dataActivity, by= c("iati_identifier")) + + if (!is.null(programme_lab)) { + thisprogramme_lab <- programme_lab + thisyear <- year + df_bud <- df_bud |> + # levels(as.factor(df$programmme_lab)) + dplyr::filter( programmme_lab == thisprogramme_lab & + year %in% thisyear & + transaction_type_name == "Expenditure") + } else if (!is.null(iati_identifier_ops)) { + thisiati_identifier_ops <- iati_identifier_ops + thisyear <- year + df_bud <- df_bud |> + dplyr::filter(iati_identifier_ops == thisiati_identifier_ops & + year %in% thisyear & + transaction_type_name == "Expenditure") + } else if (!is.null(ctr_name)) { + thisctr_name <- ctr_name + thisyear <- year + df_bud <- df_bud |> + dplyr::filter( ctr_name == thisctr_name & + year %in% thisyear & + transaction_type_name == "Expenditure") + } + + df_bud2 <- df_bud |> + dplyr::group_by(iati_identifier, year) |> + dplyr::summarise(transaction_value= sum(transaction_value, na.rm = TRUE)) |> + dplyr::left_join(iati::dataBudget |> + dplyr::mutate(budget_value= as.numeric(budget_value)) |> + dplyr::group_by(iati_identifier) |> + dplyr::summarise(budget_value= sum(budget_value, na.rm = TRUE)) + , by= c("iati_identifier")) |> + dplyr::select(iati_identifier, year,budget_value, transaction_value ) |> + dplyr::mutate( year2 = glue::glue('{year} - Bud:{scales::label_number(accuracy = .2, scale_cut = scales::cut_short_scale())(budget_value)}$/ Exp:{scales::label_number(accuracy = .2, scale_cut = scales::cut_short_scale())(transaction_value)}$ ')) + + df <- df |> + dplyr::left_join(df_bud2, by = c("year")) + + + p <- ggplot2::ggplot(data = df, + ggplot2::aes(x = stats::reorder(sector_rbm, sector_pct), + y = sector_pct + )) + + # unhcrthemes::theme_unhcr(grid = TRUE, axis = "Y", axis_title = "Sector Percentage") + + unhcrthemes::theme_unhcr(grid = "X", axis = "y", axis_title = "X", font_size = 18) + + + ggplot2::geom_bar(stat = "identity", fill = "#0072BC") + + ggplot2::coord_flip()+ + ggplot2::facet_wrap( ggplot2::vars(year2)) + + ggplot2::scale_fill_viridis_d(option = "inferno", na.value = "grey50") + + ggplot2::scale_y_continuous(expand = ggplot2::expansion(mult = c(0, .1)), labels = scales::label_number(scale_cut = scales::cut_short_scale())) + + ggplot2::labs(title = "Share of Budget per Sectors (%)", + subtitle = paste0("Recorded in ", programme_lab, ctr_name,iati_identifier_ops, + " based on UNHCR Results Framework "), + x = "Sectors", y = "% of Total Funding", + caption = "Data Source: UNHCR IATI (International Aid Transparency Initiative). UNHCR budget is needs-based. It represents the total amount of money that would be required were UNHCR to meet all of the needs that it is seeking to address.") + + return(p) +} +``` + +```{r example-show_sectors_rbm} +show_sectors_rbm( year = c(2017, 2018, 2019, 2020, 2021, 2022), + ctr_name = "Brazil") +``` + +```{r tests-show_sectors_rbm} +test_that("show_sectors_rbm works", { + expect_true(inherits(show_sectors_rbm, "function")) +}) +``` + # Using `iati::dataResult` @@ -1399,6 +1637,322 @@ test_that("show_indicators works", { expect_true(inherits(show_indicators, "function")) }) ``` + +## show_indicators_time + + +```{r function-show_indicators_time} +#' show_indicators_time +#' +#' How much indicators evolve over time against thresholds? +#' +#' @param year A numeric value corresponding to the first year of focus until the most recent year within the dataset. +#' @param programme_lab A character vector corresponding to the name of the programme. +#' @param iati_identifier_ops A character vector corresponding to the name of the operation. +#' @param ctr_name A character vector corresponding to the name of the country. +#' @param result_type_name either "Impact" "Outcome" "Output" - default is "Outcome" +#' @param type "deviation" showing difference between target and actual - or +#' "progress" showing difference between baseline and actual +#' +#' @import ggplot2 +#' @import dplyr +#' @import scales +#' @import unhcrthemes +#' @importFrom stats reorder +#' +#' @export +#' +#' @return a graph +show_indicators_time <- function(year, + programme_lab = NULL, + iati_identifier_ops = NULL, + ctr_name = NULL , + result_type_name = "Outcome", + type = "deviation") { + + + # Check if only one argument is passed + if (!is.null(programme_lab) && !is.null(iati_identifier_ops)) { + stop("Please pass only one of the arguments programme_lab or iati_identifier_ops.") + } else if (!is.null(programme_lab) && !is.null(ctr_name)) { + stop("Please pass only one of the arguments programme_lab or ctr_name.") + } else if (!is.null(iati_identifier_ops) && !is.null(ctr_name)) { + stop("Please pass only one of the arguments iati_identifier_ops or ctr_name.") + } + + df <- iati::dataResult |> + dplyr::left_join(iati::dataActivity, by= c("iati_identifier")) + + if (!is.null(programme_lab)) { + thisprogramme_lab <- programme_lab + thisyear <- year + thisresult_type_name <- result_type_name + df <- df |> + # levels(as.factor(df$result_type_name )) + dplyr::filter( programmme_lab == thisprogramme_lab & + year >= thisyear & + result_type_name == thisresult_type_name) |> + dplyr::left_join(iati::mapping_result, by= c("result_title")) |> + dplyr::distinct() + + } else if (!is.null(iati_identifier_ops)) { + thisiati_identifier_ops <- iati_identifier_ops + thisyear <- year + thisresult_type_name <- result_type_name + df <- df |> + dplyr::filter(iati_identifier_ops == thisiati_identifier_ops & + year >= thisyear & + result_type_name == thisresult_type_name) |> + dplyr::left_join(iati::mapping_result, by= c("result_title")) |> + dplyr::distinct() + + } else if (!is.null(ctr_name)) { + thisctr_name <- ctr_name + thisyear <- year + thisresult_type_name <- result_type_name + df <- df |> + dplyr::filter( ctr_name == thisctr_name & + year >= thisyear & + result_type_name == thisresult_type_name) |> + dplyr::left_join(iati::mapping_result, by= c("result_title")) |> + dplyr::distinct() + } + + ## in order to compare indictors alltogether in the same country, we need to normalise them + ## one way is to compute the distance to the target... + ## names(df) + + #table(df$result_indicator_ascending, useNA = "ifany") + df1 <- df |> + dplyr::select(result_type_name , result_title, sector_rbm, + indicator_measure_name, result_indicator_title, + year, + + result_indicator_baseline_value, + result_indicator_actual_value, + result_indicator_target_value, + result_indicator_target_value_1, + + result_indicator_baseline_location_ref, + result_indicator_baseline_dimension_1, + result_indicator_baseline_dimension_value_1, + result_indicator_baseline_dimension_2, + result_indicator_baseline_dimension_value_2, + result_indicator_ascending) |> + + ## Quick fix in case ascending is not documented... + dplyr::mutate( result_indicator_ascending = dplyr::if_else( is.na(result_indicator_ascending), + + "1", + result_indicator_ascending)) |> + + dplyr::mutate( actual = as.numeric(result_indicator_actual_value), + baseline = as.numeric(result_indicator_baseline_value), + target = as.numeric(result_indicator_target_value), + ## Reshape the indicator label... + operation = as.character(glue::glue("{result_indicator_title} / {result_indicator_target_value_1}") ), + # operation = as.character(glue::glue("{result_indicator_title} / {result_title} - + # {result_indicator_target_value_1}") ), + + + ## Calculating deviation to target + deviation_actual_target = round( ( actual - target ) / + dplyr::if_else(target == 0, 1, target) * + dplyr::if_else(target == 0, 1, 100) ,2 ), + + ## Account for indicator direction + deviation_actual_target = dplyr::if_else(result_indicator_ascending == 0, + deviation_actual_target * -1, + deviation_actual_target), + + deviation_color = dplyr::case_when( + deviation_actual_target >= -1 ~ "green", + deviation_actual_target < -1 & deviation_actual_target >= -15 ~ "orange", + deviation_actual_target < -15 ~ "red", + TRUE ~ ""), + ## Calculating progress to baseline.. + progress_baseline = round( ( actual - baseline) / + dplyr::if_else(baseline == 0, 1, baseline) * + dplyr::if_else(baseline == 0, 1, 100) ,2 ), + ## Account for indicator direction + progress_baseline = dplyr::if_else(result_indicator_ascending == 0, + progress_baseline * -1, + progress_baseline), + progress_color = dplyr::case_when( + progress_baseline >= -1 ~ "green", + progress_baseline < -1 & progress_baseline >= -15 ~ "orange", + progress_baseline < -15 ~ "red", + TRUE ~ "") + + ) + + ### Type of chart to build... + if(type == "deviation") { + + df1 <- df1 |> + ## Filter out - when no data... + dplyr::filter (! (is.na(actual))) |> + dplyr::filter (! (is.na(target))) |> + dplyr::filter (! (is.nan(deviation_actual_target))) |> + #dplyr::arrange(desc(actual)) + dplyr::group_by( result_indicator_title) |> + dplyr::arrange(desc( actual), .by_group=TRUE ) |> + dplyr::ungroup(result_indicator_title) + + ## case there's no data at all + if( nrow(df1) == 0) { + info <- paste0("No deviation - actual to target - \n comparative analysis \n could be produced for \n", + result_type_name, " indicator values \n in ", + programme_lab, ctr_name,iati_identifier_ops, " for year: ", year) + p <- ggplot2::ggplot() + + ggplot2::annotate("text", x = 1, y = 1, size = 12, + label = info ) + + ggplot2::theme_void() + + } else if(nrow(df1)> 0) { + ## and now the plot + p <- ggplot2::ggplot( df1, + ggplot2::aes(x = year, + y = deviation_actual_target, + #shape = indicator_measure_name, + color = sector_rbm)) + + ggplot2::geom_jitter(position=position_jitter(0.2), + shape = 17, + size = 3) + + ggplot2::stat_summary(fun.data=mean_sdl, #mult=1, + geom="pointrange", color="grey", size = 3) + + geom_hline(yintercept= 0, color="red") + + # ggplot2::scale_color_viridis_d(option = "inferno", na.value = "grey50") + + ggplot2::scale_colour_brewer(palette = "Paired") + + ggplot2::scale_y_continuous( label = scales::label_number(accuracy = 1, + scale_cut = scales::cut_short_scale(), + suffix = "%") )+ + ggplot2::scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 120)) + + unhcrthemes::theme_unhcr(font_size = 22, + axis_text_size = 9, + grid = "Y", + axis = "y") + + ggplot2::theme( legend.direction = "vertical", + legend.box = "horizontal", + legend.position = "right")+ + + ggplot2::labs( x = "", y = "" , + title = stringr::str_wrap( + paste0( result_type_name, " Indicators ", + programme_lab, ctr_name,iati_identifier_ops ) , + 100), + subtitle = stringr::str_wrap( paste0( + "Deviation between reported \"Actual\" value and programmatic \"Target\" (in %)" ) , + 110), + caption = stringr::str_wrap( + "Data Source: UNHCR IATI (International Aid Transparency Initiative)" , + 110) ) + } + } else if( type == "progress") { + + df1 <- df1 |> + ## Filter out - when no data... + dplyr::filter (! (is.na(actual))) |> + dplyr::filter (! (is.na(baseline))) |> + dplyr::filter (! (is.nan(progress_baseline))) |> + #dplyr::arrange(desc(actual)) + dplyr::group_by( result_indicator_title) |> + dplyr::arrange(desc( actual), .by_group=TRUE ) |> + dplyr::ungroup(result_indicator_title) + + ## case there's no data at all + if( nrow(df1) == 0) { + info <- paste0("No progress - actual to baseline - \n comparative analysis \n could be produced for \n", + result_type_name, " indicator values \n in ", + programme_lab, ctr_name,iati_identifier_ops, " for year: ", year) + p <- ggplot2::ggplot() + + ggplot2::annotate("text", x = 1, y = 1, size = 12, + label = info ) + + ggplot2::theme_void() + + } else if(nrow(df1)> 0) { + ## and now the plot + p <- ggplot2::ggplot( df1, + ggplot2::aes(x = year, + y = progress_baseline, + #shape = indicator_measure_name, + color = sector_rbm)) + + ggplot2::geom_jitter(position=position_jitter(0.2), + shape = 17, + size = 3) + + ggplot2::stat_summary(fun.data=mean_sdl, #mult=1, + geom="pointrange", color="grey", size = 3) + + geom_hline(yintercept= 0, color="red") + + # ggplot2::scale_color_viridis_d(option = "inferno", na.value = "grey50") + + ggplot2::scale_colour_brewer(palette = "Paired") + + ggplot2::scale_y_continuous( label = scales::label_number(accuracy = 1, + scale_cut = scales::cut_short_scale(), + suffix = "%") )+ + ggplot2::scale_x_discrete(labels = function(x) stringr::str_wrap(x, width = 120)) + + unhcrthemes::theme_unhcr(font_size = 22, + axis_text_size = 9, + grid = "Y", + axis = "y") + + ggplot2::theme( legend.direction = "vertical", + legend.box = "horizontal", + legend.position = "right")+ + + ggplot2::labs( x = "", y = "" , + title = stringr::str_wrap( + paste0( result_type_name, " Indicators ", + programme_lab, ctr_name,iati_identifier_ops ) , + 100), + subtitle = stringr::str_wrap( paste0( + "Deviation between reported \"Actual\" value and programmatic \"Target\" (in %)" ) , + 110), + caption = stringr::str_wrap( + "Data Source: UNHCR IATI (International Aid Transparency Initiative)" , + 110) ) + } + } + return(p) + +} +``` + +```{r example-show_indicators_time, message=FALSE, warning=FALSE, fig.retina = 2, fig.width = 8, fig.align = "center", out.width = "90%"} +show_indicators_time(year = 2020, + ctr_name = "Brazil", + result_type_name = "Outcome", + type = "deviation" + ) +show_indicators_time(year = 2022, + ctr_name = "Brazil", + result_type_name = "Impact", + type = "deviation" + ) +show_indicators_time(year = 2019, + ctr_name = "Brazil", + result_type_name = "Output", + type = "deviation" + ) +show_indicators_time(year = 2022, + ctr_name = "Brazil", + result_type_name = "Outcome", + type = "progress" + ) +show_indicators_time(year = 2022, + ctr_name = "Brazil", + result_type_name = "Impact", + type = "progress" + ) +show_indicators_time(year = 2019, + ctr_name = "Brazil", + result_type_name = "Output", + type = "progress" + ) +``` + +```{r tests-show_indicators_time} +test_that("show_indicators_time works", { + expect_true(inherits(show_indicators_time, "function")) +}) +``` diff --git a/docs/articles/unhcr-programme.html b/docs/articles/unhcr-programme.html index 8ce0a4d..ca345d8 100644 --- a/docs/articles/unhcr-programme.html +++ b/docs/articles/unhcr-programme.html @@ -319,6 +319,14 @@

show_budget_gapshow_budget_gap(year = 2018, ctr_name = "Brazil")

+
+
+
+
+show_budget_gap(year = 2018, 
+             ctr_name = "Brazil",
+             weight_by = c("refugees", "oip"))
+

@@ -330,7 +338,7 @@

Show partnership
  • How organisations partner together?
    • -
    +
     show_partnership(year = 2022,
            ctr_name = "Brazil" ) 
    
 
@@ -411,7 +419,7 @@ 
    show_sectors
    +
     knitr::kable( iati::dataSector |> 
                 dplyr::select( sector_vocabulary_name, sector_vocabulary_description) |>
                 dplyr::distinct() |>
@@ -450,32 +458,45 @@ 
    show_sectors
    -show_sectors(year =  c(2020, 2021, 2022), 
-             ctr_name = "Brazil",
-            sector_vocabulary_name = "Reporting Organisation")
    
-
    
 
    -show_sectors(year = 2022, 
-             ctr_name = "Brazil",
-            sector_vocabulary_name = "Reporting Organisation 2")
    
-
    
+show_sectors(
+  year =  c(2020, 2021, 2022), 
+  ctr_name = "Brazil",
+  sector_vocabulary_name = "Reporting Organisation")
    
+
    
 
    -show_sectors(year = c(2020, 2021, 2022),  
-             ctr_name = "Brazil",
-            sector_vocabulary_name = "Reporting Organisation 2")
    
-
    
+show_sectors(
+  year = 2022, 
+  ctr_name = "Brazil",
+  sector_vocabulary_name = "Reporting Organisation 2")
+
    
 
    -show_sectors(year = c(2017,2018,2019,2020,2021, 2022), 
-             ctr_name = "Brazil",
-            sector_vocabulary_name = "Humanitarian Global Clusters (Inter-Agency Standing Committee)")
    
-
    
+show_sectors(
+  year = c(2020, 2021, 2022),  
+  ctr_name = "Brazil",
+  sector_vocabulary_name = "Reporting Organisation 2")
+
    
 
    -show_sectors(year = c(2017,2018,2019,2020,2021, 2022), 
-             ctr_name = "Brazil",
-            sector_vocabulary_name = "OECD DAC CRS Purpose Codes (5 digit)")
    
+show_sectors(
+  year = c(2017,2018,2019,2020,2021, 2022), 
+  ctr_name = "Brazil",
+  sector_vocabulary_name = "Humanitarian Global Clusters (Inter-Agency Standing Committee)")
+
    
+
    +show_sectors(
+  year = c(2017,2018,2019,2020,2021, 2022), 
+  ctr_name = "Brazil",
+  sector_vocabulary_name = "OECD DAC CRS Purpose Codes (5 digit)")
    
 
    
 
+
    
+
    show_sectors_rbm
+
    
+
    +show_sectors_rbm( year =  c(2017, 2018, 2019, 2020, 2021, 2022), 
+             ctr_name = "Brazil")
    
+
    
+
    
 
 
    
 
    Using iati::dataResult
@@ -487,42 +508,42 @@ 
    show_indicatorsHow much indicators relate to target or
 baseline?
 
-
    +
     show_indicators(year = 2022,  
              ctr_name = "Brazil",
               result_type_name = "Outcome",
              type = "deviation"
              )
    
 
    
-
    +
     show_indicators(year = 2022,  
              ctr_name = "Brazil",
               result_type_name = "Impact",
              type = "deviation"
              )
    
 
    
-
    +
     show_indicators(year = 2019,  
              ctr_name = "Brazil",
               result_type_name = "Output",
              type = "deviation"
              )
    
 
    
-
    +
     show_indicators(year = 2022,  
              ctr_name = "Brazil",
               result_type_name = "Outcome",
              type = "progress"
              )
    
 
    
-
    +
     show_indicators(year = 2022,  
              ctr_name = "Brazil",
               result_type_name = "Impact",
              type = "progress"
              )
    
 
    
-
    +
     show_indicators(year = 2019,  
              ctr_name = "Brazil",
               result_type_name = "Output",
@@ -530,6 +551,52 @@ 
    show_indicators             )
    
 
    
 
    
+
    
+
    show_indicators_time
+
    
+
    +show_indicators_time(year = 2020,  
+             ctr_name = "Brazil",
+              result_type_name = "Outcome",
+             type = "deviation"
+             )
    
+
    
+
    +show_indicators_time(year = 2022,  
+             ctr_name = "Brazil",
+              result_type_name = "Impact",
+             type = "deviation"
+             )
    
+
    
+
    +show_indicators_time(year = 2019,  
+             ctr_name = "Brazil",
+              result_type_name = "Output",
+             type = "deviation"
+             )
    
+
    
+
    +show_indicators_time(year = 2022,  
+             ctr_name = "Brazil",
+              result_type_name = "Outcome",
+             type = "progress"
+             )
    
+
    
+
    +show_indicators_time(year = 2022,  
+             ctr_name = "Brazil",
+              result_type_name = "Impact",
+             type = "progress"
+             )
    
+
    
+
    +show_indicators_time(year = 2019,  
+             ctr_name = "Brazil",
+              result_type_name = "Output",
+             type = "progress"
+             )
    
+
    
+
    
 
    
   
diff --git a/docs/articles/unhcr-programme_files/figure-html/example-show_budget_gap-1.png b/docs/articles/unhcr-programme_files/figure-html/example-show_budget_gap-1.png
index e251971..19eabfd 100644
Binary files a/docs/articles/unhcr-programme_files/figure-html/example-show_budget_gap-1.png and b/docs/articles/unhcr-programme_files/figure-html/example-show_budget_gap-1.png differ
diff --git a/docs/articles/unhcr-programme_files/figure-html/example-show_budget_gap-2.png b/docs/articles/unhcr-programme_files/figure-html/example-show_budget_gap-2.png
new file mode 100644
index 0000000..8c322c1
Binary files /dev/null and b/docs/articles/unhcr-programme_files/figure-html/example-show_budget_gap-2.png differ
diff --git a/docs/articles/unhcr-programme_files/figure-html/example-show_expenditure-1.png b/docs/articles/unhcr-programme_files/figure-html/example-show_expenditure-1.png
index be5ebbd..c116161 100644
Binary files a/docs/articles/unhcr-programme_files/figure-html/example-show_expenditure-1.png and b/docs/articles/unhcr-programme_files/figure-html/example-show_expenditure-1.png differ
diff --git a/docs/articles/unhcr-programme_files/figure-html/example-show_expenditure-2.png b/docs/articles/unhcr-programme_files/figure-html/example-show_expenditure-2.png
index 83751ce..8b6a594 100644
Binary files a/docs/articles/unhcr-programme_files/figure-html/example-show_expenditure-2.png and b/docs/articles/unhcr-programme_files/figure-html/example-show_expenditure-2.png differ
diff --git a/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-1.png b/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-1.png
new file mode 100644
index 0000000..589bbe2
Binary files /dev/null and b/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-1.png differ
diff --git a/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-2.png b/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-2.png
new file mode 100644
index 0000000..fbbd3ac
Binary files /dev/null and b/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-2.png differ
diff --git a/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-3.png b/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-3.png
new file mode 100644
index 0000000..c0ca049
Binary files /dev/null and b/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-3.png differ
diff --git a/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-4.png b/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-4.png
new file mode 100644
index 0000000..db6079c
Binary files /dev/null and b/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-4.png differ
diff --git a/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-5.png b/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-5.png
new file mode 100644
index 0000000..831fb04
Binary files /dev/null and b/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-5.png differ
diff --git a/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-6.png b/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-6.png
new file mode 100644
index 0000000..920467b
Binary files /dev/null and b/docs/articles/unhcr-programme_files/figure-html/example-show_indicators_time-6.png differ
diff --git a/docs/articles/unhcr-programme_files/figure-html/example-show_sectors_rbm-1.png b/docs/articles/unhcr-programme_files/figure-html/example-show_sectors_rbm-1.png
new file mode 100644
index 0000000..33e3e98
Binary files /dev/null and b/docs/articles/unhcr-programme_files/figure-html/example-show_sectors_rbm-1.png differ
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
index b574f73..ae01882 100644
--- a/docs/pkgdown.yml
+++ b/docs/pkgdown.yml
@@ -3,5 +3,5 @@ pkgdown: 2.0.7
 pkgdown_sha: ~
 articles:
   unhcr-programme: unhcr-programme.html
-last_built: 2024-02-15T23:42Z
+last_built: 2024-02-22T23:55Z
 
diff --git a/docs/reference/index.html b/docs/reference/index.html
index da21542..c6153ff 100644
--- a/docs/reference/index.html
+++ b/docs/reference/index.html
@@ -92,6 +92,11 @@ 
    Chart Libraryshow_indicators_time() 
+        
+        
    show_indicators_time
    
+      
    
+          
           show_partnership() 
         
    
         
    show_partnership
    
@@ -102,6 +107,11 @@ 
    Chart Libraryshow_sectors_rbm() 
+        
+        
    show_sectors_rbm
    
+      
    
+          
           show_top_donors() 
         
    
         
    show_top_donors
    
@@ -368,6 +378,27 @@ 
    Code
    
         
         
    codeUNSDGTargets
    
       
    
+      
    Mapping
    
+      
+      
    Mapping tables
    
+
+      
+    
    
+      
+      
+      
+
+      
    
+          
+          mapping_result 
+        
    
+        
    mapping_result
    
+      
    
+          
+          mapping_sector 
+        
    
+        
    mapping_sector
    
+      
    
       
    Reference
    
       
       
    UNHCR Geographci Referential
    
diff --git a/docs/reference/mapping_result.html b/docs/reference/mapping_result.html
new file mode 100644
index 0000000..cfd4a8d
--- /dev/null
+++ b/docs/reference/mapping_result.html
@@ -0,0 +1,97 @@
+
+mapping_result — mapping_result • iati
+    Skip to contents
+    
+
+    
    
+
    
+  
    
+      
    mapping_result
    
+      Source: R/data.R
+      
    mapping_result.Rd
    
+    
    
+
+    
    
+    
    Mapping Results to UNHCR 2022 RBM Framework
    
+    
    
+
+    
    
+    
    Usage
    
+    
    mapping_result
    
+    
    
+
+    
    
+    
    Format
    
+    
    A data frame with 107 rows and 2 variables:
    result_title
    
+
    character result_title
    
+
+  
    sector_rbm
    
+
    character sector_rbm
    
+ 
+
+
    
+    
    
+    
    Source
    
+    
    https://www.unhcr.org/what-we-do/build-better-futures/compass/
    
+    
    
+
+  
    
+
+
+    
    
+  
    Developed by Edouard Legoupil, Matheus Soldi Hardt, Hisham Galal.
    
+
    
+
+
    
+  
    Site built with pkgdown 2.0.7.
    
+
    
+
+    
    
+
+  
+
+  
+
+  
+
diff --git a/docs/reference/mapping_sector.html b/docs/reference/mapping_sector.html
new file mode 100644
index 0000000..95081b7
--- /dev/null
+++ b/docs/reference/mapping_sector.html
@@ -0,0 +1,100 @@
+
+mapping_sector — mapping_sector • iati
+    Skip to contents
+    
+
+    
    
+
    
+  
    
+      
    mapping_sector
    
+      Source: R/data.R
+      
    mapping_sector.Rd
    
+    
    
+
+    
    
+    
    Mapping Sector to UNHCR 2022 RBM Framework
    
+    
    
+
+    
    
+    
    Usage
    
+    
    mapping_sector
    
+    
    
+
+    
    
+    
    Format
    
+    
    A data frame with 83 rows and 3 variables:
    sector_desc
    
+
    character COLUMN_DESCRIPTION
    
+ 
+  
    sector_vocabulary_name
    
+
    character COLUMN_DESCRIPTION
    
+
+  
    sector_rbm
    
+
    character COLUMN_DESCRIPTION
    
+ 
+
+
    
+    
    
+    
    Source
    
+    
    https://www.unhcr.org/what-we-do/build-better-futures/compass
    
+    
    
+
+  
    
+
+
+    
    
+  
    Developed by Edouard Legoupil, Matheus Soldi Hardt, Hisham Galal.
    
+
    
+
+
    
+  
    Site built with pkgdown 2.0.7.
    
+
    
+
+    
    
+
+  
+
+  
+
+  
+
diff --git a/docs/reference/show_budget_gap-1.png b/docs/reference/show_budget_gap-1.png
index 1bbe2b0..4761da0 100644
Binary files a/docs/reference/show_budget_gap-1.png and b/docs/reference/show_budget_gap-1.png differ
diff --git a/docs/reference/show_budget_gap-2.png b/docs/reference/show_budget_gap-2.png
new file mode 100644
index 0000000..0cae30d
Binary files /dev/null and b/docs/reference/show_budget_gap-2.png differ
diff --git a/docs/reference/show_budget_gap.html b/docs/reference/show_budget_gap.html
index a4a90d9..f1b401d 100644
--- a/docs/reference/show_budget_gap.html
+++ b/docs/reference/show_budget_gap.html
@@ -1,5 +1,7 @@
 
-show_budget_gap — show_budget_gap • iatishow_budget_gap — show_budget_gap • iati
@@ -52,7 +54,8 @@
     
    
 
     
    
-    
    show_budget_gap
    
+    
    UNHCR budgets are needs-based: it represents the total amount
+of money that would be required were UNHCR to meet all of the needs that it is seeking to address.
    
     
    
 
     
    
@@ -61,7 +64,8 @@ 
    Usage
   year,
   programme_lab = NULL,
   iati_identifier_ops = NULL,
-  ctr_name = NULL
+  ctr_name = NULL,
+  weight_by = NULL
 )
    
     
    
 
@@ -82,6 +86,15 @@ 
    Arguments
+
 
    
     
    
     
    Value
    
@@ -95,6 +108,13 @@ 
    Examples
    show_budget_gap(year = 2018, 
              ctr_name = "Brazil")
 
+
+
+
+show_budget_gap(year = 2018, 
+             ctr_name = "Brazil",
+             weight_by = c("refugees", "oip"))
+