From 23f964afe7bdff2d57892fd9ec63b55426c63848 Mon Sep 17 00:00:00 2001
From: equitable-equations <agard@lakeforest.edu>
Date: Mon, 21 Aug 2023 14:04:41 -0500
Subject: [PATCH] fix memoisation for offline use

---
 NAMESPACE                          |  1 +
 R/download_database_internal.R     |  8 ++-
 R/download_transect.R              | 58 +++----------------
 R/download_transect_internal.R     | 73 ++++++++++++++++++++++++
 R/index_fqa_assessments.R          | 67 +++-------------------
 R/index_fqa_assessments_internal.R | 89 ++++++++++++++++++++++++++++++
 R/index_fqa_databases.R            | 43 +++------------
 R/index_fqa_databases_internal.R   | 55 ++++++++++++++++++
 R/index_fqa_transects.R            | 68 +++--------------------
 R/index_fqa_transects_internal.R   | 89 ++++++++++++++++++++++++++++++
 10 files changed, 341 insertions(+), 210 deletions(-)
 create mode 100644 R/download_transect_internal.R
 create mode 100644 R/index_fqa_assessments_internal.R
 create mode 100644 R/index_fqa_databases_internal.R
 create mode 100644 R/index_fqa_transects_internal.R

diff --git a/NAMESPACE b/NAMESPACE
index 0d6057d..898e928 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -43,6 +43,7 @@ importFrom(ggplot2,labs)
 importFrom(ggplot2,scale_x_continuous)
 importFrom(ggplot2,theme_minimal)
 importFrom(memoise,drop_cache)
+importFrom(memoise,forget)
 importFrom(memoise,has_cache)
 importFrom(memoise,memoise)
 importFrom(rlang,.data)
