initial commit

.Rbuildignore

@@ -0,0 +1,3 @@
+^rsr\.Rproj$
+^\.Rproj\.user$
+^LICENSE\.md$

.gitignore

@@ -0,0 +1,4 @@
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata

DESCRIPTION

@@ -0,0 +1,31 @@
+Package: rsr
+Title: Tidy wrapper for the UNHCR Resettlement Statistics Report application
+Version: 0.0.0.9000
+Authors@R: 
+    person(given = "Hisham",
+           family = "Galal",
+           role = c("aut", "cre"),
+           email = "[email protected]")
+Description: Retrieve & tidy data from the UNHCR Resettlement Statistics Report application https://rsr.unhcr.org/.
+License: MIT + file LICENSE
+Encoding: UTF-8
+LazyData: true
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.1.1
+Depends: R (>= 4.1.0)
+Imports: 
+    cachem,
+    chromote,
+    dplyr,
+    fs,
+    httr,
+    lubridate,
+    memoise,
+    purrr,
+    rappdirs,
+    readr,
+    readxl,
+    rvest,
+    stringr,
+    tidyr,
+    tidyselect

LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2021
+COPYRIGHT HOLDER: rsr authors

LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2021 rsr authors
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

@@ -0,0 +1,39 @@
+# Generated by roxygen2: do not edit by hand
+
+export(rsr_demographics)
+export(rsr_departures)
+export(rsr_indicators)
+export(rsr_login)
+export(rsr_submissions)
+importFrom(dplyr,filter)
+importFrom(dplyr,if_else)
+importFrom(dplyr,mutate)
+importFrom(dplyr,rename)
+importFrom(dplyr,rename_with)
+importFrom(dplyr,select)
+importFrom(dplyr,slice)
+importFrom(httr,set_cookies)
+importFrom(httr,write_disk)
+importFrom(lubridate,make_date)
+importFrom(lubridate,rollforward)
+importFrom(purrr,discard)
+importFrom(purrr,keep)
+importFrom(purrr,modify_if)
+importFrom(purrr,pluck)
+importFrom(readr,parse_number)
+importFrom(readxl,read_excel)
+importFrom(rvest,html_attr)
+importFrom(rvest,html_form)
+importFrom(rvest,html_form_set)
+importFrom(rvest,html_nodes)
+importFrom(rvest,html_text)
+importFrom(rvest,session)
+importFrom(rvest,session_jump_to)
+importFrom(rvest,session_submit)
+importFrom(stringr,str_c)
+importFrom(stringr,str_detect)
+importFrom(stringr,str_to_sentence)
+importFrom(tidyr,fill)
+importFrom(tidyr,pivot_longer)
+importFrom(tidyselect,contains)
+importFrom(tidyselect,last_col)

R/access.R

@@ -0,0 +1,28 @@
+#' Interactive login to the RSR application
+#'
+#' Interactive login to the RSR application
+#'
+#' @importFrom purrr discard
+#' @export
+rsr_login <- function() {
+  cookiejar <- fs::path(fs::dir_create(rappdirs::app_dir("rsr", "unhcr")$cache()), "cookies.rds")
+  b <- chromote::ChromoteSession$new()
+  b$Page$navigate("https://rsr.unhcr.org/connect/azure")
+  b$view()
+  readline("Hit [RETURN] to continue when you've logged in.")
+  cookies <- b$Network$getAllCookies()
+  b$close()
+  cookies$cookies |> discard(~.$domain == "rsr.unhcr.org") |> saveRDS(cookiejar)
+}
+
+#' @importFrom purrr keep pluck
+#' @noRd
+get_sessionid <- function() {
+  cookiejar <- fs::path(rappdirs::app_dir("rsr", "unhcr")$cache(), "cookies.rds")
+  b <- chromote::ChromoteSession$new()
+  b$Network$setCookies(cookies = readRDS(cookiejar))
+  b$Page$navigate("https://rsr.unhcr.org/connect/azure")
+  cookies <- b$Network$getAllCookies()
+  b$close()
+  cookies$cookies |> keep(~.$name == "PHPSESSID") |> pluck(1, "value")
+}

R/rsr.R

