R/plot_reg_origin_dest.R

Defines functions plot_reg_origin_dest

Documented in plot_reg_origin_dest

# WARNING - Generated by {fusen} from /dev/dev_plot_Region.Rmd: do not edit by hand

#' Plot Population Origin-Destination within the region 
#' 
#' Chord diagram showing Origin destination see - https://jokergoo.github.io/circlize_book/book/
#' 

#' @param year Numeric value of the year (for instance 2020)
#' @param region Character value with the related UNHCR bureau - when left null, it will display the whole world
#' 
#' @importFrom ggplot2  ggplot  aes  coord_flip   element_blank element_line
#'             element_text expansion geom_bar geom_col geom_hline unit stat_summary
#'             geom_label geom_text labs  position_stack  scale_color_manual scale_colour_manual 
#'             geom_text
#'             scale_fill_manual scale_x_continuous scale_x_discrete  scale_y_continuous   sym theme 
#' @importFrom dplyr  desc select  case_when lag mutate group_by filter summarise ungroup
#'               pull distinct n arrange across slice left_join summarize
#'               
#' @importFrom tidyr replace_na
#' @importFrom graphics title 
#' @importFrom circlize chordDiagram circos.track circos.text CELL_META
#' @importFrom unhcrthemes theme_unhcr
#' 
#' @return plot a ggplot2 object 
#' 
#' @export
#' @examples
#' plot_reg_origin_dest(year = 2022,  region = "Asia")
plot_reg_origin_dest <- function(year = 2022,  region = "Americas"){
   


chords <- ForcedDisplacementStat::end_year_population_totals |>
  dplyr::left_join( ForcedDisplacementStat::reference |> 
                      dplyr::select(coa_region = `UNHCRBureau`, iso_3),  by = c("CountryAsylumCode" = "iso_3")) |> 
  dplyr::filter(coa_region == region &
           Year == year) |> 
  dplyr::mutate(across(REF:OIP, ~ tidyr::replace_na(as.numeric(.), 0)),
         total = REF + ASY + OIP, #+ IDP  + STA + OOC,
         # Lump together factor levels into "other"
         CountryAsylumName = forcats::fct_lump_prop(CountryAsylumName, prop = .02, w = total),
         CountryOriginName = forcats::fct_lump_prop(CountryOriginName, prop = .02, w = total)) |> 
   dplyr::group_by(CountryOriginName, CountryAsylumName) |>
   dplyr::summarize(total = sum(total), .groups = "drop")  |>
# CountryOriginName = fct_recode(CountryOriginName, "Other" = "China")
  dplyr::mutate(CountryOriginName = stringr::str_replace(CountryOriginName, " \\(Bolivarian Republic of\\)", ""),
        CountryAsylumName = stringr::str_replace(CountryAsylumName, " \\(Bolivarian Republic of\\)", ""),
        CountryOriginName = stringr::str_replace(CountryOriginName, " \\(Plurinational State of\\)", ""),
        CountryAsylumName = stringr::str_replace(CountryAsylumName, " \\(Plurinational State of\\)", ""),
        CountryOriginName = stringr::str_replace(CountryOriginName, "United States of America", "USA"),
        CountryAsylumName = stringr::str_replace(CountryAsylumName, "United States of America", "USA"))

circlize::chordDiagram(chords,
                       self.link = 1,
                      # grid.col = colorRampPalette(RColorBrewer::brewer.pal(11, "Paired"))(15),
                       annotationTrack = "grid" ,
                     # preAllocateTracks = list(track.height = max(strwidth(unlist(dimnames(chords))))),
                      preAllocateTracks = 1.6
)

circlize::circos.track(track.index = 1,
                        panel.fun = function(x, y) {
                             circlize::circos.text(circlize::CELL_META$xcenter,
                                                   circlize::CELL_META$ylim[1],
                                                   circlize::CELL_META$sector.index,
                                                   facing = "clockwise",
                                                   niceFacing = TRUE,
                                                   adj = c(0, 0.5))
                           },
                           bg.border = NA) # here set bg.border to NA is important


title(main = "Movement of Forcibly Displaced Population", 
      sub = paste0("In ", region, " as of ", year),
      cex.main = 1.5)

  
     return(invisible(NULL))
  
    
}
Edouard-Legoupil/unhcrdatapackage documentation built on Nov. 6, 2023, 6:10 p.m.