Merge pull request #9 from eduaguilera/catalin/balance-bilateral-trade

Optimize bilateral trade and allow public link downloads

Author: lbm364dl

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

@@ -15,21 +15,18 @@ jobs:
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
       R_KEEP_PKG_SOURCE: yes
-      GOOGLE_CLOUD_KEY: ${{ secrets.GOOGLE_CLOUD_KEY }}
     steps:
       - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-pandoc@v2
 
       - uses: r-lib/actions/setup-r@v2
         with:
+          r-version: 'renv'
           use-public-rspm: true
 
       - uses: r-lib/actions/setup-renv@v2
 
-      - name: Set googlesheets4 token
-        run: echo "$GOOGLE_CLOUD_KEY" > ${{ github.workspace }}/inst/google_cloud_key.json
-
       - uses: r-lib/actions/check-r-package@v2
         with:
           upload-snapshots: true

.github/workflows/pkgdown.yaml

@@ -21,7 +21,6 @@ jobs:
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
       R_KEEP_PKG_SOURCE: yes
-      GOOGLE_CLOUD_KEY: ${{ secrets.GOOGLE_CLOUD_KEY }}
     permissions:
       contents: write
     steps:
@@ -35,9 +34,6 @@ jobs:
 
       - uses: r-lib/actions/setup-renv@v2
 
-      - name: Set googlesheets4 token
-        run: echo "$GOOGLE_CLOUD_KEY" > ${{ github.workspace }}/inst/google_cloud_key.json
-
       - name: Install package
         run: devtools::install()
         shell: Rscript {0}

DESCRIPTION

@@ -9,6 +9,7 @@ Imports:
     dplyr,
     FAOSTAT,
     googledrive,
+    httr2,
     mipfp,
     purrr,
     readr,

R/bilateral_trade.R

@@ -109,27 +109,28 @@ get_bilateral_trade <- function(file_path) {
     get_wide_cbs() |>
     dplyr::select(year, item, area_code, export, import)
 
-  btd <-
-    file_path |>
+  btd <- file_path |>
     readr::read_csv(show_col_types = FALSE) |>
     .clean_bilateral_trade()
 
   codes <- .get_all_country_codes(btd, cbs)
 
   btd |>
-    .build_trade_matrices(cbs, codes) |>
-    .fill_all_missing_trade(cbs) |>
-    .balance_matrices() |>
+    .nest_by_year_item(cbs, codes) |>
+    .process_bilateral_trade(codes) |>
     dplyr::select(-total_trade)
 }
 
