Merge pull request #3 from mapme-initiative/main

update

Author: fBedecarrats

.Rbuildignore

@@ -34,3 +34,4 @@ vignettes/assets
 ^cran-comments\.md$
 ^CRAN-SUBMISSION$
 ^data-raw$
+^extras$

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mapme.biodiversity
 Title: Efficient Monitoring of Global Biodiversity Portfolios
-Version: 0.9.5
+Version: 0.9.5.9000
 Authors@R: c(person(given = "Darius A.", 
                     family = "G\u00F6rgen", 
                     role = "aut",

NAMESPACE

@@ -103,7 +103,6 @@ importFrom(httr2,req_perform)
 importFrom(httr2,req_retry)
 importFrom(httr2,request)
 importFrom(httr2,resp_body_json)
-importFrom(httr2,resp_check_status)
 importFrom(httr2,resp_status)
 importFrom(magrittr,"%>%")
 importFrom(stats,sd)

NEWS.md

@@ -1,3 +1,10 @@
+# mapme.biodiversity 0.9.5.9000
+
+## General
+
+-   modified `get_acled()` to align with the new ACLED API version ([440](https://github.com/mapme-initiative/mapme.biodiversity/issues/440))
+-   updated tests related to ACLED resource to reflect the changes in the `get_acled()` function
+
 # mapme.biodiversity 0.9.5
 
 ## General

R/calc_biodiversity_intactness_index.R

@@ -57,7 +57,7 @@ calc_biodiversity_intactness_index <- function() {
     mean_bii <- exactextractr::exact_extract(biodiversity_intactness_index, x, fun = "mean")
 
     results <- tibble::tibble(
-      datetime = as.POSIXct("2005-01-01T00:00:00Z"),
+      datetime = as.POSIXct("2015-01-01T00:00:00Z"),
       variable = "biodiversity_intactness_index",
       unit = "unitless",
       value = mean_bii

R/calc_exposed_population_acled.R

@@ -145,7 +145,7 @@
 #'       get_worldpop(years = 2000)
 #'     ) %>%
 #'     calc_indicators(
-#'       conflict_exposure_acled(
+#'       calc_exposed_population_acled(
 #'         distance = 5000,
 #'         years = 2000,
 #'         precision_location = 1,
@@ -207,7 +207,7 @@ calc_exposed_population_acled <- function(
     }
   }
 
-  years <- check_available_years(years, c(1997:2024), "exposed_population_acled")
+  years <- check_available_years(years, c(1997:as.integer(format(Sys.Date(), "%Y"))), "exposed_population_acled")
 
   function(x,
            acled = NULL,

R/calc_fatalities_acled.R

@@ -89,7 +89,7 @@ calc_fatalities_acled <- function(
     stratum = c("event_type", "sub_event_type", "disorder_type"),
     precision_location = 1,
     precision_time = 1) {
-  years <- check_available_years(years, c(1997:2024), "acled")
+  years <- check_available_years(years, c(1997:as.integer(format(Sys.Date(), "%Y"))), "acled")
   stratum <- match.arg(stratum)
 
   if (!precision_location %in% 1:3) {

R/get_acled.R

@@ -8,15 +8,19 @@
 #' test conflict scenarios, and makes both data and analysis open for free use
 #' by the public.*
 #'
-#' In order to access data from the ACLED API, you first must register an
-#' an account. Note, that the ACLED API used here provides a *living database*
+#' In order to access data from the ACLED API, you first must register
+#' an account. Make sure you register with your institutional domain
+#' (e.g., organization, university, or company) email address rather than
+#' your personal email address, in order to be able to use the API,
+#' as explained [here](https://acleddata.com/myacled-faqs).
+#' Note that the ACLED API provides a *living database*
 #' with single events being altered or removed altogether over time.
 #'
 #' @name acled
 #' @param years A numeric vector specifying the years for which to make
-#'   ACLED data available (between 1997 and today). Defaults to 2000.
-#' @param key ACLED API key obtained by registering with ACLED (see Details).
+#'   ACLED data available (between 1997 and today).
 #' @param email Email addressed used to register with ACLED (see Details).
+#' @param password Password used to register with ACLED (see Details).
 #' @param accept_terms A logical indicating if you agree to abide by ACLED's terms
 #'   of use. Defaults to FALSE, thus must be manually set to TRUE.
 #' @keywords resource
@@ -27,115 +31,129 @@
 #'   \doi{doi:10.1057/s41599-023-01559-4}
 #' @source Armed Conflict Location & Event Data Project (ACLED).
 #' @include register.R
-#' @importFrom httr2 request req_perform resp_check_status resp_body_json
+#' @importFrom httr2 request req_perform resp_body_json
 #' @export
 get_acled <- function(
-    years = 2000,
-    key = Sys.getenv("ACLED_ACCESS_KEY"),
-    email = Sys.getenv("ACLED_ACCESS_EMAIL"),
+    years,
+    email = Sys.getenv("ACLED_EMAIL"),
+    password = Sys.getenv("ACLED_PASSWORD"),
     accept_terms = FALSE) {
+  # check input arguments
   if (!accept_terms) {
-    msg <- "Please read and agree to ACLED's Terms of Use here:\nhttps://acleddata.com/terms-of-use/"
+    msg <- "Please read and agree to ACLED's Terms of Use here:\nhttps://acleddata.com/terms-and-conditions"
     stop(msg)
   } else {
-    msg <- "You agreed to abide to ACLED's Terms of Use (https://acleddata.com/terms-of-use/)."
-    message(msg)
+    if (isTRUE(mapme_options()[["verbose"]])) {
+      msg <- "You agreed to abide to ACLED's Terms of Use (https://acleddata.com/terms-and-conditions)."
+      message(msg)
+    }
   }
-
   if (is.null(email) | email == "") {
     msg <- "Please specify your email registered with ACLED."
     stop(msg)
   }
-
-  if (is.null(key) | key == "") {
-    msg <- "Please specify your API key registered with ACLED."
+  if (is.null(password) | password == "") {
+    msg <- "Please specify your password registered with ACLED."
     stop(msg)
   }
-
-  years <- check_available_years(years, 1997:2024)
+  years <- check_available_years(years, 1997:as.integer(format(Sys.Date(), "%Y")))
 
   function(x,
            name = "acled",
            type = "vector",
            outdir = mapme_options()[["outdir"]],
            verbose = mapme_options()[["verbose"]]) {
+    # token authorization url
+    .token_url <- "https://acleddata.com/oauth/token"
     acled_yearly <- purrr::map_chr(years, function(year) {
       filename <- sprintf("acled_events_%s.gpkg", year)
-
+      # make full path to output file
       if (is.null(outdir)) {
         filename <- file.path(tempdir(), filename)
       } else {
         filename <- file.path(outdir, filename)
       }
-
+      # if already available just return the file name
       if (spds_exists(filename)) {
         return(filename)
       }
-
-      base_url <- .prep_acled_url(key, email, year)
+      # start building the request
+      base_url <- "https://acleddata.com/api/acled/read"
+      req <- httr2::request(base_url)
+      # add year as query parameter
+      req <- httr2::req_url_query(req, year = year)
+      # authenticate the request
+      req <- httr2::req_oauth_password(
+        req,
+        client = httr2::oauth_client("acled", .token_url),
+        username = email,
+        password = password
+      )
+      # prepare for page iteration
       next_page <- TRUE
       page <- 1
-      data <- NULL
-
+      data_lst <- NULL
+      running_count <- 0L
+      # iterate pages
       while (next_page) {
-        page_url <- paste0(base_url, sprintf("&page=%s", page))
-
-        req <- request(page_url)
-        rsp <- req_perform(req)
-        resp_check_status(rsp)
-        cnt <- resp_body_json(rsp)
-
-        if (cnt$status != 200) {
-          stop("ACLED API query failed with message:\n", cnt$error$message)
-        }
-
-        if (cnt$count == 0) {
+        req <- httr2::req_url_query(req, page = page)
+        resp <- httr2::req_perform(req)
+        cnt <- httr2::resp_body_json(resp, simplifyVector = TRUE, flatten = TRUE)
+        # check if we still have some data
+        count <- cnt$count
+        if (count == 0L) {
           next_page <- FALSE
           next
         }
-
-        events <- purrr::map(cnt$data, function(y) as.data.frame(y))
-        events <- purrr::list_rbind(events)
-        events <- st_as_sf(events,
-          coords = c("longitude", "latitude"),
-          crs = st_crs("EPSG:4326")
-        )
-
+        # increment running count
+        running_count <- running_count + count
+        # get data as data.frame
+        events <- cnt$data
+        # store events data.frame in list
         if (page == 1) {
-          data <- list(events)
+          data_lst <- list(events)
+          total_count <- cnt$total_count
         } else {
-          data[[page]] <- events
+          data_lst[[page]] <- events
         }
-
+        # increment page number
         page <- page + 1
       }
-
-      if (is.null(data)) {
+      # check everything OK
+      if (running_count != total_count) {
+        msg <- sprintf("ACLED API returned only %d events out of %d.", running_count, total_count)
+        stop(msg)
+      }
+      if (is.null(data_lst)) {
         stop("ACLED API returned 0 events.")
       }
-
-      data <- st_sf(tibble::as_tibble(purrr::list_rbind(data)))
-      write_sf(data, filename)
+      # rbind list into global data.frame
+      data <- purrr::list_rbind(data_lst)
+      # convert to sf object
+      data <- sf::st_as_sf(data,
+                           coords = c("longitude", "latitude"),
+                           crs = sf::st_crs("EPSG:4326"))
+      # convert all non-geometry columns to character to be compatible with previous version
+      # temporarily extract geometry
+      geom <- sf::st_geometry(data)
+      # convert non-geometry columns
+      data_df <- sf::st_drop_geometry(data)
+      data_df[] <- lapply(data_df, as.character)
+      # reattach geometry
+      data <- sf::st_sf(data_df, geom)
+      # write the file and return file name
+      sf::write_sf(data, filename)
       return(filename)
     })
-
+    # make footprint
     bbox <- c(xmin = -180.0, ymin = -90.0, xmax = 180.0, ymax = 90.0)
-    fps <- st_as_sfc(st_bbox(bbox, crs = "EPSG:4326"))
-    fps <- st_as_sf(rep(fps, length(acled_yearly)))
+    fps <- sf::st_as_sfc(sf::st_bbox(bbox, crs = "EPSG:4326"))
+    fps <- sf::st_as_sf(rep(fps, length(acled_yearly)))
     fps[["source"]] <- acled_yearly
     fps <- make_footprints(fps, what = "vector")
   }
 }
 
-.prep_acled_url <- function(key, email, year) {
-  url <- "https://api.acleddata.com/acled/read?"
-  url <- paste0(url, "terms=accept")
-  url <- paste0(url, "&key=", key)
-  url <- paste0(url, "&email=", email)
-  url <- paste0(url, "&year=", year)
-  url
-}
-
 register_resource(
   name = "acled",
   description = "Armed Conflict Location & Event Data (ACLED)",

R/get_key_biodiversity_areas.R

@@ -20,7 +20,7 @@
 #'   Rainforest Trust, Royal Society for the Protection of Birds, Wildlife
 #'   Conservation Society and World Wildlife Fund. Available at
 #'   www.keybiodiversityareas.org.
-#' @source \url{https://www.keybiodiversityareas.org/kba-data}
+#' @source \url{https://www.keybiodiversityareas.org/request-gis-data}
 #' @include register.R
 #' @export
 get_key_biodiversity_areas <- function(path = NULL) {

R/get_mcd64A1.R

@@ -78,7 +78,7 @@ get_mcd64a1 <- function(years = 2000:2022) {
 register_resource(
   name = "mcd64a1",
   description = "MODIS Burned Area Monthly Product (Aqua and Terra)",
-  licence = "https://lpdaac.usgs.gov/data/data-citation-and-policies/",
+  licence = "https://www.earthdata.nasa.gov/engage/open-data-services-software-policies/data-use-guidance",
   source = "https://planetarycomputer.microsoft.com/dataset/modis-64A1-061",
   type = "raster"
 )