Merge pull request #330 from 4DModeller/326-joss-review-homedir

fdmr::retrieve_tutorial_data should not modify the home directory

R/util_paths.R

@@ -2,11 +2,12 @@
 #'
 #' @param dataset Name of dataset
 #' @param filename Name of file
+#' @param saved Specify the location where user unpacked the data.
 #'
 #' @return fs::path Full filepath
 #' @export
-get_tutorial_datapath <- function(dataset, filename) {
-  tutorial_datapath <- fs::path(get_tutorial_cache_datapath(), dataset)
+get_tutorial_datapath <- function(dataset, filename, saved = FALSE) {
+  tutorial_datapath <- fs::path(get_tutorial_cache_datapath(saved), dataset)
 
   if (!fs::dir_exists(tutorial_datapath)) {
     stop("Unable to load data, the folder ", toString(tutorial_datapath), " does not exist. Have you run retrieve_tutorial_data?")
@@ -26,15 +27,16 @@ get_tutorial_datapath <- function(dataset, filename) {
 #'
 #' @param dataset Name of dataset
 #' @param filename Name of file
+#' @param saved Specify the location where user unpacked the data
 #'
 #' @return loaded object
 #' @export
-load_tutorial_data <- function(dataset, filename) {
+load_tutorial_data <- function(dataset, filename, saved = FALSE) {
   if (!tolower(fs::path_ext(filename)) == "rds") {
     stop("We can only load rds files.")
   }
 
-  fpath <- get_tutorial_datapath(dataset = dataset, filename = filename)
+  fpath <- get_tutorial_datapath(dataset = dataset, filename = filename, saved = saved)
   return(readRDS(fpath))
 }
 
@@ -62,30 +64,55 @@ clean_path <- function(path, check_exists = FALSE) {
   return(fpath)
 }
 
+
 #' Get path to tutorial data cache folder
+#' 
+#' @param saved Specify the location where user unpacked the data
 #'
 #' @return fs::path
 #' @keywords internal
-get_tutorial_cache_datapath <- function() {
-  fs::path(fs::path_home(), "fdmr", "tutorial_data")
+get_tutorial_cache_datapath <- function(saved) {
+  if (base::isTRUE(saved) | base::is.character(saved)){
+    if (base::is.character(saved)) {
+      save_path <- check_path(saved)
+      fs::path(save_path, "fdmr", "tutorial_data")
+    } else{
+      fs::path(fs::path_home(), "fdmr", "tutorial_data")
+    }
+  } else {
+    fs::path(fs::path_temp(), "fdmr", "tutorial_data")
+  }
 }
 
 #' Get path to downloaded archive cache folder
+#' 
+#' @param saved Specify the location where user unpacked the data
 #'
 #' @return fs::path
 #' @keywords internal
-get_archive_cache_datapath <- function() {
-  fs::path(fs::path_home(), "fdmr", "download_cache")
+get_archive_cache_datapath <- function(saved) {
+  if (base::isTRUE(saved) | base::is.character(saved)){
+    if (base::is.character(saved)) {
+      save_path <- check_path(saved)
+      fs::path(save_path, "fdmr", "download_cache")
+    } else{
+      fs::path(fs::path_home(), "fdmr", "download_cache")
+    }
+  } else {
+    fs::path(fs::path_temp(), "fdmr", "download_cache")
+  }
 }
 
 
 #' Clear both tutorial data and downloaded archive caches
 #'
+#' @param saved Specify the location where user unpacked the data
+#'
 #' @return NULL
 #' @export
-clear_caches <- function() {
-  tut_path <- get_tutorial_cache_datapath()
-  cache_path <- get_archive_cache_datapath()
+clear_caches <- function(saved = TRUE) {
+  tut_path <- get_tutorial_cache_datapath(saved)
+  cache_path <- get_archive_cache_datapath(saved)
   print(paste("Deleting ", tut_path, cache_path))
   fs::dir_delete(tut_path)
   fs::dir_delete(cache_path)

R/util_retrieve.R

@@ -1,14 +1,25 @@
-#' Retrieve a tutorial dataset and unpacks it to ~/fdmr/tutorial_data
+#' Retrieves a tutorial dataset and unpacks it to a place specified by the user (~/fdmr/tutorial_data)
 #'
 #' @param dataset Name of dataset to retrieve
 #' @param force_update Force retrieval of metadata and dataset
+#' @param save Unpack the dataset to where user specified (character), home directory (TRUE), session's temporary directory (FALSE: default).
 #'
 #' @return NULL
 #' @export
-retrieve_tutorial_data <- function(dataset, force_update = FALSE) {
+retrieve_tutorial_data <- function(dataset, force_update = FALSE, save = FALSE) {
   dataset <- base::tolower(dataset)
 
-  download_cache_folder <- fs::path(fs::path_home(), "fdmr", "download_cache")
+  if (base::isTRUE(save) | base::is.character(save)){
+    if (base::is.character(save)) {
+      save_path <- clean_path(save, check_exists = TRUE)
+      download_cache_folder <- fs::path(save_path, "fdmr", "download_cache")
+    } else{
+      download_cache_folder <- fs::path(fs::path_home(), "fdmr", "download_cache")
+    }
+  } else {
+    download_cache_folder <- fs::path(fs::path_temp(), "fdmr", "download_cache")
+    }
+
   if (!fs::dir_exists(download_cache_folder)) {
     fs::dir_create(download_cache_folder, recurse = TRUE)
   }
@@ -40,7 +51,17 @@ retrieve_tutorial_data <- function(dataset, force_update = FALSE) {
     jsonlite::write_json(retrieval_info, path = file_metadata_file)
   }
 
-  extract_path <- fs::path(fs::path_home(), "fdmr", "tutorial_data", dataset)
+  if (base::isTRUE(save) | base::is.character(save)){
+    if (base::is.character(save)){
+      save_path <- clean_path(save, check_exists = TRUE)
+      extract_path <- fs::path(save_path, "fdmr", "tutorial_data", dataset)
+    } else{
+      extract_path <- fs::path(fs::path_home(), "fdmr", "tutorial_data", dataset)
+    }
+  } else {
+    extract_path <- fs::path(fs::path_temp(), "fdmr", "tutorial_data", dataset)
+    }
+
 
   if (!fs::dir_exists(extract_path)) {
     fs::dir_create(extract_path, recurse = TRUE)
@@ -72,4 +93,4 @@ retrieve_tutorial_data <- function(dataset, force_update = FALSE) {
   } else {
     stop("Invalid dataset, please see available datasets at https://github.com/4DModeller/fdmr_data")
   }
-}
+}

vignettes/expected_data_structure.Rmd

@@ -18,6 +18,7 @@ In this tutorial, we will show the expected data structure for running the Bayes
 In the [COVID-19 tutorial](https://4dmodeller.github.io/fdmr/articles/covid.html), we aim to fit a Bayesian spatio-temporal model to predict the COVID-19 infection rates across mainland England over space and time, and investigate the impacts of socioeconomic, demographic and environmental factors on COVID-19 infection. We load the dataset `covid19_data` and the type of this object is a `data.frame`. 
 
 ```{r classcovidat}
+fdmr::retrieve_tutorial_data(dataset = "covid")
 covid19_data <- fdmr::load_tutorial_data(dataset = "covid", filename = "covid19_data.rds")
 class(covid19_data)
 ```