diff --git a/R/download_database_internal.R b/R/download_database_internal.R
index 976224d..9778a8b 100644
--- a/R/download_database_internal.R
+++ b/R/download_database_internal.R
@@ -15,10 +15,14 @@
 
 download_database_internal <- memoise::memoise(function(database_id) {
   if (!is.numeric(database_id)) {
-    stop("database_id must be an integer.", call. = FALSE)
+    stop("database_id must be an integer.",
+         call. = FALSE
+         )
   }
   if (database_id %% 1 != 0) {
-    stop("database_id must be an integer.", call. = FALSE)
+    stop("database_id must be an integer.",
+         call. = FALSE
+         )
   }
   if (database_id == -40000) {
     return(invisible(NULL))
diff --git a/R/download_transect.R b/R/download_transect.R
index 904fd34..3e4160a 100644
--- a/R/download_transect.R
+++ b/R/download_transect.R
@@ -17,8 +17,7 @@
 #'   overview, and \code{\link[=transect_inventory]{transect_inventory()}} for
 #'   species-level data.
 #'
-#' @import jsonlite httr
-#' @importFrom memoise memoise
+#' @importFrom memoise drop_cache
 #'
 #' @examples
 #' \donttest{
@@ -33,55 +32,12 @@
 #' @export
 
 
-download_transect <- memoise::memoise(function(transect_id) {
-  if (!is.numeric(transect_id)) {
-    stop("transect_id must be an integer.", call. = FALSE)
+download_transect <- function(transect_id) {
+  out <- download_transect_internal(transect_id)
+  if (is.null(out)){
+    memoise::drop_cache(download_transect_internal)({{ transect_id }})
   }
-  if (transect_id %% 1 != 0) {
-    stop("transect_id must be an integer.", call. = FALSE)
-  }
-
-  trans_address <-
-    paste0("http://universalfqa.org/get/transect/", transect_id)
-  ua <-
-    httr::user_agent("https://github.com/equitable-equations/fqar")
-
-  trans_get <- tryCatch(httr::GET(trans_address, ua),
-                        error = function(e){
-                          message("Unable to connect. Please check internet connection.")
-                          return(invisible(NULL))
-                        }
-  )
-  if (httr::http_error(trans_get)) {
-    message(
-      paste(
-        "API request to universalFQA.org failed. Error",
-        httr::status_code(assessments_get)
-      )
-    )
-    return(invisible(NULL))
-  }
-
-  trans_text <- httr::content(trans_get,
-                              "text",
-                              encoding = "ISO-8859-1")
-  trans_json <- jsonlite::fromJSON(trans_text)
-  list_data <- trans_json[[2]]
-
-  if ((list_data[[1]] == "The requested assessment is not public") &
-      (!is.na(list_data[[1]]))) {
-    stop("The requested assessment is not public", call. = FALSE)
-  }
-
-  max_length <-
-    max(unlist(lapply(list_data, length))) # determines how wide the df must be
-  list_data <- lapply(list_data,
-                      function(x) {
-                        length(x) <- max_length
-                        unlist(x)
-                      })
-
-  as.data.frame(do.call(rbind, list_data))
+  out
+}
 
-})
 
diff --git a/R/download_transect_internal.R b/R/download_transect_internal.R
new file mode 100644
index 0000000..83ca59f
--- /dev/null
+++ b/R/download_transect_internal.R
@@ -0,0 +1,73 @@
+#' Download a single floristic quality transect assessment with possible null result cached
+#'
+#' @param transect_id A numeric identifier of the desired floristic quality
+#'   transect assessment
+#'
+#' @return An untidy data frame in the original format of the Universal FQA
+#'   website.
+#'
+#' @import httr jsonlite
+#' @importFrom memoise memoise
+#'
+#' @noRd
+
+download_transect <- 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)
+  }
+  if (transect_id == -40000) {
+    return(invisible(NULL))
+  } # for testing memoisation
+
+  trans_address <-
+    paste0("http://universalfqa.org/get/transect/", transect_id)
+  ua <-
+    httr::user_agent("https://github.com/equitable-equations/fqar")
+
+  trans_get <- tryCatch(httr::GET(trans_address, ua),
+                        error = function(e){
+                          message("Unable to connect. Please check internet connection.")
+                          character(0)
+                        }
+  )
+
+  cl <- class(trans_get)
+  if (cl != "response"){
+    return(invisible(NULL))
+  }
+
+  if (httr::http_error(trans_get)) {
+    message(
+      paste(
+        "API request to universalFQA.org failed. Error",
+        httr::status_code(assessments_get)
+      )
+    )
+    return(invisible(NULL))
+  }
+
+  trans_text <- httr::content(trans_get,
+                              "text",
+                              encoding = "ISO-8859-1")
+  trans_json <- jsonlite::fromJSON(trans_text)
+  list_data <- trans_json[[2]]
+
+  if ((list_data[[1]] == "The requested assessment is not public") &
+      (!is.na(list_data[[1]]))) {
+    stop("The requested assessment is not public", call. = FALSE)
+  }
+
+  max_length <-
+    max(unlist(lapply(list_data, length))) # determines how wide the df must be
+  list_data <- lapply(list_data,
+                      function(x) {
+                        length(x) <- max_length
+                        unlist(x)
+                      })
+
+  as.data.frame(do.call(rbind, list_data))
+
+})
diff --git a/R/index_fqa_assessments.R b/R/index_fqa_assessments.R
index ead7f2a..083b328 100644
--- a/R/index_fqa_assessments.R
+++ b/R/index_fqa_assessments.R
@@ -18,8 +18,7 @@
 #'   \item practitioner (character)
 #'   }
 #'
-#' @import jsonlite httr
-#' @importFrom memoise memoise
+#' @importFrom memoise drop_cache
 #'
 #' @examples
 #' \donttest{
@@ -31,66 +30,14 @@
 #' @export
 
 
