improved offline behavior

R/assessment_cooccurrences_summary.R

@@ -47,6 +47,7 @@
 #'
 #' @export
 
+
 assessment_cooccurrences_summary <- function(inventory_list) {
 
   bad_df <- data.frame(
@@ -70,7 +71,7 @@ assessment_cooccurrences_summary <- function(inventory_list) {
 
   if (!is_inventory_list(inventory_list)) {
     message(
-      "assessment_list must be a list of dataframes obtained from universalFQA.org. Type ?download_assessment_list for help."
+      "assessment_list must be a list of inventories obtained from universalFQA.org. Type ?assessment_inventory_list for help."
     )
     return(invisible(bad_df))
   }

R/assessment_glance.R

@@ -146,9 +146,9 @@ assessment_glance <- function(data_set) {
     return(invisible(df_bad))
   }
 
-  if (ncol(data_set) == 0) {
+  if (nrow(data_set) == 0) {
     message(
-      "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help."
+      "Input data_set is empty."
     )
     return(invisible(df_bad))
   }

R/assessment_inventory.R

@@ -54,6 +54,11 @@ assessment_inventory <- function(data_set) {
     return(invisible(df_bad))
   }
 
+  if (nrow(data_set) == 0) {
+    message("Input data_set is empty.")
+    return(invisible(df_bad))
+  }
+
   if (ncol(data_set) == 0) {
     message(
       "data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help."

R/database_inventory.R

@@ -49,12 +49,12 @@ database_inventory <- function(database) {
   )
 
   if (!is.data.frame(database)) {
-    message("database must be a data frame obtained from the universalFQA.org website. Type ?download_assessment for help.")
+    message("database must be a data frame obtained from the universalFQA.org website. Type ?download_database for help.")
     return(invisible(bad_df))
   }
 
   if (ncol(database) == 0){
-    message("data_set must be a dataframe obtained from the universalFQA.org website. Type ?download_assessment for help.")
+    message("database must be a data frame obtained from the universalFQA.org website. Type ?download_database for help.")
     return(invisible(bad_df))
   }
 
@@ -72,7 +72,7 @@ database_inventory <- function(database) {
   }
 
   if (!("Scientific Name" %in% database[[1]])) {
-    message("database must be a data frame obtained from the universalFQA.org website. Type ?download_assessment for help.")
+    message("database must be a data frame obtained from the universalFQA.org website. Type ?download_database for help.")
     return(invisible(bad_df))
   }
 

R/download_assessment.R

@@ -36,36 +36,13 @@
 
 download_assessment <- function(assessment_id) {
 
-  # apply interval version
-  # if nrow = 0, remove cache
-  # output the data frame from the internal version
-
   out <- download_assessment_internal(assessment_id)
 
   if (nrow(out) == 0){
     memoise::drop_cache(download_assessment_internal)({{ assessment_id }})
+    return(invisible(out))
   }
 
   out
-#
-#   out <- tryCatch(download_assessment_internal(assessment_id),
-#                   warning = function(w) {
-#                     warning(w)
-#                     memoise::drop_cache(download_assessment_internal)({{ assessment_id }})
-#                     return(invisible(NULL))
-#                   },
-#                   message = function(m) {
-#                     message(m)
-#                     memoise::drop_cache(download_assessment_internal)({{ assessment_id }})
-#                     return(invisible(NULL))
-#                   }
-#   )
-#
-#   if (is.null(out)){
-#     memoise::drop_cache(download_assessment_internal)({{ assessment_id }})
-#     return(invisible(NULL))
-#   }
-#
-#   out
 }
 

R/download_assessment_internal.R

@@ -11,7 +11,9 @@
 #'
 #' @noRd
 
+
 download_assessment_internal <- memoise::memoise(function(assessment_id) {
+
   if (!is.numeric(assessment_id)) {
     stop("assessment_id must be an integer.", call. = FALSE)
   }
@@ -69,7 +71,7 @@ download_assessment_internal <- memoise::memoise(function(assessment_id) {
 
   if ((list_data[[1]] == "The requested assessment is not public") &
       (!is.na(list_data[[1]]))) {
-    message("The requested assessment is not public. Returning empty data frame.")
+    message("The requested assessment is not public.")
     return(invisible(empty))
   }
 
@@ -81,5 +83,12 @@ download_assessment_internal <- memoise::memoise(function(assessment_id) {
                         unlist(x)
                       })
 
-  as.data.frame(do.call(rbind, list_data))
+  out <- as.data.frame(do.call(rbind, list_data))
+
+  class(out) <- c("tbl_df",
+                  "tbl",
+                  "data.frame")
+
+  out
+
 })

R/download_assessment_list.R

@@ -44,8 +44,8 @@ download_assessment_list <- function(database_id, ...) {
 
   inventories_summary <- index_fqa_assessments(database_id)
 
-  if (is.null(inventories_summary)){
-    return(invisible(NULL))
+  if (nrow(inventories_summary) == 0){
+    return(list())
   }
 
   inventories_requested <- inventories_summary |>

R/download_database.R

@@ -31,27 +31,17 @@
 
 download_database <- function(database_id) {
 
-  out <- tryCatch(download_database_internal(database_id),
-                  warning = function(w) {
-                    warning(w)
-                    memoise::drop_cache(download_database_internal)({{ database_id }})
-                    return(invisible(NULL))
-                  },
-                  message = function(m) {
-                    message(m)
-                    memoise::drop_cache(download_database_internal)({{ database_id }})
-                    return(invisible(NULL))
-                  }
-  )
-
-  if (is.null(out)){
+  out <- download_database_internal(database_id)
+
+  if (nrow(out) == 0 | out$V2[5] == 0){
     memoise::drop_cache(download_database_internal)({{ database_id }})
+    return(invisible(out))
   }
 
   out
-
 }
 
 
 
 
+

R/download_database_internal.R

@@ -13,20 +13,34 @@
 #'
 #'
 
+
 download_database_internal <- memoise::memoise(function(database_id) {
+
   if (!is.numeric(database_id)) {
     stop("database_id must be an integer.",
          call. = FALSE
-         )
+    )
   }
+
   if (database_id %% 1 != 0) {
     stop("database_id must be an integer.",
          call. = FALSE
-         )
+    )
   }
-  if (database_id == -40000) {
-    return(invisible(NULL))
-  } # for testing memoisation
+
+  empty <- data.frame(V1 = character(0),
+                      V2 = character(0),
+                      V3 = character(0),
+                      V4 = character(0),
+                      V5 = character(0),
+                      V6 = character(0),
+                      V7 = character(0),
+                      V8 = character(0),
+                      V9 = character(0))
+
+  if (database_id == -40000){
+    return(invisible(empty))
+  } # for testing internet errors
 
   database_address <-
     paste0("http://universalfqa.org/get/database/",
@@ -43,7 +57,7 @@ download_database_internal <- memoise::memoise(function(database_id) {
 
   cl <- class(database_get)
   if (cl != "response"){
-    return(invisible(NULL))
+    return(invisible(empty))
   }
 
   if (httr::http_error(database_get)) {
@@ -53,7 +67,7 @@ download_database_internal <- memoise::memoise(function(database_id) {
         httr::status_code(assessments_get)
       )
     )
-    return(invisible(NULL))
+    return(invisible(empty))
   }
 
   database_text <- httr::content(database_get,
@@ -64,8 +78,8 @@ download_database_internal <- memoise::memoise(function(database_id) {
 
   if ((list_data[[1]] == "The requested assessment is not public") &
       (!is.na(list_data[[1]]))) {
-    message("The requested assessment is not public. Returning NULL.")
-    return(invisible(NULL))
+    message("The requested assessment is not public.")
+    return(invisible(empty))
   }
 
   max_length <-
@@ -79,8 +93,12 @@ download_database_internal <- memoise::memoise(function(database_id) {
   db_out <- as.data.frame(do.call(rbind, list_data))
 
   if (db_out[5, 2] == 0){
-    warning("Specified database is empty.", call. = FALSE)
+    message("Specified database is empty.")
   }
 
+  class(db_out) <- c("tbl_df",
+                     "tbl",
+                     "data.frame")
+
   db_out
 })

R/download_transect.R

@@ -34,25 +34,14 @@
 
 download_transect <- function(transect_id) {
 
-  out <- tryCatch(download_transect_internal(transect_id),
-                  warning = function(w) {
-                    warning(w)
-                    memoise::drop_cache(download_transect_internal)({{ transect_id }})
-                    return(invisible(NULL))
-                  },
-                  message = function(m) {
-                    message(m)
-                    memoise::drop_cache(download_transect_internal)({{ transect_id }})
-                    return(invisible(NULL))
-                  }
-  )
+  out <- download_transect_internal(transect_id)
 
-  if (is.null(out)){
+  if (nrow(out) == 0){
     memoise::drop_cache(download_transect_internal)({{ transect_id }})
+    return(invisible(out))
   }
 
   out
-
 }
 
 

R/download_transect_internal.R

@@ -11,16 +11,35 @@
 #'
 #' @noRd
 
+
 download_transect_internal <- memoise::memoise(function(transect_id) {
+
   if (!is.numeric(transect_id)) {
     stop("transect_id must be an integer.", call. = FALSE)
   }
+
   if (transect_id %% 1 != 0) {
     stop("transect_id must be an integer.", call. = FALSE)
   }
+
+  empty <- data.frame(V1 = character(0),
+                      V2 = character(0),
+                      V3 = character(0),
+                      V4 = character(0),
+                      V5 = character(0),
+                      V6 = character(0),
+                      V7 = character(0),
+                      V8 = character(0),
+                      V9 = character(0),
+                      V10 = character(0),
+                      V11 = character(0),
+                      V12 = character(0),
+                      V13 = character(0),
+                      V14 = character(0))
+
   if (transect_id == -40000) {
-    return(invisible(NULL))
-  } # for testing memoisation
+    return(invisible(empty))
+  } # for testing internet errors
 
   trans_address <-
     paste0("http://universalfqa.org/get/transect/", transect_id)
@@ -36,7 +55,7 @@ download_transect_internal <- memoise::memoise(function(transect_id) {
 
   cl <- class(trans_get)
   if (cl != "response"){
-    return(invisible(NULL))
+    return(invisible(empty))
   }
 
   if (httr::http_error(trans_get)) {
@@ -46,7 +65,7 @@ download_transect_internal <- memoise::memoise(function(transect_id) {
         httr::status_code(assessments_get)
       )
     )
-    return(invisible(NULL))
+    return(invisible(empty))
   }
 
   trans_text <- httr::content(trans_get,
@@ -57,8 +76,8 @@ download_transect_internal <- memoise::memoise(function(transect_id) {
 
   if ((list_data[[1]] == "The requested assessment is not public") &
       (!is.na(list_data[[1]]))) {
-    message("The requested assessment is not public. Returning NULL.")
-    return(invisible(NULL))
+    message("The requested assessment is not public.")
+    return(invisible(empty))
   }
 
   max_length <-
@@ -69,6 +88,11 @@ download_transect_internal <- memoise::memoise(function(transect_id) {
                         unlist(x)
                       })
 
-  as.data.frame(do.call(rbind, list_data))
+  out <- as.data.frame(do.call(rbind, list_data))
+
+  class(out) <- c("tbl_df",
+                  "tbl",
+                  "data.frame")
 
+  out
 })