More graceful errors (#4)

* Update fetch_ucirepo() to have a softer error if the internet resource cannot be reached.

* Update list_available_datasets() to have a softer error if no data sets are found.

* Add two tests that mimic a bad connection/failure of httr2::request() using mocking.

* Add NEWS file

* Bump version

Author: coatless

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ucimlrepo
 Title: Explore UCI ML Repository Datasets
-Version: 0.0.1
+Version: 0.0.2
 Authors@R: c(
     person("James Joseph", "Balamuta", email = "[email protected]", 
            role = c("aut", "cre", "cph"), 
@@ -23,7 +23,7 @@ Imports:
     utils
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Collate: 
     'constants.R'
     'fetch-ucirepo.R'

NEWS.md

@@ -0,0 +1,15 @@
+# ucimlrepo 0.0.2
+
+## Features
+
+- Improved graceful errors for `fetch_ucirepo()` and `list_available_datasets()`
+  when resources are not found/available. ([#3](https://github.com/coatless-rpkg/ucimlrepo/issues/3),
+  thanks Prof. Ripley!)
+
+# ucimlrepo 0.0.1
+
+## Features
+
+- `fetch_ucirepo()`: Download a dataset from the UCI ML Repository.
+- `list_available_datasets()`: List all available datasets from the UCI ML Repository.
+

R/fetch-ucirepo.R

@@ -1,3 +1,78 @@
+#' Empty Fetch Response
+#'
+#' Internal function to create an empty fetch response.
+#'
+#' @return
+#' A list containing dataset metadata, dataframes, and variable info in its properties.
+#'
+#' @seealso
+#' [`fetch_ucirepo()`]
+#'
+#' @keywords internal
+empty_fetch_response <- function() {
+  list(
+    data = list(
+      ids = data.frame(),
+      features = data.frame(),
+      targets = data.frame(),
+      original = data.frame(),
+      headers = character()
+    ),
+    metadata = list(
+      uci_id = integer(),
+      name = character(),
+      repository_url = character(),
+      data_url = character(),
+      abstract = character(),
+      area = character(),
+      tasks = list(),
+      characteristics = list(),
+      num_instances = integer(),
+      num_features = integer(),
+      feature_types = list(),
+      demographics = list(),
+      target_col = list(),
+      index_col = NULL,
+      has_missing_values = character(),
+      missing_values_symbol = character(),
+      year_of_dataset_creation = integer(),
+      last_updated = character(),
+      dataset_doi = character(),
+      creators = list(),
+      intro_paper = list(
+        title = character(),
+        authors = character(),
+        published_in = character(),
+        year = integer(),
+        url = character(),
+        doi = NULL
+      ),
+      additional_info = list(
+        summary = character(),
+        purpose = NULL,
+        funded_by = NULL,
+        instances_represent = NULL,
+        recommended_data_splits = NULL,
+        sensitive_data = NULL,
+        preprocessing_description = NULL,
+        variable_info = character(),
+        citation = NULL
+      )
+    ),
+    variables = data.frame(
+      name = character(),
+      role = character(),
+      type = character(),
+      demographic = character(),
+      description = character(),
+      units = character(),
+      missing_values = character(),
+      stringsAsFactors = FALSE
+    )
+  )
+}
+
+
 #' Fetch UCI ML Repository Dataset
 #'
 #' Loads a dataset from the UCI ML Repository, including the dataframes and
@@ -103,18 +178,20 @@ fetch_ucirepo <- function(name, id) {
   }
 
   # Fetch metadata from API
-  response <- tryCatch({
+  response <- try({
     httr2::request(API_BASE_URL) |>
       httr2::req_url_query(!!!query_params) |>
       httr2::req_perform()
-  }, error = function(e) {
-    message('Error connecting to server')
-    return()
   })
 
+  if (inherits(response, "try-error")) {
+    message('Error connecting to server')
+    return(invisible(empty_fetch_response()))
+  }
+
   if (response$status_code != 200) {
     message('Dataset not found in repository')
-    return()
+    return(invisible(empty_fetch_response()))
   }
 
   data <- response |> httr2::resp_body_json(check_type = FALSE)
@@ -132,20 +209,20 @@ fetch_ucirepo <- function(name, id) {
   # No data URL means that the dataset cannot be imported into R
   if (is.null(data_url)) {
     message(paste0('"', name, '" dataset (id=', id, ') exists in the repository, but is not available for import. Please select a dataset from this list: https://archive.ics.uci.edu/datasets?skip=0&take=10&sort=desc&orderBy=NumHits&search=&Python=true'))
-    return()
+    return(invisible(empty_fetch_response()))
   }
 
   # Parse into dataframe using read.csv
   df <- tryCatch({
     utils::read.csv(data_url, check.names = FALSE)
   }, error = function(e) {
     message(paste0('Error reading data csv file for "', name, '" dataset (id=', id, ').'))
-    return()
+    return(invisible(empty_fetch_response))
   })
 
   if (nrow(df) == 0) {
     message(paste0('Error reading data csv file for "', name, '" dataset (id=', id, ').'))
-    return()
+    return(invisible(empty_fetch_response()))
   }
 
   # Header line should be variable names

R/list-available-datasets.R

@@ -1,3 +1,32 @@
+#' Empty Search Response
+#'
+#' Internal function to create an empty search response.
+#'
+#' @return
+#' A data frame with three empty columns of 'id', 'name', and 'url'.
+#'
+#' @seealso
+#' [`list_available_datasets()`]
+#'
+#' @keywords internal
+empty_search_response <- function() {
+  search <- data.frame(
+    id = integer(),
+    name = character(),
+    url = character(),
+    stringsAsFactors = FALSE
+  )
+
+  # Nullify attributes
+  attr(search, 'filter') <- NULL
+  attr(search, 'search') <- NULL
+  attr(search, 'area') <-  NULL
+
+  search
+}
+
+
+
 #' List Available Datasets from UCI ML Repository
 #'
 #' Prints a list of datasets that can be imported via the \code{fetch_ucirepo} function.
@@ -7,15 +36,15 @@
 #' @param area Character. Optional query to filter available datasets based on subject area.
 #'
 #' @return
-#' Prints the list of available datasets.
-#'
-#' Invisibly returns a data frame containing the list of available datasets
+#' A data frame containing the list of available datasets
 #' with columns of:
 #'
 #' - **id**: Integer ID for the data set.
 #' - **name**: Name of Dataset
 #' - **url**: Download location of the data set
 #'
+#' In the event the search fails, the data frame returned will be empty.
+#'
 #' @include constants.R
 #' @export
 #' @examples
@@ -56,28 +85,29 @@ list_available_datasets <- function(filter, search, area) {
   }
 
   # Fetch list of datasets from API
-  response <- tryCatch({
+  response <- try({
     httr2::request(API_LIST_URL) |>
       httr2::req_url_query(!!!query_params) |>
       httr2::req_perform()
-  }, error = function(e) {
-    message('Error connecting to server')
-    message(e)
-    return()
   })
 
+  if (inherits(response, "try-error")) {
+    message('Error connecting to server')
+    return(invisible(empty_search_response()))
+  }
+
   # Convert body to JSON
   # Avoid enforcing the application/json format response
   data <- response |> httr2::resp_body_json(check_type = FALSE) |> {\(x) x$data}()
 
   if (response$status_code != 200) {
     message('Error fetching datasets with status code: ', response$status_code)
-    return()
+    return(invisible(empty_search_response()))
   }
 
   if (length(data) == 0) {
     message('No datasets found')
-    return()
+    return(invisible(empty_search_response()))
   }
 
   # Create and return a table of data

man/empty_fetch_response.Rd

@@ -1,3 +1,20 @@
+test_that("fetch_ucirepo(): Graceful errors", {
+  skip_on_cran()
+
+  with_mocked_bindings(
+    code = {
+      # Check we ommit a diagnostic message instead of a hard error
+      expect_message(result <- fetch_ucirepo(id = -5))
+
+      # Verify empty variables data frame
+      # (This indicates an empty/failed response)
+      expect_equal(nrow(result$variables), 0)
+    },
+    request = function(...) { stop("Error!") },
+    .package = "httr2"
+  )
+})
+
 test_that("fetch_ucirepo(): Nonexistent dataset", {
   skip_on_cran()
   expect_message(fetch_ucirepo(id = 2000))

man/empty_search_response.Rd

@@ -10,6 +10,23 @@ test_that("list_available_datasets(): graceful errors", {
 
 })
 
+test_that("list_available_datasets(): Graceful errors with bad connection", {
+  skip_on_cran()
+
+  with_mocked_bindings(
+    code = {
+      # Check we ommit a diagnostic message instead of a hard error
+      expect_message(result <- list_available_datasets(search = "toad"))
+
+      # Verify empty variables data frame
+      # (This indicates an empty/failed response)
+      expect_equal(nrow(result), 0)
+    },
+    request = function(...) { stop("Error!") },
+    .package = "httr2"
+  )
+})
+
 test_that("list_available_datasets(): search", {
   skip_on_cran()