-index_fqa_assessments <- memoise(function(database_id) {
-  if (!is.numeric(database_id)) {
-    stop(
-      "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.",
-      call. = FALSE
-    )
+index_fqa_assessments <- function(database_id) {
+  out <- index_fqa_assessments_internal(database_id)
+  if (is.null(out)){
+    memoise::drop_cache(index_fqa_assessments_internal)({{ database_id }})
   }
-  if (database_id %% 1 != 0) {
-    stop(
-      "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.",
-      call. = FALSE
-    )
-  }
-
-  assessments_address <-
-    paste0("http://universalfqa.org/get/database/",
-           database_id,
-           "/inventory")
-  ua <-
-    httr::user_agent("https://github.com/equitable-equations/fqar")
-
-  assessments_get <- tryCatch(httr::GET(assessments_address, ua),
-                              error = function(e){
-                                message("Unable to connect. Please check internet connection.")
-                                return(invisible(NULL))
-                              }
-  )
-  if (httr::http_error(assessments_get)) {
-    message(
-      paste(
-        "API request to universalFQA.org failed. Error",
-        httr::status_code(assessments_get)
-      )
-    )
-    return(invisible(NULL))
-  }
-
-  assessments_text <- httr::content(assessments_get,
-                                    "text",
-                                    encoding = "ISO-8859-1")
-  assessments_json <- jsonlite::fromJSON(assessments_text)
-  list_data <- assessments_json[[2]]
+  out
+}
 
-  inventories_summary <- as.data.frame(list_data)
 
-  if (nrow(inventories_summary) == 0) {
-    stop("no data associated with specified database_id.", call. = FALSE)
-  }
 
-  colnames(inventories_summary) <- c("id", "assessment",
-                                     "date",
-                                     "site",
-                                     "practitioner")
-  inventories_summary$id <- as.double(inventories_summary$id)
-  inventories_summary$date[inventories_summary$date == "0000-00-00"] <-
-    NA
-  inventories_summary$date <- as.Date(inventories_summary$date)
-  class(inventories_summary) <- c("tbl_df",
-                                  "tbl",
-                                  "data.frame")
 
-  inventories_summary
-})
diff --git a/R/index_fqa_assessments_internal.R b/R/index_fqa_assessments_internal.R
new file mode 100644
index 0000000..827d156
--- /dev/null
+++ b/R/index_fqa_assessments_internal.R
@@ -0,0 +1,89 @@
+#' List all available public floristic quality assessments with possible null
+#' results cached
+#'
+#' @param database_id A numeric identifier of the desired database
+#' @return A data frame with 5 columns
+#'
+#' @import jsonlite httr
+#' @importFrom memoise memoise
+#'
+#' @noRd
+
+
+index_fqa_assessments_internal <- memoise::memoise(function(database_id) {
+  if (!is.numeric(database_id)) {
+    stop(
+      "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.",
+      call. = FALSE
+    )
+  }
+  if (database_id %% 1 != 0) {
+    stop(
+      "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.",
+      call. = FALSE
+    )
+  }
+  if (database_id == -40000) {
+    return(invisible(NULL))
+  } # for testing memoisation
+
+  assessments_address <-
+    paste0("http://universalfqa.org/get/database/",
+           database_id,
+           "/inventory")
+  ua <-
+    httr::user_agent("https://github.com/equitable-equations/fqar")
+
+  assessments_get <- tryCatch(httr::GET(assessments_address, ua),
+                              error = function(e){
+                                message("Unable to connect. Please check internet connection.")
+                                character(0)
+                              }
+  )
+
+  cl <- class(assessments_get)
+  if (cl != "response"){
+    return(invisible(NULL))
+  }
+
+  if (httr::http_error(assessments_get)) {
+    message(
+      paste(
+        "API request to universalFQA.org failed. Error",
+        httr::status_code(assessments_get)
+      )
+    )
+    return(invisible(NULL))
+  }
+
+  assessments_text <- httr::content(assessments_get,
+                                    "text",
+                                    encoding = "ISO-8859-1")
+  assessments_json <- jsonlite::fromJSON(assessments_text)
+  list_data <- assessments_json[[2]]
+
+  inventories_summary <- as.data.frame(list_data)
+
+  if (nrow(inventories_summary) == 0) {
+    stop("no data associated with specified database_id.", call. = FALSE)
+  }
+
+  colnames(inventories_summary) <- c("id", "assessment",
+                                     "date",
+                                     "site",
+                                     "practitioner")
+  inventories_summary$id <- as.double(inventories_summary$id)
+  inventories_summary$date[inventories_summary$date == "0000-00-00"] <-
+    NA
+  inventories_summary$date <- as.Date(inventories_summary$date)
+  class(inventories_summary) <- c("tbl_df",
+                                  "tbl",
+                                  "data.frame")
+
+  inventories_summary
+})
+
+
+
+
+
diff --git a/R/index_fqa_databases.R b/R/index_fqa_databases.R
index 4c62a39..2bfac60 100644
--- a/R/index_fqa_databases.R
+++ b/R/index_fqa_databases.R
@@ -12,8 +12,7 @@
 #'   \item description (character)
 #' }
 #'
-#' @import jsonlite httr
-#' @importFrom memoise memoise
+#' @importFrom memoise forget
 #'
 #' @examples
 #' databases <- index_fqa_databases()
@@ -21,41 +20,13 @@
 #' @export
 
 
-index_fqa_databases <- memoise::memoise(function() {
-  databases_address <- "http://universalfqa.org/get/database/"
-  ua <-
-    httr::user_agent("https://github.com/equitable-equations/fqar")
-
-  databases_get <- tryCatch(httr::GET(databases_address, ua),
-                            error = function(e){
-                              message("Unable to connect. Please check internet connection.")
-                              return(invisible(NULL))
-                            }
-  )
-  if (httr::http_error(databases_get)) {
-    message(
-      paste(
-        "API request to universalFQA.org failed. Error",
-        httr::status_code(assessments_get)
-      )
-    )
-    return(invisible(NULL))
+index_fqa_databases <- function() {
+  out <- index_fqa_databases_internal()
+  if (is.null(out)){
+    memoise::forget(index_fqa_databases_internal)
   }
+  out
+}
 
-  databases_text <- httr::content(databases_get,
-                                  "text",
-                                  encoding = "ISO-8859-1")
-  databases_json <- jsonlite::fromJSON(databases_text)
-  list_data <- databases_json[[2]]
-  databases <- as.data.frame(list_data)
 
-  databases[, c(1, 3)] <- lapply(databases[, c(1, 3)], as.double)
-  colnames(databases) <- c("database_id",
-                           "region", "year",
-                           "description")
-  class(databases) <- c("tbl_df",
-                        "tbl",
-                        "data.frame")
 
-  databases
-})
diff --git a/R/index_fqa_databases_internal.R b/R/index_fqa_databases_internal.R
new file mode 100644
index 0000000..74e9dc5
--- /dev/null
+++ b/R/index_fqa_databases_internal.R
@@ -0,0 +1,55 @@
+#' List all available floristic quality assessment databases with possible null results cached
+#'
+#' @return A data frame with 4 columns
+#' @import jsonlite httr
+#' @importFrom memoise memoise
+#'
+#'
+#' @noRd
+
+index_fqa_databases_internal <- memoise::memoise(function() {
+  databases_address <- "http://universalfqa.org/get/database/"
+  ua <-
+    httr::user_agent("https://github.com/equitable-equations/fqar")
+
+  databases_get <- tryCatch(httr::GET(databases_address, ua),
+                            error = function(e){
+                              message("Unable to connect. Please check internet connection.")
+                              character(0)
+                            }
+  )
+
+  cl <- class(databases_get)
+  if (cl != "response"){
+    return(invisible(NULL))
+  }
+
+  if (httr::http_error(databases_get)) {
+    message(
+      paste(
+        "API request to universalFQA.org failed. Error",
+        httr::status_code(assessments_get)
+      )
+    )
+    return(invisible(NULL))
+  }
+
+  databases_text <- httr::content(databases_get,
+                                  "text",
+                                  encoding = "ISO-8859-1")
+  databases_json <- jsonlite::fromJSON(databases_text)
+  list_data <- databases_json[[2]]
+  databases <- as.data.frame(list_data)
+
+  databases[, c(1, 3)] <- lapply(databases[, c(1, 3)], as.double)
+  colnames(databases) <- c("database_id",
+                           "region", "year",
+                           "description")
+  class(databases) <- c("tbl_df",
+                        "tbl",
+                        "data.frame")
+
+  databases
+})
+
+
diff --git a/R/index_fqa_transects.R b/R/index_fqa_transects.R
index a2b0ac0..0d53b57 100644
--- a/R/index_fqa_transects.R
+++ b/R/index_fqa_transects.R
@@ -18,8 +18,7 @@
 #'   \item practitioner (character)
 #'   }
 #'
-#' @import jsonlite httr
-#' @importFrom memoise memoise
+#' @importFrom memoise drop_cache
 #'
 #' @examples
 #' \donttest{
@@ -30,66 +29,13 @@
 #'
 #' @export
 
-index_fqa_transects <- memoise::memoise(function(database_id) {
-  if (!is.numeric(database_id)) {
-    stop(
-      "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.",
-      call. = FALSE
-    )
-  }
-  if (database_id %% 1 != 0) {
-    stop(
-      "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.",
-      call. = FALSE
-    )
-  }
-
-  trans_address <- paste0("http://universalfqa.org/get/database/",
-                          database_id,
-                          "/transect")
-  ua <-
-    httr::user_agent("https://github.com/equitable-equations/fqar")
-
-  trans_get <- tryCatch(httr::GET(trans_address, ua),
-                        error = function(e){
-                          message("Unable to connect. Please check internet connection.")
-                          return(invisible(NULL))
-                        }
-  )
-  if (httr::http_error(trans_get)) {
-    message(
-      paste(
-        "API request to universalFQA.org failed. Error",
-        httr::status_code(assessments_get)
-      )
-    )
-    return(invisible(NULL))
-  }
-
-  trans_text <- httr::content(trans_get,
-                              "text",
-                              encoding = "ISO-8859-1")
-  trans_json <- jsonlite::fromJSON(trans_text)
-  list_data <- trans_json[[2]]
-
-  transect_summary <- as.data.frame(list_data)
 
-  if (nrow(transect_summary) == 0) {
-    stop("no data associated with specified database_id.")
+index_fqa_transects <- function(database_id) {
+  out <- index_fqa_transects_internal(database_id)
+  if (is.null(out)){
+    memoise::drop_cache(index_fqa_transects_internal)({{ database_id }})
   }
+  out
+}
 
-  colnames(transect_summary) <- c("id",
-                                  "assessment",
-                                  "date",
-                                  "site",
-                                  "practitioner")
-  transect_summary$id <- as.double(transect_summary$id)
-  transect_summary$date[transect_summary$date == "0000-00-00"] <-
-    NA
-  transect_summary$date <- as.Date(transect_summary$date)
-  class(transect_summary) <- c("tbl_df",
-                               "tbl",
-                               "data.frame")
 
-  transect_summary
-})
diff --git a/R/index_fqa_transects_internal.R b/R/index_fqa_transects_internal.R
new file mode 100644
index 0000000..f60c06e
--- /dev/null
+++ b/R/index_fqa_transects_internal.R
@@ -0,0 +1,89 @@
+#' List all available public floristic quality transect assessments with possible null cached
+#'
+#' @param database_id A numeric identifier of the desired database
+#'
+#' @return A data frame with 5 columns
+#'
+#' @import jsonlite httr
+#' @importFrom memoise memoise
+#'
+#' @noRd
+
+index_fqa_transects_internal <- memoise::memoise(function(database_id) {
+  if (!is.numeric(database_id)) {
+    stop(
+      "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.",
+      call. = FALSE
+    )
+  }
+  if (database_id %% 1 != 0) {
+    stop(
+      "database_id must be an integer corresponding to an existing FQA database. Use index_fqa_databases() to obtain a data frame of valid options.",
+      call. = FALSE
+    )
+  }
+  if (database_id == -40000) {
+    return(invisible(NULL))
+  } # for testing memoisation
+
+  trans_address <- paste0("http://universalfqa.org/get/database/",
+                          database_id,
+                          "/transect")
+  ua <-
+    httr::user_agent("https://github.com/equitable-equations/fqar")
+
+  trans_get <- tryCatch(httr::GET(trans_address, ua),
+                        error = function(e){
+                          message("Unable to connect. Please check internet connection.")
+                          character(0)
+                        }
+  )
+
+  cl <- class(trans_get)
+  if (cl != "response"){
+    return(invisible(NULL))
+  }
+
+  if (httr::http_error(trans_get)) {
+    message(
+      paste(
+        "API request to universalFQA.org failed. Error",
+        httr::status_code(assessments_get)
+      )
+    )
+    return(invisible(NULL))
+  }
+
+  trans_text <- httr::content(trans_get,
+                              "text",
+                              encoding = "ISO-8859-1")
+  trans_json <- jsonlite::fromJSON(trans_text)
+  list_data <- trans_json[[2]]
+
+  transect_summary <- as.data.frame(list_data)
+
+  if (nrow(transect_summary) == 0) {
+    stop("no data associated with specified database_id.")
+  }
+
+  colnames(transect_summary) <- c("id",
+                                  "assessment",
+                                  "date",
+                                  "site",
+                                  "practitioner")
+  transect_summary$id <- as.double(transect_summary$id)
+  transect_summary$date[transect_summary$date == "0000-00-00"] <-
+    NA
+  transect_summary$date <- as.Date(transect_summary$date)
+  class(transect_summary) <- c("tbl_df",
+                               "tbl",
+                               "data.frame")
+
+  transect_summary
+})
+
+
+
+
+
+