Skip to content

Commit

Permalink
rewrite/simplification of get_ZB18a cache logic and test cleanup
Browse files Browse the repository at this point in the history
  • Loading branch information
@japhir
japhir committed Jun 9, 2023
1 parent b3769c7 commit 5c1296c
Show file tree
Hide file tree
Showing 5 changed files with 106 additions and 67 deletions.
137 changes: 78 additions & 59 deletions R/get_solution.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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}}}",
Expand All @@ -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
Expand Down Expand Up @@ -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)
}
5 changes: 4 additions & 1 deletion man/get_solution.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

7 changes: 0 additions & 7 deletions tests/testthat.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}
23 changes: 23 additions & 0 deletions tests/testthat/_snaps/get_solution.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 <http://www.soest.hawaii.edu/oceanography/faculty/zeebe_files/Astro/PrecTilt/OS/ZB18a/ems-plan3.dat>.
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
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
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

1 change: 1 addition & 0 deletions tests/testthat/test-get_solution.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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())
})

0 comments on commit 5c1296c

Please sign in to comment.