-.balance_matrices <- function(btd) {
+.process_bilateral_trade <- function(btd, codes) {
   btd |>
     dplyr::mutate(
       bilateral_trade = purrr::map2(
         bilateral_trade,
         total_trade,
-        .balance_matrix
+        ~ .x |>
+          .build_trade_matrix(codes) |>
+          .fill_missing_trade(.y) |>
+          .balance_matrix(.y)
       )
     )
 }
@@ -180,6 +181,7 @@ get_bilateral_trade <- function(file_path) {
       unit = ifelse(unit == "Head", "heads", unit),
       from_code = ifelse(element == "Export", area_code, area_code_p),
       to_code = ifelse(element == "Export", area_code_p, area_code),
+      dplyr::across(c(year, from_code, to_code), as.integer)
     ) |>
     .prefer_flow_direction("Export") |>
     dplyr::select(year, from_code, to_code, item, unit, value)
@@ -199,17 +201,6 @@ get_bilateral_trade <- function(file_path) {
     dplyr::bind_rows(preferred_direction)
 }
 
-.fill_all_missing_trade <- function(btd, cbs) {
-  btd |>
-    dplyr::mutate(
-      bilateral_trade = purrr::map2(
-        bilateral_trade,
-        total_trade,
-        .fill_missing_trade
-      )
-    )
-}
-
 .fill_missing_trade <- function(trade_matrix, total_trade) {
   exports <- total_trade |>
     dplyr::pull(export)
@@ -249,47 +240,49 @@ get_bilateral_trade <- function(file_path) {
   }
 }
 
-.build_trade_matrices <- function(btd, cbs, codes) {
+.nest_by_year_item <- function(btd, cbs, codes) {
+  cbs <- cbs |>
+    dplyr::mutate(area_code = factor(area_code, levels = codes))
+
   btd |>
     dplyr::filter(unit == "tonnes") |>
     dplyr::select(-unit) |>
+    dplyr::mutate(
+      from_code = factor(from_code, levels = codes),
+      to_code = factor(to_code, levels = codes),
+    ) |>
     .filter_only_items_in_cbs(cbs) |>
     tidyr::nest(
       bilateral_trade = c(from_code, to_code, value),
       .by = c(year, item)
     ) |>
-    dplyr::left_join(.get_nested_cbs(cbs, codes), c("year", "item")) |>
-    dplyr::mutate(
-      bilateral_trade = purrr::map(
-        bilateral_trade,
-        ~ .build_trade_matrix(.x, codes)
-      )
-    )
+    dplyr::left_join(.get_nested_cbs(cbs, codes), c("year", "item"))
 }
 
 .get_nested_cbs <- function(cbs, codes) {
   cbs |>
+    dplyr::mutate(item = as.factor(item)) |>
+    .complete_total_trade(codes) |>
+    dplyr::group_by(year, item) |>
+    .balance_total_trade() |>
+    dplyr::ungroup() |>
     tidyr::nest(
-      total_trade = c(area_code, export, import),
+      total_trade = c(
+        area_code, export, import, balanced_export, balanced_import
+      ),
       .by = c(year, item)
-    ) |>
-    dplyr::mutate(
-      total_trade = purrr::map(
-        total_trade,
-        ~ .x |>
-          .complete_total_trade(codes) |>
-          .balance_total_trade()
-      )
     )
 }
 
 .complete_total_trade <- function(total_trade, codes) {
+  df_codes <- tibble::tibble(area_code = codes)
+  combs <- total_trade |>
+    dplyr::distinct(year, item) |>
+    dplyr::cross_join(df_codes)
+
   total_trade |>
-    tidyr::complete(
-      area_code = codes,
-      fill = list(export = 0, import = 0)
-    ) |>
-    dplyr::arrange(area_code)
+    dplyr::right_join(combs, by = c("year", "item", "area_code")) |>
+    tidyr::replace_na(list(export = 0, import = 0))
 }
 
 .filter_only_items_in_cbs <- function(btd, cbs) {
@@ -317,13 +310,18 @@ get_bilateral_trade <- function(file_path) {
     dplyr::pull(cbs, area_code)
   ) |>
     unique() |>
-    sort()
+    sort() |>
+    as.factor()
 }
 
 .build_trade_matrix <- function(btd, codes) {
   btd |>
-    tidyr::complete(from_code = codes, to_code = codes) |>
-    tidyr::pivot_wider(names_from = to_code, values_from = value) |>
+    tidyr::pivot_wider(
+      names_from = to_code,
+      values_from = value,
+      names_expand = TRUE
+    ) |>
+    tidyr::complete(from_code = codes) |>
     tibble::column_to_rownames(var = "from_code") |>
     as.matrix()
 }

R/commodity_balance_sheet.R

@@ -54,7 +54,11 @@ get_wide_cbs <- function(file_path) {
     readr::read_csv(show_col_types = FALSE) |>
     tidyr::pivot_wider(names_from = Element, values_from = Value) |>
     dplyr::rename_with(tolower) |>
-    dplyr::mutate(stock_retrieval = -stock_variation, .keep = "unused")
+    dplyr::mutate(
+      stock_retrieval = -stock_variation,
+      dplyr::across(c(year, area_code), as.integer),
+      .keep = "unused"
+    )
 }
 
 #' Processed products share factors

R/input_files.R

@@ -2,8 +2,7 @@
 #'
 #' @description
 #' If the requested file doesn't exist locally, it is downloaded from a public
-#' Google Drive link and stored in a cache directory obtained using
-#' `tools::R_user_dir`.
+#' link and stored in a cache directory obtained using `tools::R_user_dir`.
 #'
 #' @param file_alias Alias of the requested file. For now the possible
 #'    values are:
@@ -47,13 +46,13 @@ get_file_path <- function(file_alias, force_download = FALSE) {
   tryCatch(
     {
       message(stringr::str_glue("Downloading {file_info$alias}..."))
-      .download_from_drive(file_info$drive_file_id, destfile)
+      .download_from_somewhere(file_info, destfile)
     },
     error = function(cond) {
       if (file.exists(destfile)) {
         file.remove(destfile)
       }
-      stop("File was not downloaded correctly. Try again.")
+      stop(cond)
     }
   )
   destfile
@@ -70,6 +69,21 @@ get_file_path <- function(file_alias, force_download = FALSE) {
   )
 }
 
+.download_from_somewhere <- function(file_info, destfile) {
+  if (!is.na(file_info$drive_file_id)) {
+    .download_from_drive(file_info$drive_file_id, destfile)
+  } else {
+    .download_from_any_url(file_info$file_url, destfile)
+  }
+}
+
+.download_from_any_url <- function(file_url, destfile) {
+  file_url |>
+    httr2::request() |>
+    httr2::req_progress() |>
+    httr2::req_perform(destfile)
+}
+
 .download_from_drive <- function(drive_file_id, destfile) {
   googledrive::drive_deauth()
   googledrive::drive_download(

inst/extdata/input/raw/input_files.csv

@@ -1,4 +1,5 @@
-extension,alias,drive_file_id
-csv,commodity_balance_sheet,1N6N4DI3PDowKvWwreFbcSe3YwYjV24k9
-csv,bilateral_trade,1WzMpkBzou8sCJZg1SWh-Z-6iwsrVoWtw
-csv,processing_coefs,1VrZ8rJxMcFZfw5PBjnEHYiTRa3usWb0H
+extension,alias,drive_file_id,file_url
+csv,commodity_balance_sheet,,"https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Sources%20(proposed%20by%20alvaro)/Model%20inputs/New%20FABIO/commodity_balance_sheet.csv"
+csv,bilateral_trade,,"https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Sources%20(proposed%20by%20alvaro)/Model%20inputs/New%20FABIO/bilateral_trade.csv"
+csv,processing_coefs,,"https://saco.csic.es/public.php/dav/files/nrJ3JGPZyZeQMW8/Sources%20(proposed%20by%20alvaro)/Model%20inputs/New%20FABIO/processing_coefs.csv"
+csv,example_cbs_drive,1N6N4DI3PDowKvWwreFbcSe3YwYjV24k9,