From 5c1296ce748d0f0862f75979b4b935350735058d Mon Sep 17 00:00:00 2001 From: Ilja Kocken Date: Thu, 8 Jun 2023 17:41:09 -1000 Subject: [PATCH] rewrite/simplification of get_ZB18a cache logic and test cleanup --- R/get_solution.R | 137 +++++++++++++++----------- man/get_solution.Rd | 5 +- tests/testthat.R | 7 -- tests/testthat/_snaps/get_solution.md | 23 +++++ tests/testthat/test-get_solution.R | 1 + 5 files changed, 106 insertions(+), 67 deletions(-) diff --git a/R/get_solution.R b/R/get_solution.R index f61fa6d..31e6b15 100644 --- a/R/get_solution.R +++ b/R/get_solution.R @@ -14,7 +14,7 @@ #' get_solution() #' } #' @export -get_solution <- function(orbital_solution = "ZB18a", quiet = FALSE) { +get_solution <- function(orbital_solution = "ZB18a", quiet = FALSE, force = FALSE) { solutions <- c("ZB18a", "La11") if (!orbital_solution %in% solutions) { cli::cli_abort(c("{.var orbital_solution} must be one of: {.or {.q {solutions}}}", @@ -23,7 +23,7 @@ get_solution <- function(orbital_solution = "ZB18a", quiet = FALSE) { if (orbital_solution == "ZB18a") { # read in the (new?) cached result - dat <- get_ZB18a(quiet = quiet) + dat <- get_ZB18a(quiet = quiet, force = force) } if (orbital_solution == "La11") { ## dat <- snvecR::La11 @@ -59,79 +59,98 @@ get_ZB18a <- function(quiet = FALSE, force = FALSE) { ZB18a_url <- "http://www.soest.hawaii.edu/oceanography/faculty/zeebe_files/Astro/PrecTilt/OS/ZB18a/ems-plan3.dat" cachedir <- tools::R_user_dir("snvecR", which = "cache") + raw_path <- paste0(cachedir, "/ems-plan3.dat") csv_path <- paste0(cachedir, "/ZB18a.csv") rds_path <- paste0(cachedir, "/ZB18a.rds") - # if it doesn't exist, or the user wants to override the file - if (!file.exists(rds_path) || force) { - if (!file.exists(csv_path) || force) { - if (!quiet) cli::cli_alert_info("The orbital solution ZB18a has not been downloaded.") - - # default to Yes downloading if not interactive (i.e. GitHub actions) - if (!interactive()) { - download <- TRUE - # default to cache - save_cache <- TRUE - } else {# we're interactive - # a logical, TRUE if Yes, no if otherwise - download <- utils::menu(c("Yes", "No"), title = "Would you like to download and process it now?") == 1L + raw_col_names <- c("t", # time in days + "aa", # semimajor axis + "ee", # eccentricity + "inc", # inclination + "lph", # long periapse + "lan", # long ascending node + "arp", # argument of periapse + "mna") # mean anomaly + + # read final processed file from cache if available + if (!force && file.exists(rds_path)) { + ZB18a <- readr::read_rds(rds_path) + return(ZB18a) + } + + # read raw intermediate steps from disk + if (!force && (file.exists(csv_path) || file.exists(raw_path))) { + if (file.exists(csv_path)) { + ZB18a_raw <- readr::read_csv(csv_path, show_col_types = FALSE) + } + + if (file.exists(raw_path)) { + ZB18a_raw <- readr::read_table(raw_path, + col_names = raw_col_names, + skip = 3, comment = "#", + show_col_types = FALSE) + } + } else {# files don't exist or force + if (!quiet) cli::cli_alert_info("The orbital solution ZB18a has not been downloaded.") + + # default to downloading/caching if not interactive (i.e. GitHub actions) + if (force || !interactive()) { + download <- TRUE + save_cache <- TRUE + } else { + # a logical, TRUE if Yes, no if otherwise + download <- utils::menu(c("Yes", "No"), + title = "Would you like to download and process it now?") == 1L + if (download) { + save_cache <- utils::menu(c("Yes", "No"), + title = "Would you like to save the results to { +.file .csv} and { +.file .rds}?") == 1L + } else { + save_cache <- FALSE } + } + + # the user would NOT like to download and process the orbital solution + if (!download) { + cli::cli_abort("Cannot `get_ZB18a()` without downloading the file.") + } - # the user would NOT like to download and process the orbital solution - if (!download) { - cli::cli_abort("Cannot `get_ZB18a()` without downloading the file.") - } else {# the user would like to download and process the orbital solution - if (interactive()) { - save_cache <- utils::menu(c("Yes", "No"), title = "Would you like to save the results to the cache?") == 1L - } - - if (!quiet) cli::cli_alert_info("Reading {.file {basename(raw_path)}} from website {.url {ZB18a_url}}.") - - # read the file from the website - ZB18a <- readr::read_table(ZB18a_url, - col_names = c("t", # time in days - "aa", # semimajor axis - "ee", # eccentricity - "inc", # inclination - "lph", # long periapse - "lan", # long ascending node - "arp", # argument of periapse - "mna"), # mean anomaly - skip = 3, - comment = "#", + # read the file from the website + ZB18a_raw <- readr::read_table(ZB18a_url, + col_names = raw_col_names, + skip = 3, comment = "#", show_col_types = FALSE) + if (!quiet) cli::cli_alert_info("Read {.file {basename(raw_path)}} from website {.url {ZB18a_url}}.") + + # calculate helper columns + ZB18a <- ZB18a_raw |> prepare_solution(quiet = quiet) - if (save_cache) { - dir.create(cachedir, recursive = TRUE, showWarnings = FALSE) - if (!quiet) cli::cli_alert_info("The cache directory is {.file {cachedir}}.") - # also copy the raw file to disk, even though we've read it in using read_table directly - curl::curl_download(ZB18a_url, destfile = raw_path) - if (!quiet) cli::cli_alert_info("Saved {.file {basename(raw_path)}} to cache.") - - # write intermediate result to csv - readr::write_csv(ZB18a, csv_path) - if (!quiet) cli::cli_alert_info("Saved cleaned-up {.file {basename(csv_path)}} to cache.") - } + if (!save_cache) { + return(ZB18a) + } else { + if (!dir.exists(cachedir)) { + dir.create(cachedir, recursive = TRUE, showWarnings = TRUE) } - } else {# if we've downloaded the file but haven't prepared the solution somehow - ZB18a <- readr::read_csv(csv_path, show_col_types = FALSE) - } + if (!quiet) cli::cli_alert_info("The cache directory is {.file {cachedir}}.") + + # also copy the raw file to disk + # even though we've read it in using read_table directly + curl::curl_download(ZB18a_url, destfile = raw_path) + if (!quiet) cli::cli_alert_info("Saved {.file {basename(raw_path)}} to cache.") - # prepare the solution (i.e. calculate helper columns) - ZB18a <- ZB18a |> - prepare_solution(quiet = quiet) + # write intermediate result to csv + readr::write_csv(ZB18a_raw, csv_path) + if (!quiet) cli::cli_alert_info("Saved cleaned-up {.file {basename(csv_path)}} to cache.") - if (save_cache) { + # write final result to rds cache readr::write_rds(ZB18a, rds_path) if (!quiet) { cli::cli_alert("Saved solution with helper columns {.file {basename(rds_path)}} to cache.", "i" = "Future runs will read from the cache, unless you specify `force = TRUE`.") } } - } else {# if the rds file already exist, read it from the cache - ZB18a <- readr::read_rds(rds_path) + return(ZB18a) } - - return(ZB18a) } diff --git a/man/get_solution.Rd b/man/get_solution.Rd index fbfa567..64564a6 100644 --- a/man/get_solution.Rd +++ b/man/get_solution.Rd @@ -4,7 +4,7 @@ \alias{get_solution} \title{Get an Orbital Solution} \usage{ -get_solution(orbital_solution = "ZB18a", quiet = FALSE) +get_solution(orbital_solution = "ZB18a", quiet = FALSE, force = FALSE) } \arguments{ \item{orbital_solution}{Character vector with the name of the orbital @@ -16,6 +16,9 @@ or \code{"La11"} (not yet implemented!).} \item If \code{TRUE}, hide info messages. \item If \code{FALSE} (the default) print info messages and timing. }} + +\item{force}{Force re-downloading the results, even if the solution is saved +to the cache.} } \value{ \code{get_solution()} returns a \link[tibble:tibble-package]{tibble} with the diff --git a/tests/testthat.R b/tests/testthat.R index ca4a717..f8fb6a1 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -10,10 +10,3 @@ library(testthat) library(snvecR) test_check("snvecR") - -# clean up after tests -cachedir <- tools::R_user_dir("snvecR", which = "cache") -if (dir.exists(cachedir)) { - cli::cli_inform("Removing {.file {cachedir}} from reproducible environment.") - unlink(cachedir, recursive = TRUE) -} diff --git a/tests/testthat/_snaps/get_solution.md b/tests/testthat/_snaps/get_solution.md index bb85cd8..3b60459 100644 --- a/tests/testthat/_snaps/get_solution.md +++ b/tests/testthat/_snaps/get_solution.md @@ -13,3 +13,26 @@ 5 -584400 1.6 1.00 0.0173 7.11 22.1 -178. -160. 12.8 22.1 182. 0.00653 0.0161 -0.00359 -0.124 0.992 0.998 -0.00359 0.124 0.992 6 -730500 2 1.00 0.0175 7.10 21.0 -178. -161. 16.4 21.0 182. 0.00627 0.0163 -0.00449 -0.124 0.992 0.998 -0.00448 0.123 0.992 +--- + + Code + head(get_solution(orbital_solution = "ZB18a", quiet = FALSE, force = TRUE)) + Message + i The orbital solution ZB18a has not been downloaded. + i Read 'ems-plan3.dat' from website . + i Calculating helper columns. + i The cache directory is '/home/japhir/.cache/R/snvecR'. + i Saved 'ems-plan3.dat' to cache. + i Saved cleaned-up 'ZB18a.csv' to cache. + > Saved solution with helper columns 'ZB18a.rds' to cache. + Output + # A tibble: 6 x 20 + t age aa ee inc lph lan arp mna lphu lanu hh kk pp qq cc dd nnx nny nnz + + 1 0 0 1.00 0.0167 7.15 27.3 180. -153. -2.45 27.3 180. 0.00767 0.0148 0.00000164 -0.125 0.992 0.998 0.00000163 0.125 0.992 + 2 -146100 0.4 1.00 0.0169 7.15 26.1 -180. -154. 1.27 26.1 180. 0.00742 0.0151 -0.000902 -0.125 0.992 0.998 -0.000900 0.124 0.992 + 3 -292200 0.8 1.00 0.0171 7.14 24.7 -179. -156. 5.22 24.7 181. 0.00713 0.0155 -0.00180 -0.124 0.992 0.998 -0.00180 0.124 0.992 + 4 -438300 1.2 1.00 0.0172 7.12 23.7 -179. -158. 8.75 23.7 181. 0.00690 0.0157 -0.00270 -0.124 0.992 0.998 -0.00270 0.124 0.992 + 5 -584400 1.6 1.00 0.0173 7.11 22.1 -178. -160. 12.8 22.1 182. 0.00653 0.0161 -0.00359 -0.124 0.992 0.998 -0.00359 0.124 0.992 + 6 -730500 2 1.00 0.0175 7.10 21.0 -178. -161. 16.4 21.0 182. 0.00627 0.0163 -0.00449 -0.124 0.992 0.998 -0.00448 0.123 0.992 + diff --git a/tests/testthat/test-get_solution.R b/tests/testthat/test-get_solution.R index 03ce46c..85e3970 100644 --- a/tests/testthat/test-get_solution.R +++ b/tests/testthat/test-get_solution.R @@ -6,4 +6,5 @@ test_that("get_solution() inputs are checked", { test_that("get_solution() works", { withr::local_options(width = 150) expect_snapshot(get_solution(orbital_solution = "ZB18a", quiet = TRUE) |> head()) + expect_snapshot(get_solution(orbital_solution = "ZB18a", quiet = FALSE, force = TRUE) |> head()) })