data-raw/get-sipri.R

In lajh87/sipriarmsdata: SIPRI Arms Transfer Data

url <- "https://armstrade.sipri.org/armstrade/page/values.php"
req <- httr::GET(url)

country_code <- req |>
  httr::content() |>
  xml2::xml_find_all("//select[@name = 'country_code']//option") |>
  xml2::xml_attr("value")

country_label <- req |>
  httr::content() |>
  xml2::xml_find_all("//select[@name = 'country_code']//option") |>
  xml2::xml_text()

low_year <- req |>
  httr::content() |>
  xml2::xml_find_all("//select[@name = 'low_year']//option") |>
  xml2::xml_attr("value")

high_year <- req |>
  httr::content() |>
  xml2::xml_find_all("//select[@name = 'high_year']//option") |>
  xml2::xml_attr("value")

summarize <- req |>
  httr::content() |>
  xml2::xml_find_all("//input[@name = 'summarize']") |>
  xml2::xml_attr("value")

filetype <- req |>
  httr::content() |>
  xml2::xml_find_all("//input[@name = 'filetype']") |>
  xml2::xml_attr("value")

import_or_export <- req |>
  httr::content() |>
  xml2::xml_find_all("//input[@name = 'import_or_export']") |>
  xml2::xml_attr("value")


data_map <- expand.grid(type = summarize, import_export = import_or_export,
                        ctry = country_code, stringsAsFactors = FALSE)

pb <- dplyr::progress_estimated(nrow(data_map))
sipri_raw <- purrr::pmap(data_map, function(type, import_export, ctry, ...){
  pb$tick()$print()
  x <- httr::POST(
    url = "https://armstrade.sipri.org/armstrade/html/export_values.php",
    body = list(
      import_or_export = import_export,
      summarize = type,
      low_year = min(low_year),
      high_year = max(high_year),
      country_code = ctry,
      filetype = "csv"
    )
  ) |>
    httr::content(as = "raw")

  list(type = type, import_export = import_export, ctry = ctry, raw = x)
})

saveRDS(sipri_raw, "data-raw/sipri_raw.RDS")

sipri_ctry <- dplyr::tibble(country_code, country_label)
saveRDS(sipri_ctry, "data-raw/sipri_ctry.RDS")