@@ -0,0 +1,129 @@
+#' @importFrom rvest session html_form html_form_set session_submit html_nodes html_text html_attr session_jump_to
+#' @importFrom httr set_cookies write_disk
+#' @importFrom purrr keep discard
+#' @importFrom stringr str_detect str_to_sentence
+#' @noRd
+rsr <- function(bureau, year, month, table) {
+  r <- session("https://rsr.unhcr.org/report", set_cookies(PHPSESSID = get_sessionid()))
+  f <-
+    html_form(r)[[1]] |>
+    html_form_set("grid_a75b200afdb00bcdb06040d2d98029bd[year][from][]" = year-2017+1,
+                  "grid_a75b200afdb00bcdb06040d2d98029bd[month][from][]" = month)
+  r <- r |> session_submit(f, submit = 1)
+  t <- r |> html_nodes("tr") |> keep(~str_detect(html_text(.), bureau))
+  a <- t |> html_nodes("a") |> keep(~str_detect(html_text(.), str_to_sentence(table)))
+  f <- fs::file_temp(ext = "xls")
+  r |> session_jump_to(html_attr(a, "href"), write_disk(f, overwrite = TRUE))
+  f
+}
+
+#' Summary reports
+#'
+#' Departure summary
+#'
+#' @param bureau UNHCR bureau name as it appears in the RSR application (string)
+#' @param year Year (numeric)
+#' @param month Month (numeric)
+#'
+#' @return A tibble
+#'
+#' @importFrom readxl read_excel
+#' @importFrom dplyr select rename slice mutate filter
+#' @importFrom tidyr pivot_longer fill
+#' @importFrom tidyselect contains
+#' @importFrom lubridate make_date rollforward
+#'
+#' @rdname rsr
+#' @export
+rsr_departures <- function(bureau, year, month) {
+  rsr(bureau, year, month, "departure") |>
+    (\(x) suppressMessages(read_excel(x, skip = 5)))() |>
+    select(-contains("Total")) |>
+    rename(asof = ...1, coa = ...2, coo = ...4) |>
+    slice(-1) |>
+    pivot_longer(-c(asof, coa, coo), names_to = "cor", values_to = "n") |>
+    mutate(n = parse_number(n)) |>
+    fill(asof, coa) |>
+    filter(asof != "Total", !is.na(n)) |>
+    mutate(asof = rollforward(make_date(year, month)))
+}
+
+#' Submission summary
+#'
+#' Submission summary
+#'
+#' @importFrom readxl read_excel
+#' @importFrom dplyr select rename rename_with slice mutate filter
+#' @importFrom tidyr pivot_longer fill
+#' @importFrom tidyselect last_col
+#' @importFrom stringr str_c str_detect
+#' @importFrom purrr modify_if
+#' @importFrom readr parse_number
+#' @importFrom lubridate make_date rollforward
+#'
+#' @rdname rsr
+#' @export
+rsr_submissions <- function(bureau, year, month) {
+  rsr(bureau, year, month, "submission") |>
+    (\(x) suppressMessages(read_excel(x, skip = 5)))() |>
+    select(-c(3, 4, last_col(), last_col(1))) |>
+    rename(asof = ...1, coa = ...2, coo = ...5) |>
+    (\(x) rename_with(x, ~str_c(., as.character(x[1,.]), sep = "-"), -c(asof, coa, coo)))() |>
+    slice(-1) |>
+    pivot_longer(-c(asof, coa, coo), names_to = c("cor", "unit"), names_pattern = "(.+)-(.+)", values_to = "n") |>
+    mutate(cor = modify_if(cor, ~str_detect(., "\\d"), ~NA_character_),
+           n = parse_number(n)) |>
+    fill(asof, coa, cor) |>
+    filter(asof != "Total", !is.na(n)) |>
+    mutate(asof = rollforward(make_date(year, month)))
+}
+
+#' Indicators summary
+#'
+#' Indicators summary
+#'
+#' @importFrom readxl read_excel
+#' @importFrom dplyr rename rename_with slice mutate filter
+#' @importFrom tidyr pivot_longer fill
+#' @importFrom stringr str_c
+#' @importFrom lubridate make_date rollforward
+#'
+#' @rdname rsr
+#' @export
+rsr_indicators <- function(bureau, year, month) {
+  rsr(bureau, year, month, "indicators") |>
+    (\(x) suppressMessages(read_excel(x, skip = 5)))() |>
+    rename(asof = ...1, coa = ...2, coo = ...3) |>
+    (\(x) rename_with(x, ~str_c(., as.character(x[1,.]), sep = "-"), -c(asof, coa, coo)))() |>
+    slice(-1) |>
+    pivot_longer(-c(asof, coa, coo), names_to = c("ind", "unit"), names_pattern = "(.+)-(.+)", values_to = "n") |>
+    mutate(ind = modify_if(ind, ~str_detect(., "\\d"), ~NA_character_),
+           n = parse_number(n)) |>
+    fill(asof, coa, ind) |>
+    filter(asof != "Total") |>
+    mutate(asof = rollforward(make_date(year, month)))
+}
+
+#' Demographics summary
+#'
+#' Demographics summary
+#'
+#' @importFrom readxl read_excel
+#' @importFrom dplyr select rename mutate filter if_else
+#' @importFrom tidyr pivot_longer fill
+#' @importFrom tidyselect contains
+#' @importFrom lubridate make_date rollforward
+#'
+#' @rdname rsr
+#' @export
+rsr_demographics <- function(bureau, year, month) {
+  rsr(bureau, year, month, "demographics") |>
+    (\(x) suppressMessages(read_excel(x, skip = 5)))() |>
+    select(-contains("Total")) |>
+    rename(asof = `Data as of`, coa = COA, coo = COO, cor = COR) |>
+    pivot_longer(-c(asof, coa, coo, cor), names_to = c("sex", "age"), names_pattern = "(M|F|Other) ?(.*)", values_to = "n") |>
+    mutate(age = if_else(sex == "Other", "Unk", age)) |>
+    fill(asof, coa) |>
+    filter(asof != "Total", !is.na(n)) |>
+    mutate(asof = rollforward(make_date(year, month)))
+}

