v0.3.0: added functions to assess dois (verify, retracted end exist)

Author: rkrug

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: IPBES.R
 Type: Package
 Title: Tool functions used by the Data and Knowledge Technical Support Unit of IPBES
-Version: 0.2.8
+Version: 0.3.0
 Date: 2023-11-13
 Authors@R: 
   c(person(given = "Rainer M.",
@@ -22,7 +22,8 @@ Imports:
   tidygraph,
   ggplot2,
   ggraph,
-  networkD3
+  networkD3,
+  httr2
 Suggests: 
     roxyglobals,
     tinytest

NAMESPACE

@@ -1,6 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
 export(abbreviate_authors)
+export(doi_exists)
+export(doi_not_retracted)
+export(doi_valid)
 export(get_count)
 export(plot_snowball)
 export(plot_snowball_interactive)
@@ -9,6 +12,7 @@ importFrom(dplyr,arrange)
 importFrom(dplyr,desc)
 importFrom(dplyr,filter)
 importFrom(dplyr,full_join)
+importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
 importFrom(dplyr,relocate)
 importFrom(dplyr,rename)
@@ -29,11 +33,20 @@ importFrom(ggraph,geom_node_point)
 importFrom(ggraph,ggraph)
 importFrom(ggraph,scale_edge_width)
 importFrom(ggraph,theme_graph)
+importFrom(httr2,req_error)
+importFrom(httr2,req_headers)
+importFrom(httr2,req_perform)
+importFrom(httr2,req_retry)
+importFrom(httr2,req_throttle)
+importFrom(httr2,request)
+importFrom(httr2,resp_status)
 importFrom(networkD3,JS)
 importFrom(networkD3,forceNetwork)
 importFrom(openalexR,oa_query)
 importFrom(openalexR,oa_request)
 importFrom(openalexR,snowball2df)
 importFrom(tidygraph,as_tbl_graph)
+importFrom(utils,download.file)
+importFrom(utils,read.csv)
 importFrom(utils,tail)
 importFrom(writexl,write_xlsx)

R/doi_exists.R

@@ -0,0 +1,92 @@
+library(httr2)
+
+
+
+#' Check if DOIs exist
+#'
+#' This function checks if a given list of DOIs exist by sending HTTP requests to the DOI resolver.
+#'
+#' @details This function uses the httr package to send HTTP GET requests to the DOI resolver and checks the response status code. A status code of 200 indicates that the DOI exists, while any other status code indicates that the DOI does not exist.
+#'
+#' @param dois A character vector of DOIs to check.
+#' @param cache_file A file name of the cache to be used, i.e. the confirmed existing dois. The format is a character vector with the DOIs which exist. If the cache exist, it will be updated at the end.
+#'
+#' @return A named logical vector indicating whether each DOI does exist or not, names are the dois.
+#'
+#' @examples
+#' dois <- c("sbcd1234", "10.1234/abcd", "10.1002/jcb.23190", "10.47366/sabia.v5n1a3")
+#' doi_exists(dois)
+#' # Output: [1] FALSE  TRUE
+#'
+#' @importFrom httr2 request req_headers req_throttle req_retry req_error req_perform resp_status
+#'
+#' @export
+doi_exists <- function(dois, cache_file = NULL) {
+    if (is.null(cache_file)) {
+        dois_to_check <- 1:length(dois)
+        cache <- NULL
+    } else {
+        if (file.exists(cache_file)) {
+            cache <- readRDS(cache_file)
+            dois_to_check <- (1:length(dois))[!(dois %in% cache)]
+        } else {
+            dois_to_check <- 1:length(dois)
+            cache <- NULL
+        }
+    }
+
+    total <- length(dois_to_check)
+    result_dois_checked <- sapply(
+        dois_to_check,
+        function(i) {
+            # Print progress
+            cat(sprintf("\rProgress: %d of %d", i, total))
+
+            if (is.na(dois[i])) {
+                return(NA)
+            } else {
+                tryCatch(
+                    {
+                        status <- httr2::request(paste0("https://doi.org/", dois[i])) |>
+                            httr2::req_headers(
+                                noredirect = TRUE,
+                                type = "URL"
+                            ) |>
+                            httr2::req_throttle(
+                                rate = 30 / 60
+                            ) |>
+                            httr2::req_retry(
+                                max_tries = 5
+                            ) |>
+                            req_error(
+                                is_error = function(e) {
+                                    FALSE
+                                }
+                            ) |>
+                            httr2::req_perform() |>
+                            httr2::resp_status()
+                        return(status == 200)
+                    },
+                    error = function(e) {
+                        return(NA)
+                    }
+                )
+            }
+        }
+    )
+
+    result <- dois
+    result[] <- NA
+    result <- as.logical(result)
+    names(result) <- dois
+
+    result[dois_to_check] <- result_dois_checked
+
+    if (!is.null(cache)) {
+        result[dois[(dois %in% cache)]] <- TRUE
+        cache <- c(cache, result[result])
+        cache <- cache[!duplicated(cache)]
+        saveRDS(cache, cache_file)
+    }
+    return(result)
+}

R/doi_retracted.R

@@ -0,0 +1,49 @@
+#' Check if DOIs are not retracted
+#'
+#' This function checks if a given list of DOIs (Digital Object Identifiers) are retracted.
+#' It uses the Crossref API to query the Retraction Watch database.
+#'
+#' @param dois A character vector of DOIs to be checked.
+#' @param cache_file A file name of the cache to be used, i.e. the downloaded retraction data. THe file is an `rds` file as downloaded from the retractionwatch site. If NULL, the data will not be cached.
+#' @param email An optional email address to be included in the API request [RECOMMENDET!].
+#'
+#' @return A named logical vector indicating whether each DOI is retracted (`FALSE`) or or not (`TRUE`), names are the dois.
+#'
+#' @importFrom utils download.file read.csv
+#' @examples
+#' # Check if a single DOI is retracted
+#' doi_not_retracted("10.1234/abcd")
+#'
+#' # Check if multiple DOIs are retracted
+#' dois <- c("sbcd1234", "10.1234/abcd", "10.1002/jcb.23190", "10.47366/sabia.v5n1a3")
+#' doi_not_retracted(dois)
+#'
+#' @export
+doi_not_retracted <- function(dois, cache_file = NULL, email = NULL) {
+    if (is.null(cache_file)) {
+        tmpfile <- tempfile(fileext = ".csv")
+        utils::download.file(
+            url = paste0("https://api.labs.crossref.org/data/retractionwatch?", email),
+            destfile = tmpfile
+        )
+        cache <- read.csv(tmpfile, stringsAsFactors = FALSE)
+        unlink(tmpfile)
+    } else {
+        if (file.exists(cache_file)) {
+            cache <- readRDS(cache_file)
+        } else {
+            tmpfile <- tempfile(fileext = ".csv")
+            utils::download.file(
+                url = paste0("https://api.labs.crossref.org/data/retractionwatch?", email),
+                destfile = tmpfile
+            )
+            cache <- read.csv(tmpfile, stringsAsFactors = FALSE)
+            saveRDS(cache, cache_file)
+            unlink(tmpfile)
+        }
+    }
+
+    result <- !(dois %in% cache$OriginalPaperDOI)
+    names(result) <- dois
+    return(result)
+}

R/doi_valid.R

@@ -0,0 +1,30 @@
+#' Validate DOIs
+#'
+#' This function validates a vector of DOIs (Digital Object Identifiers) using a regular expression pattern.#'
+#' It is taken from https://github.com/libscie/retractcheck/blob/23f1e5c7d572d9470583288d951d1bad98392f82/R/utils.R#L16
+
+#' @param dois A vector of DOIs to be validated.
+#'
+#' @return A named logical vector indicating whether each DOI is valid or not, names are the dois.
+#'
+#' @details The function uses a regular expression pattern to validate the format of each DOI in the input vector.
+#' The regular expression pattern is based on the pattern used by the \code{retractcheck} package and can be found at
+#' https://github.com/libscie/retractcheck/blob/23f1e5c7d572d9470583288d951d1bad98392f82/R/utils.R#L16.
+#' Alternatively, you can uncomment the second regular expression pattern and comment out the first one to use the pattern
+#' from the \code{rorcid} package, which can be found at https://github.com/ropensci-archive/rorcid/blob/master/R/check_dois.R.
+#'
+#' @examples
+#' dois <- c("sbcd1234", "10.1234/abcd", "10.1002/jcb.23190", "10.47366/sabia.v5n1a3")
+#' doi_valid(dois)
+#'
+#' @export
+doi_valid <- function(dois) {
+    ## regex <- "^10\\.\\d{4,9}/[-._;()/:A-Z0-9]+$" # https://github.com/libscie/retractcheck/blob/23f1e5c7d572d9470583288d951d1bad98392f82/R/utils.R#L16
+    regex <- "\\b(10[.][0-9]{4,}(?:[.][0-9]+)*/(?:(?![\"&\'<>])\\S)+)\\b" # https://github.com/ropensci-archive/rorcid/blob/master/R/check_dois.R
+    result <- grepl(
+        x = dois, pattern = regex,
+        perl = TRUE, ignore.case = TRUE
+    )
+    names(result) <- dois
+    return(result)
+}

R/globals.R

@@ -1,7 +1,6 @@
 # Generated by roxyglobals: do not edit by hand
 
 utils::globalVariables(c(
-  "x", # <plot_snowball>
   "index", # <plot_snowball>
   "cited_by_count_by_year", # <plot_snowball>
   "type", # <plot_snowball>
@@ -11,7 +10,6 @@ utils::globalVariables(c(
   "cited_by_count", # <plot_snowball>
   "Freq", # <to_xlsx>
   "Var1", # <to_xlsx>
-  "flat_snow", # <to_xlsx>
   "id", # <to_xlsx>
   "publication_year", # <to_xlsx>
   "cited_by_count", # <to_xlsx>

R/plot_snowball_interactive.R

@@ -3,21 +3,23 @@
 #' This function creates a interactive snowball seaarch network using the networkD3 package.
 #'
 #' @param snowball The snowball object containing the network data. The object is returned from the
-#'   \link[openalexR]{oa_snowball function in the `openalexR`` package
+#'   \link[openalexR]{oa_snowball} function in the `openalexR`` package
 #' @param key_works A data frame, as returned. e.g. by `oa_fetch(entity = "works", ...`,
 #'   containing the key-works from the snowball search which will be highlighted in the network.
 #' @param file The file name to save the network to. TThe directory has tro esxist.
 #'   Default: `NULL`, i.e. not saved.
 #'
 #' @importFrom networkD3 forceNetwork JS
 #'
+#' @importFrom dplyr mutate select rename left_join
+#'
 #' @return A networkD3 object representing the interactive network plot.
 #'
 #' @md
 #'
 #' @examples
 #' \dontrun{
-#' plot_snowball_interactive(snowball)
+#' plot_snowball_interactive(snowball, key_works, file)
 #' }
 #' @export
 plot_snowball_interactive <- function(snowball, key_works, file) {