R/zzz.R

@@ -0,0 +1,5 @@
+#' @noRd
+.onLoad <- function(libname, pkgname) {
+  get_sessionid <<- memoise::memoise(get_sessionid, cache = cachem::cache_mem(max_age = 30*60))
+  rsr <<- memoise::memoise(rsr)
+}

README.md

@@ -1,2 +1,30 @@
 # rsr
-Retrieve & tidy data from the UNHCR Resettlement Statistics Report application
+Retrieve & tidy data from the [UNHCR Resettlement Statistics Report application](https://rsr.unhcr.org).
+
+### Installation
+
+    remotes::install_github("galalH/rsr")
+
+### Usage
+
+    library(rsr)
+
+The first time you install the package, you need to call `rsr_login()` to initialize your access credentials. `rsr` uses the [`chromote`](https://github.com/rstudio/chromote) package to launch a new tab in any chromium-based browser on your system where you should login to your UNHCR account as usual before returning to your R session and hitting return to continue. This process needs to be done only once after installation, then again any time you update your UNHCR access credentials. See the excellent documentation from sister-package [popdata](https://github.com/PopulationStatistics/popdata/#using-the-popdata-package) for more details on how this works.
+
+Once everything is up and running, you can use any of the convenience functions in the package to access a tidy version of the data from the summary reports produced by the system.
+
+     > rsr_submissions(bureau = "The Americas", year = 2020, month = 5)
+     # A tibble: 102 x 6
+       asof       coa   coo   cor   unit      n
+       <date>     <chr> <chr> <chr> <chr> <dbl>
+     1 2020-05-31 CUB   AFG   AUL   C         2
+     2 2020-05-31 CUB   AFG   AUL   P         2
+     3 2020-05-31 CUB   AFG   FRA   C         2
+     4 2020-05-31 CUB   AFG   FRA   P         6
+     5 2020-05-31 CUB   AFG   NET   C         0
+     6 2020-05-31 CUB   AFG   NET   P         0
+     7 2020-05-31 CUB   AFG   NZL   C         2
+     8 2020-05-31 CUB   AFG   NZL   P         2
+     9 2020-05-31 CUB   AFG   SWE   C         0
+    10 2020-05-31 CUB   AFG   SWE   P         0
+    # ... with 92 more rows