From acbb13b7f69832c18be6acbf10e87cccfff4159d Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Thu, 7 Apr 2022 14:48:08 -0700 Subject: [PATCH 01/14] Update evaluate.R --- R/evaluate.R | 29 ++++++++++++++++++++++++----- 1 file changed, 24 insertions(+), 5 deletions(-) diff --git a/R/evaluate.R b/R/evaluate.R index 8f4fc4912..7522f4b08 100644 --- a/R/evaluate.R +++ b/R/evaluate.R @@ -8,9 +8,6 @@ #' #' @param settings \code{list} of controls for the directory, with defaults set in \code{\link{directory_settings}} that should generally not need to be altered. #' -#' @param cast_group,cast_groups \code{integer} (or integer \code{numeric}) value(s) of the cast group(s) to evaluate, as indexed within the directory in the \code{casts} sub folder. See the casts metadata file (\code{casts_metadata.csv}) for summary information. \cr -#' \code{cast_group} can only be a single value, whereas \code{cast_groups} can be multiple. -#' #' @param cast_id,cast_ids \code{integer} (or integer \code{numeric}) value(s) representing the casts of interest for evaluating, as indexed within the directory in the \code{casts} sub folder. See the casts metadata file (\code{casts_metadata.csv}) for summary information. \cr #' \code{cast_id} can only be a single value, whereas \code{cast_ids} can be multiple. #' @@ -26,12 +23,35 @@ #' evaluate_casts <- function (main = ".", settings = directory_settings(), - cast_groups = NULL, cast_ids = NULL, quiet = FALSE, verbose = FALSE) { + casts_to_evaluate <- select_casts(main = main, + settings = settings, + cast_ids = cast_ids) + + if (NROW(casts_to_evaluate) == 0) { + + stop("no casts available for request") + + } else { + + cast_ids <- casts_to_evaluate$cast_id + ncasts_ids <- length(cast_ids) + + } + + for (i in 1:ncast_ids) { + + evaluate_cast(main = main, + settings = settings, + cast_id = cast_ids[i], + quiet = quiet, + verbose = verbose) + + } invisible() @@ -44,7 +64,6 @@ evaluate_casts <- function (main = ".", #' evaluate_cast <- function (main = ".", settings = directory_settings(), - cast_group = NULL, cast_id = NULL, quiet = FALSE, verbose = FALSE) { From 173ef98191e12e0a38b402800299d3a5c437d90e Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Thu, 7 Apr 2022 14:49:50 -0700 Subject: [PATCH 02/14] doc --- DESCRIPTION | 2 +- NEWS.md | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index a36d2a946..cf2e38874 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: portalcasting Title: Functions Used in Predicting Portal Rodent Dynamics -Version: 0.35.0 +Version: 0.36.0 Authors@R: c( person(c("Juniper", "L."), "Simonis", email = "juniper.simonis@weecology.org", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 6f4688608..49ceacb60 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,13 @@ Version numbers follow [Semantic Versioning](https://semver.org/). +# portalcasting 0.36.0 +*In Progress* + +### Building out evaluation pipeline +* starting with what is already occurring, but formalizing as such + + # [portalcasting 0.35.0](https://github.com/weecology/portalcasting/releases/tag/v0.35.0) *2022-04-07* From d3c37e404fc4b6d5c30d1d6df93411d38a744b31 Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Thu, 7 Apr 2022 17:38:56 -0700 Subject: [PATCH 03/14] Update test-22-evaluate.R --- tests/testthat/test-22-evaluate.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-22-evaluate.R b/tests/testthat/test-22-evaluate.R index 96b4f0be1..efcf18401 100644 --- a/tests/testthat/test-22-evaluate.R +++ b/tests/testthat/test-22-evaluate.R @@ -1,15 +1,17 @@ context(desc = "evaluate functions") +main <- "./testing" + test_that(desc = "evaluate_casts evaluates casts", { - expect_null(evaluate_casts()) + expect_null(evaluate_casts(main = main)) }) test_that(desc = "evaluate_cast evaluates cast", { - expect_null(evaluate_cast()) + expect_null(evaluate_cast(main = main)) }) From 6bc31af836b527c37cd0d3e86c2399ecaa9a0879 Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Thu, 7 Apr 2022 18:06:27 -0700 Subject: [PATCH 04/14] Update evaluate.R --- R/evaluate.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/evaluate.R b/R/evaluate.R index 7522f4b08..d2bcfc934 100644 --- a/R/evaluate.R +++ b/R/evaluate.R @@ -38,8 +38,8 @@ evaluate_casts <- function (main = ".", } else { - cast_ids <- casts_to_evaluate$cast_id - ncasts_ids <- length(cast_ids) + cast_ids <- casts_to_evaluate$cast_id + ncast_ids <- length(cast_ids) } @@ -69,7 +69,6 @@ evaluate_cast <- function (main = ".", verbose = FALSE) { - invisible() } From c8006da7a73b06aef1fe29440a4f9abc7d4b055a Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Thu, 7 Apr 2022 18:20:05 -0700 Subject: [PATCH 05/14] ongoing eval work --- R/evaluate.R | 9 ++++++ R/prepare_models.R | 4 +++ R/process_casts.R | 58 ++++++++++++++++++++++++--------------- man/evaluate-forecasts.Rd | 5 ---- man/read-cast-output.Rd | 10 +++---- 5 files changed, 54 insertions(+), 32 deletions(-) diff --git a/R/evaluate.R b/R/evaluate.R index d2bcfc934..07219fe35 100644 --- a/R/evaluate.R +++ b/R/evaluate.R @@ -68,6 +68,15 @@ evaluate_cast <- function (main = ".", quiet = FALSE, verbose = FALSE) { + model_cast <- read_model_cast(main = main, + cast_id = cast_id, + settings = settings) + casts_metadata <- read_casts_metadata(main = main, + settings = settings) + + model <- casts_metadata$model[casts_metadata$cast_id == cast_id] + + invisible() diff --git a/R/prepare_models.R b/R/prepare_models.R index d6e3223f3..6c46fbb89 100644 --- a/R/prepare_models.R +++ b/R/prepare_models.R @@ -75,6 +75,10 @@ write_model_controls <- function (main = ".", } + + + + #' @title Write Model Function Script into Directory #' #' @description Writes a model's function as a script into the defined directory for use in forecasting. \cr \cr \code{model} can be input as a \code{character} string, symbol (backquoted name), or \code{function}, as \code{\link{match.fun}} diff --git a/R/process_casts.R b/R/process_casts.R index b63b39772..3fcb6e884 100644 --- a/R/process_casts.R +++ b/R/process_casts.R @@ -221,8 +221,8 @@ add_obs_to_cast_tab <- function (main = ".", #' @export #' read_cast_tab <- function (main = ".", - settings = directory_settings(), - cast_id = NULL) { + cast_id = NULL, + settings = directory_settings()) { if (is.null(cast_id) ){ @@ -257,8 +257,8 @@ read_cast_tab <- function (main = ".", #' @export #' read_cast_tabs <- function (main = ".", - settings = directory_settings(), - cast_ids = NULL) { + cast_ids = NULL, + settings = directory_settings()) { if (is.null(cast_ids)) { @@ -269,8 +269,8 @@ read_cast_tabs <- function (main = ".", } cast_tab <- read_cast_tab(main = main, - settings = settings, - cast_id = cast_ids[1]) + cast_id = cast_ids[1], + settings = settings) ncasts <- length(cast_ids) @@ -278,9 +278,9 @@ read_cast_tabs <- function (main = ".", for (i in 2:ncasts) { - cast_tab_i <- read_cast_tab(main = main, - settings = settings, - cast_id = cast_ids[i]) + cast_tab_i <- read_cast_tab(main = main, + cast_id = cast_ids[i], + settings = settings) cast_tab <- rbind(cast_tab, cast_tab_i) @@ -297,8 +297,8 @@ read_cast_tabs <- function (main = ".", #' @export #' read_cast_metadata <- function (main = ".", - settings = directory_settings(), - cast_id = NULL) { + cast_id = NULL, + settings = directory_settings()) { if (is.null(cast_id)) { @@ -326,8 +326,8 @@ read_cast_metadata <- function (main = ".", #' @export #' read_model_fit <- function (main = ".", - settings = directory_settings(), - cast_id = NULL) { + cast_id = NULL, + settings = directory_settings()) { if (is.null(cast_id)) { @@ -356,8 +356,8 @@ read_model_fit <- function (main = ".", #' @export #' read_model_cast <- function (main = ".", - settings = directory_settings(), - cast_id = NULL) { + cast_id = NULL, + settings = directory_settings()) { if (is.null(cast_id)) { @@ -367,17 +367,31 @@ read_model_cast <- function (main = ".", } - lpath <- paste0("cast_id_", cast_id, "_model_casts.json") - cpath <- file.path(main, settings$subs$forecasts, lpath) + lpath_json <- paste0("cast_id_", cast_id, "_model_casts.json") + cpath_json <- file.path(main, settings$subs$forecasts, lpath_json) - if (!file.exists(cpath)) { + lpath_RData <- paste0("cast_id_", cast_id, "_model_casts.RData") + cpath_RData <- file.path(main, settings$subs$forecasts, lpath_RData) - stop("cast_id does not have a model_casts file") + if (!file.exists(cpath_json)) { - } + if (!file.exists(cpath_RData)) { - read_in_json <- fromJSON(readLines(cpath)) - unserializeJSON(read_in_json) + stop("cast_id does not have a model_casts file") + + } else { + + load(cpath_RData) + model_casts + + } + + } else { + + read_in_json <- fromJSON(readLines(cpath_json)) + unserializeJSON(read_in_json) + + } } diff --git a/man/evaluate-forecasts.Rd b/man/evaluate-forecasts.Rd index 9936cadbc..5c187164b 100644 --- a/man/evaluate-forecasts.Rd +++ b/man/evaluate-forecasts.Rd @@ -9,7 +9,6 @@ evaluate_casts( main = ".", settings = directory_settings(), - cast_groups = NULL, cast_ids = NULL, quiet = FALSE, verbose = FALSE @@ -18,7 +17,6 @@ evaluate_casts( evaluate_cast( main = ".", settings = directory_settings(), - cast_group = NULL, cast_id = NULL, quiet = FALSE, verbose = FALSE @@ -33,9 +31,6 @@ evaluate_cast( \item{verbose}{\code{logical} indicator of whether or not to print out all of the information (and thus just the tidy messages).} -\item{cast_group, cast_groups}{\code{integer} (or integer \code{numeric}) value(s) of the cast group(s) to evaluate, as indexed within the directory in the \code{casts} sub folder. See the casts metadata file (\code{casts_metadata.csv}) for summary information. \cr -\code{cast_group} can only be a single value, whereas \code{cast_groups} can be multiple.} - \item{cast_id, cast_ids}{\code{integer} (or integer \code{numeric}) value(s) representing the casts of interest for evaluating, as indexed within the directory in the \code{casts} sub folder. See the casts metadata file (\code{casts_metadata.csv}) for summary information. \cr \code{cast_id} can only be a single value, whereas \code{cast_ids} can be multiple.} } diff --git a/man/read-cast-output.Rd b/man/read-cast-output.Rd index 3eb0ce562..a61ccbe4e 100644 --- a/man/read-cast-output.Rd +++ b/man/read-cast-output.Rd @@ -9,15 +9,15 @@ \alias{read_model_cast} \title{Read in Cast Output From a Given Cast} \usage{ -read_cast_tab(main = ".", settings = directory_settings(), cast_id = NULL) +read_cast_tab(main = ".", cast_id = NULL, settings = directory_settings()) -read_cast_tabs(main = ".", settings = directory_settings(), cast_ids = NULL) +read_cast_tabs(main = ".", cast_ids = NULL, settings = directory_settings()) -read_cast_metadata(main = ".", settings = directory_settings(), cast_id = NULL) +read_cast_metadata(main = ".", cast_id = NULL, settings = directory_settings()) -read_model_fit(main = ".", settings = directory_settings(), cast_id = NULL) +read_model_fit(main = ".", cast_id = NULL, settings = directory_settings()) -read_model_cast(main = ".", settings = directory_settings(), cast_id = NULL) +read_model_cast(main = ".", cast_id = NULL, settings = directory_settings()) } \arguments{ \item{main}{\code{character} value of the name of the main component of the directory tree.} From 7966dfcbcd2224d3e9cef91d7cffab9887040ed0 Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Thu, 7 Apr 2022 18:41:54 -0700 Subject: [PATCH 06/14] bringing existing evaluation into evaluate cast function --- R/evaluate.R | 42 ++++++++++++++++++++++++++++++++---------- R/prepare_models.R | 2 +- 2 files changed, 33 insertions(+), 11 deletions(-) diff --git a/R/evaluate.R b/R/evaluate.R index 07219fe35..e32ced197 100644 --- a/R/evaluate.R +++ b/R/evaluate.R @@ -21,16 +21,16 @@ #' #' @export #' -evaluate_casts <- function (main = ".", - settings = directory_settings(), - cast_ids = NULL, - quiet = FALSE, - verbose = FALSE) { +evaluate_casts <- function (main = ".", + settings = directory_settings(), + cast_ids = NULL, + quiet = FALSE, + verbose = FALSE) { - casts_to_evaluate <- select_casts(main = main, - settings = settings, - cast_ids = cast_ids) + casts_to_evaluate <- select_casts(main = main, + settings = settings, + cast_ids = cast_ids) if (NROW(casts_to_evaluate) == 0) { @@ -73,10 +73,32 @@ evaluate_cast <- function (main = ".", settings = settings) casts_metadata <- read_casts_metadata(main = main, settings = settings) + cast_model <- casts_metadata$model[casts_metadata$cast_id == cast_id] + + cast_model_controls <- model_controls(main = main, + model = model, + settings = settings) + cast_model_response <- cast_model_controls$response + + cast_tab <- read_cast_tab(main = main, + settings = settings, + cast_id = cast_id) + + cast_tab <- add_obs_to_cast_tab(main = main, + settings = settings, + cast_tab = cast_tab) + cast_tab <- add_err_to_cast_tab(main = main, + settings = settings, + cast_tab = cast_tab) + cast_tab <- add_lead_to_cast_tab(main = main, + settings = settings, + cast_tab = cast_tab) + cast_tab <- add_covered_to_cast_tab(main = main, + settings = settings, + cast_tab = cast_tab) + cast_err <- measure_cast_level_error(cast_tab = cast_tab) - model <- casts_metadata$model[casts_metadata$cast_id == cast_id] - invisible() diff --git a/R/prepare_models.R b/R/prepare_models.R index 6c46fbb89..957c4f3b1 100644 --- a/R/prepare_models.R +++ b/R/prepare_models.R @@ -35,7 +35,7 @@ model_controls <- function (main = ".", settings = directory_settings()) { read_model_controls(main = main, - settings = settings)[models] + settings = settings)[[models]] } From 3491fa6dee9ac742216dc1a0f3a56828cd3278e1 Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Thu, 7 Apr 2022 19:59:29 -0700 Subject: [PATCH 07/14] Update evaluate.R --- R/evaluate.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/evaluate.R b/R/evaluate.R index e32ced197..56494c7b7 100644 --- a/R/evaluate.R +++ b/R/evaluate.R @@ -76,7 +76,7 @@ evaluate_cast <- function (main = ".", cast_model <- casts_metadata$model[casts_metadata$cast_id == cast_id] cast_model_controls <- model_controls(main = main, - model = model, + model = cast_model, settings = settings) cast_model_response <- cast_model_controls$response From 244329d7b8c178db7eb3b5fbbc365654584f66f1 Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Thu, 7 Apr 2022 20:35:37 -0700 Subject: [PATCH 08/14] try --- R/evaluate.R | 2 +- R/prepare_models.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/evaluate.R b/R/evaluate.R index 56494c7b7..7dadf0633 100644 --- a/R/evaluate.R +++ b/R/evaluate.R @@ -77,7 +77,7 @@ evaluate_cast <- function (main = ".", cast_model_controls <- model_controls(main = main, model = cast_model, - settings = settings) + settings = settings)[[cast_model]] cast_model_response <- cast_model_controls$response cast_tab <- read_cast_tab(main = main, diff --git a/R/prepare_models.R b/R/prepare_models.R index 957c4f3b1..6c46fbb89 100644 --- a/R/prepare_models.R +++ b/R/prepare_models.R @@ -35,7 +35,7 @@ model_controls <- function (main = ".", settings = directory_settings()) { read_model_controls(main = main, - settings = settings)[[models]] + settings = settings)[models] } From 502137017dff2c3ae3ae30ba759a267d167c9d5e Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Thu, 7 Apr 2022 22:17:11 -0700 Subject: [PATCH 09/14] Update evaluate.R --- R/evaluate.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/evaluate.R b/R/evaluate.R index 7dadf0633..3aa42e357 100644 --- a/R/evaluate.R +++ b/R/evaluate.R @@ -76,7 +76,7 @@ evaluate_cast <- function (main = ".", cast_model <- casts_metadata$model[casts_metadata$cast_id == cast_id] cast_model_controls <- model_controls(main = main, - model = cast_model, + models = cast_model, settings = settings)[[cast_model]] cast_model_response <- cast_model_controls$response From 59c104277f441f2df94c6cf01a4dfc8e30a0dcf0 Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Thu, 7 Apr 2022 22:43:47 -0700 Subject: [PATCH 10/14] null return --- R/evaluate.R | 2 + R/portalcast.R | 5 + R/prepare_rodents.R | 2 - R/process_casts.R | 1 + code_development/hold_modelcontrols.R | 52 ------- code_development/hold_rodentcontrols.R | 200 ------------------------- code_development/notes.R | 17 +++ man/prepare-rodents.Rd | 2 - 8 files changed, 25 insertions(+), 256 deletions(-) delete mode 100644 code_development/hold_modelcontrols.R delete mode 100644 code_development/hold_rodentcontrols.R diff --git a/R/evaluate.R b/R/evaluate.R index 3aa42e357..c2d7803c5 100644 --- a/R/evaluate.R +++ b/R/evaluate.R @@ -68,6 +68,8 @@ evaluate_cast <- function (main = ".", quiet = FALSE, verbose = FALSE) { + return_if_null(cast_id) + model_cast <- read_model_cast(main = main, cast_id = cast_id, settings = settings) diff --git a/R/portalcast.R b/R/portalcast.R index c48dc00fd..c1363531e 100644 --- a/R/portalcast.R +++ b/R/portalcast.R @@ -46,6 +46,11 @@ portalcast <- function (main = ".", quiet = FALSE, verbose = FALSE){ +# +# the datasets here should come from the models selected +# and not as an argument +# + return_if_null(models) messageq(message_break(), "\nPreparing directory for casting\n", message_break(), "\nThis is portalcasting v", packageDescription("portalcasting", fields = "Version"), "\n", message_break(), quiet = quiet) diff --git a/R/prepare_rodents.R b/R/prepare_rodents.R index 367f16a39..6ded56029 100644 --- a/R/prepare_rodents.R +++ b/R/prepare_rodents.R @@ -87,8 +87,6 @@ write_dataset_controls <- function (main = ".", #' #' @param settings \code{list} of controls for the directory, with defaults set in \code{\link{directory_settings}}. #' -#' @param new_dataset_controls \code{list} of controls for any new datasets (not in the prefab datasets) listed in \code{dataset}. -#' #' @return \code{list} of prepared \code{datasets}. #' #' @name prepare rodents diff --git a/R/process_casts.R b/R/process_casts.R index 3fcb6e884..e753db8ad 100644 --- a/R/process_casts.R +++ b/R/process_casts.R @@ -381,6 +381,7 @@ read_model_cast <- function (main = ".", } else { + model_casts <- NULL load(cpath_RData) model_casts diff --git a/code_development/hold_modelcontrols.R b/code_development/hold_modelcontrols.R deleted file mode 100644 index 53c586399..000000000 --- a/code_development/hold_modelcontrols.R +++ /dev/null @@ -1,52 +0,0 @@ - - list( - AutoArima = list(metadata = list(name = "AutoArima", - descriptor = "classic model, all species, focal species"), - fun = "AutoArima", - args = NULL, - datasets = c("all", "controls", "exclosures", "dm_controls")), - ESSS = list(metadata = list(name = "ESSS", - descriptor = "classic model, all species, focal species"), - fun = "ESSS", - args = NULL, - datasets = c("all_interp", "controls_interp", "exclosures_interp", "dm_controls_interp")), - NaiveArima = list(metadata = list(name = "NaiveArima", - descriptor = "classic model, all species, focal species"), - fun = "NaiveArima", - args = NULL, - datasets = c("all", "controls", "exclosures", "dm_controls")), - nbGARCH = list(metadata = list(name = "nbGARCH", - descriptor = "classic model, all species, focal species"), - fun = "nbGARCH", - args = NULL, - datasets = c("all_interp", "controls_interp", "exclosures_interp", "dm_controls_interp")), - nbsGARCH = list(metadata = list(name = "nbsGARCH", - descriptor = "classic model, all species, focal species"), - fun = "nbsGARCH", - args = NULL, - datasets = c("all_interp", "controls_interp", "exclosures_interp", "dm_controls_interp")), - pevGARCH = list(metadata = list(name = "pevGARCH", - descriptor = "classic model, all species, focal species"), - fun = "pevGARCH", - datasets = c("all_interp", "controls_interp", "exclosures_interp", "dm_controls_interp"), - args = list(lag = 6)), -# simplexEDM = list(metadata = list(name = "simplexEDM", -# descriptor = "population model, all species, focal species"), -# fun = "simplexEDM", -# datasets = c("all_interp", "controls_interp", "exclosures_interp", "dm_controls_interp"), -# args = list(max_E = 7)), -# GPEDM = list(metadata = list(name = "GPEDM", -# descriptor = "population model, all species, focal species"), -# fun = "GPEDM", -# datasets = c("all_interp", "controls_interp", "exclosures_interp", "dm_controls_interp"), -# args = list(max_E = 7)), - jags_RW = list(metadata = list(name = "jags_RW", - descriptor = "population model, focal species"), - fun = "jags_RW", - datasets = c("dm_controls"), - args = list(control_runjags = runjags_control())), - jags_logistic = list(metadata = list(name = "jags_logistic", - descriptor = "population model, focal species"), - fun = "jags_logistic", - datasets = c("dm_controls"), - args = list(control_runjags = runjags_control()))) diff --git a/code_development/hold_rodentcontrols.R b/code_development/hold_rodentcontrols.R deleted file mode 100644 index dc3a33771..000000000 --- a/code_development/hold_rodentcontrols.R +++ /dev/null @@ -1,200 +0,0 @@ -prefab_rodent_dataset_controls <- function(interpolate = NULL) { - out <- list( - all = list(metadata = list(name = "all", - descriptor = "classic dataset, all plots combined"), - fun = "prep_rodent_dataset", - args = list(name = "all", - species = base_species(), - total = TRUE, - interpolate = FALSE, - clean = FALSE, - type = "Rodents", - level = "Site", - plots = "all", - treatment = NULL, - min_plots = 24, - min_traps = 1, - output = "abundance", - fillweight = FALSE, - unknowns = FALSE, - time = "newmoon", - na_drop = FALSE, - zero_drop = TRUE, - effort = TRUE, - filename = "rodents_all.csv")), - all_interp = list(metadata = list(name = "all_interp", - descriptor = "classic dataset, all plots combined, interpolated for models that cannot have missing data"), - fun = "prep_rodent_dataset", - args = list(name = "all_interp", - species = base_species(), - total = TRUE, - interpolate = TRUE, - clean = FALSE, - type = "Rodents", - level = "Site", - plots = "all", - treatment = NULL, - min_plots = 24, - min_traps = 1, - output = "abundance", - fillweight = FALSE, - unknowns = FALSE, - time = "newmoon", - na_drop = FALSE, - zero_drop = TRUE, - effort = TRUE, - filename = "rodents_all_interp.csv")), - controls = list(metadata = list(name = "controls", - descriptor = "classic dataset, control plots combined"), - fun = "prep_rodent_dataset", - args = list(name = "controls", - species = base_species(), - total = TRUE, - interpolate = FALSE, - clean = FALSE, - type = "Rodents", - level = "Treatment", - plots = "Longterm", - treatment = "control", - min_plots = 24, - min_traps = 1, - output = "abundance", - fillweight = FALSE, - unknowns = FALSE, - time = "newmoon", - na_drop = FALSE, - zero_drop = TRUE, - effort = TRUE, - filename = "rodents_controls.csv")), - controls_interp = list(metadata = list(name = "controls_interp", - descriptor = "classic dataset, control plots combined, interpolated for models that cannot have missing data"), - fun = "prep_rodent_dataset", - args = list(name = "controls_interp", - species = base_species(), - total = TRUE, - interpolate = TRUE, - clean = FALSE, - type = "Rodents", - level = "Treatment", - plots = "Longterm", - treatment = "control", - min_plots = 24, - min_traps = 1, - output = "abundance", - fillweight = FALSE, - unknowns = FALSE, - time = "newmoon", - na_drop = FALSE, - zero_drop = TRUE, - effort = TRUE, - filename = "rodents_controls_interp.csv")), - exclosures = list(metadata = list(name = "exclosures", - descriptor = "classic dataset, exclosure plots combined"), - fun = "prep_rodent_dataset", - args = list(name = "exclosures", - species = base_species(), - total = TRUE, - interpolate = FALSE, - clean = FALSE, - type = "Rodents", - level = "Treatment", - plots = "Longterm", - treatment = "exclosure", - min_plots = 24, - min_traps = 1, - output = "abundance", - fillweight = FALSE, - unknowns = FALSE, - time = "newmoon", - na_drop = FALSE, - zero_drop = TRUE, - effort = TRUE, - filename = "rodents_exclosures.csv")), - exclosures_interp = list(metadata = list(name = "exclosures_interp", - descriptor = "classic dataset, exclosure plots combined, interpolated for models that cannot have missing data"), - fun = "prep_rodent_dataset", - args = list(name = "exclosures_interp", - species = base_species(), - total = TRUE, - interpolate = TRUE, - clean = FALSE, - type = "Rodents", - level = "Treatment", - plots = "Longterm", - treatment = "exclosure", - min_plots = 24, - min_traps = 1, - output = "abundance", - fillweight = FALSE, - unknowns = FALSE, - time = "newmoon", - na_drop = FALSE, - zero_drop = TRUE, - effort = TRUE, - filename = "rodents_exclosures_interp.csv")), - dm_controls = list(metadata = list(name = "dm_controls", - descriptor = "DM only, control plots combined"), - fun = "prep_rodent_dataset", - args = list(name = "dm_controls", - species = "DM", - total = FALSE, - interpolate = FALSE, - clean = FALSE, - type = "Rodents", - level = "Treatment", - plots = "Longterm", - treatment = "control", - min_plots = 24, - min_traps = 1, - output = "abundance", - fillweight = FALSE, - unknowns = FALSE, - time = "newmoon", - na_drop = FALSE, - zero_drop = TRUE, - effort = TRUE, - filename = "rodents_dm_controls.csv")), - dm_controls_interp = list(metadata = list(name = "dm_controls_interp", - descriptor = "DM only, control plots combined, interpolated for models that cannot have missing data"), - fun = "prep_rodent_dataset", - args = list(name = "dm_controls_interp", - species = "DM", - total = FALSE, - interpolate = TRUE, - clean = FALSE, - type = "Rodents", - level = "Treatment", - plots = "Longterm", - treatment = "control", - min_plots = 24, - min_traps = 1, - output = "abundance", - fillweight = FALSE, - unknowns = FALSE, - time = "newmoon", - na_drop = FALSE, - zero_drop = TRUE, - effort = TRUE, - filename = "rodents_dm_controls_interp.csv"))) - - if (is.null(interpolate)) { - - out - - } else { - - dsnames <- names(out) - - if (interpolate) { - - out[grepl("_interp", dsnames)] - - } else { - - out[!grepl("_interp", dsnames)] - - } - - } - -} \ No newline at end of file diff --git a/code_development/notes.R b/code_development/notes.R index f3270abc1..d86369f2a 100644 --- a/code_development/notes.R +++ b/code_development/notes.R @@ -7,6 +7,23 @@ devtools::load_all() main <- "./portalcasting" +# +# to do +# +# in portalcast and cast +# datasets should come from the models' via their controls +# + + + + + + + + + + + list.files("tests/testthat") devtools::test(filter = "01") diff --git a/man/prepare-rodents.Rd b/man/prepare-rodents.Rd index 7b68789d6..60e1aa328 100644 --- a/man/prepare-rodents.Rd +++ b/man/prepare-rodents.Rd @@ -23,8 +23,6 @@ prep_rodents( \item{quiet}{\code{logical} indicator controlling if messages are printed.} \item{verbose}{\code{logical} indicator of whether or not to print out all of the information or not (and thus just the tidy messages).} - -\item{new_dataset_controls}{\code{list} of controls for any new datasets (not in the prefab datasets) listed in \code{dataset}.} } \value{ \code{list} of prepared \code{datasets}. From 6f0a30bef5ba1f378657f3bf3a013eb71bac629c Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Wed, 20 Apr 2022 10:03:44 -0700 Subject: [PATCH 11/14] Update rodent_species.R --- R/rodent_species.R | 42 ++++++++++++++++++++++++++++++------------ 1 file changed, 30 insertions(+), 12 deletions(-) diff --git a/R/rodent_species.R b/R/rodent_species.R index 22a260249..aaf53f14e 100644 --- a/R/rodent_species.R +++ b/R/rodent_species.R @@ -62,6 +62,8 @@ species_from_table <- function(rodents_tab = NULL, #' #' @param total \code{logical} value indicating if \code{"total"} should be added or not. #' +#' @param type \code{character} value indicating the output type. Current options include \code{abbreviation} (default, two-letter abbreviation) and \code{Latin} (full scientific names). +#' #' @return \code{character} vector of species abbreviations. #' #' @examples @@ -80,35 +82,51 @@ species_from_table <- function(rodents_tab = NULL, rodent_species <- function (species = NULL, set = NULL, nadot = FALSE, - total = FALSE) { + total = FALSE, + type = "abbreviation") { return_if_null(c(species, set)) out <- NULL - if (!is.null(set) && set == "all") { + type <- tolower(type) - out <- c("BA", "DM", "DO", "DS", "NA", "OL", "OT", "PB", "PE", "PF", "PH", "PI", "PL", "PM", "PP", "RF", "RM", "RO", "SF", "SH", "SO") + if (type == "abbreviation") { - } else if (!is.null(set) && set == "base") { + if (!is.null(set) && set == "all") { - out <- c("BA", "DM", "DO", "DS", "NA", "OL", "OT", "PB", "PE", "PF", "PH", "PL", "PM", "PP", "RF", "RM", "RO", "SF", "SH", "SO") + out <- c("BA", "DM", "DO", "DS", "NA", "OL", "OT", "PB", "PE", "PF", "PH", "PI", "PL", "PM", "PP", "RF", "RM", "RO", "SF", "SH", "SO") - } else if (!is.null(set) && set == "evalplot") { + } else if (!is.null(set) && set == "base") { - out <- c("BA", "DM", "DO", "PP", "OT", "NA") + out <- c("BA", "DM", "DO", "DS", "NA", "OL", "OT", "PB", "PE", "PF", "PH", "PL", "PM", "PP", "RF", "RM", "RO", "SF", "SH", "SO") - } + } else if (!is.null(set) && set == "evalplot") { - if (total) { + out <- c("BA", "DM", "DO", "PP", "OT", "NA") - out <- c(out, "total") + } + + if (nadot) { + + out[which(out == "NA")] <- "NA." + + } + + + } else if (type = "latin") { + + + + } else { + + stop ("`type` must be 'abbreviation' or 'Latin'") } - if (nadot) { + if (total) { - out[which(out == "NA")] <- "NA." + out <- c(out, "total") } From 87c6b4f0d6f9165fe8eaeb22564d481551a40931 Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Wed, 20 Apr 2022 12:15:57 -0700 Subject: [PATCH 12/14] doc --- R/create_dir.R | 11 ++++++----- R/directory_configuration_file.R | 11 +++++++---- R/evaluate.R | 10 +++++----- R/prepare_models.R | 2 +- R/process_casts.R | 4 ++-- man/directory-creation.Rd | 2 ++ man/directory_configuration_file.Rd | 5 ++++- man/read-and-write-model-controls.Rd | 2 +- man/save_cast_output.Rd | 4 ++-- 9 files changed, 30 insertions(+), 21 deletions(-) diff --git a/R/create_dir.R b/R/create_dir.R index c85165047..1e7cc1824 100644 --- a/R/create_dir.R +++ b/R/create_dir.R @@ -8,6 +8,8 @@ #' #' @param settings \code{list} of controls for the directory, with defaults set in \code{\link{directory_settings}}. #' +#' @param verbose \code{logical} indicator of whether or not to print out all of the information (and thus just the tidy messages). +#' #' @return The \code{list} of directory settings \code{\link[base]{invisible}}-ly. #' #' @name directory creation @@ -31,10 +33,9 @@ create_dir <- function(main = ".", showWarnings = FALSE) - config <- write_directory_config(main = main, - settings = settings, - quiet = quiet) + write_directory_config(main = main, + settings = settings, + quiet = quiet) + - invisible(config) - } diff --git a/R/directory_configuration_file.R b/R/directory_configuration_file.R index efd303d06..32a650432 100644 --- a/R/directory_configuration_file.R +++ b/R/directory_configuration_file.R @@ -7,6 +7,8 @@ #' #' @param quiet \code{logical} indicator if progress messages should be quieted. #' +#' @param verbose \code{logical} indicator of whether or not to print out all of the information (and thus just the tidy messages). +#' #' @param main \code{character} value of the name of the main component of the directory tree. Default value (\code{"."}) puts the forecasting directory in the present locations. Nesting the forecasting directory in a folder can be done by simply adding to the \code{main} input (see \code{Examples}). #' #' @param settings \code{list} of controls for the directory, with defaults set in \code{\link{directory_settings}} that should generally not need to be altered. @@ -34,6 +36,7 @@ write_directory_config <- function (main = ".", write_yaml(x = config, file = file.path(main, settings$files$directory_config)) + invisible(config) } @@ -69,7 +72,8 @@ read_directory_config <- function (main = ".", #' update_directory_config <- function (main = ".", settings = directory_settings(), - quiet = FALSE){ + quiet = FALSE, + verbose = FALSE){ config <- read_directory_config(main = main, settings = settings, @@ -85,14 +89,13 @@ update_directory_config <- function (main = ".", config$raw$PortalData_version <- scan(file = file.path(main, settings$subs$resources, "PortalData", "version.txt"), what = "character", - quiet = TRUE) + quiet = !verbose) } - - write_yaml(x = config, file = file.path(main, settings$files$directory_config)) + invisible(config) } diff --git a/R/evaluate.R b/R/evaluate.R index c2d7803c5..db37d3826 100644 --- a/R/evaluate.R +++ b/R/evaluate.R @@ -62,11 +62,11 @@ evaluate_casts <- function (main = ".", #' #' @export #' -evaluate_cast <- function (main = ".", - settings = directory_settings(), - cast_id = NULL, - quiet = FALSE, - verbose = FALSE) { +evaluate_cast <- function (main = ".", + settings = directory_settings(), + cast_id = NULL, + quiet = FALSE, + verbose = FALSE) { return_if_null(cast_id) diff --git a/R/prepare_models.R b/R/prepare_models.R index 6c46fbb89..e18cd6b44 100644 --- a/R/prepare_models.R +++ b/R/prepare_models.R @@ -1,6 +1,6 @@ #' @title Read and Write Model Control Lists #' -#' @description Input/Output functions for model control lists. +#' @description Input/output functions for model control lists. #' #' @param quiet \code{logical} indicator controlling if messages are printed. #' diff --git a/R/process_casts.R b/R/process_casts.R index e753db8ad..3bc9aabe9 100644 --- a/R/process_casts.R +++ b/R/process_casts.R @@ -498,12 +498,12 @@ select_casts <- function (main = ".", #' of the model (across multiple species, for example). #' \item \code{"model_fits"}: saved out as a serialized \code{JSON} file #' via \code{\link[jsonlite]{serializeJSON}} and -#' \code{\link[jsonlite]{write_json}}, so quite flexible with respect to +#' \code{\link[jsonlite:read_json]{write_json}}, so quite flexible with respect to #' specific object structure. Saving out a \code{list} of the actual model #' fit/return objects means that models do not need to be refit later. #' \item \code{"model_casts"}: saved out as a serialized \code{JSON} file #' via \code{\link[jsonlite]{serializeJSON}} and -#' \code{\link[jsonlite]{write_json}}, so quite flexible with respect to +#' \code{\link[jsonlite:read_json]{write_json}}, so quite flexible with respect to #' specific object structure. Is used to save \code{list}s #' of predictions across multiple instances of the model. #' } diff --git a/man/directory-creation.Rd b/man/directory-creation.Rd index ca40aa0e1..1e0af117e 100644 --- a/man/directory-creation.Rd +++ b/man/directory-creation.Rd @@ -13,6 +13,8 @@ create_dir(main = ".", settings = directory_settings(), quiet = FALSE) \item{settings}{\code{list} of controls for the directory, with defaults set in \code{\link{directory_settings}}.} \item{quiet}{\code{logical} indicator if progress messages should be quieted.} + +\item{verbose}{\code{logical} indicator of whether or not to print out all of the information (and thus just the tidy messages).} } \value{ The \code{list} of directory settings \code{\link[base]{invisible}}-ly. diff --git a/man/directory_configuration_file.Rd b/man/directory_configuration_file.Rd index 439e16020..776b30b18 100644 --- a/man/directory_configuration_file.Rd +++ b/man/directory_configuration_file.Rd @@ -22,7 +22,8 @@ read_directory_config( update_directory_config( main = ".", settings = directory_settings(), - quiet = FALSE + quiet = FALSE, + verbose = FALSE ) } \arguments{ @@ -31,6 +32,8 @@ update_directory_config( \item{settings}{\code{list} of controls for the directory, with defaults set in \code{\link{directory_settings}} that should generally not need to be altered.} \item{quiet}{\code{logical} indicator if progress messages should be quieted.} + +\item{verbose}{\code{logical} indicator of whether or not to print out all of the information (and thus just the tidy messages).} } \value{ \code{list} of directory configurations, \code{\link[base]{invisible}}-ly. diff --git a/man/read-and-write-model-controls.Rd b/man/read-and-write-model-controls.Rd index b53166edb..428fe7d5e 100644 --- a/man/read-and-write-model-controls.Rd +++ b/man/read-and-write-model-controls.Rd @@ -38,5 +38,5 @@ write_model_controls( \code{list} of \code{models}' control \code{list}s, \code{\link[base]{invisible}}-ly for \code{write_model_controls}. } \description{ -Input/Output functions for model control lists. +Input/output functions for model control lists. } diff --git a/man/save_cast_output.Rd b/man/save_cast_output.Rd index ed1b898f5..9f618685d 100644 --- a/man/save_cast_output.Rd +++ b/man/save_cast_output.Rd @@ -41,12 +41,12 @@ Currently, four generalized output components are recognized and indicated by th of the model (across multiple species, for example). \item \code{"model_fits"}: saved out as a serialized \code{JSON} file via \code{\link[jsonlite]{serializeJSON}} and - \code{\link[jsonlite]{write_json}}, so quite flexible with respect to + \code{\link[jsonlite:read_json]{write_json}}, so quite flexible with respect to specific object structure. Saving out a \code{list} of the actual model fit/return objects means that models do not need to be refit later. \item \code{"model_casts"}: saved out as a serialized \code{JSON} file via \code{\link[jsonlite]{serializeJSON}} and - \code{\link[jsonlite]{write_json}}, so quite flexible with respect to + \code{\link[jsonlite:read_json]{write_json}}, so quite flexible with respect to specific object structure. Is used to save \code{list}s of predictions across multiple instances of the model. } From eb3ba7ae9c5af0f56e7f52eb0996d68905b7b82e Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Thu, 21 Apr 2022 11:32:14 -0700 Subject: [PATCH 13/14] update from main extra --- R/evaluate.R | 2 -- R/portalcast.R | 2 +- code_development/notes.R | 4 +++- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/evaluate.R b/R/evaluate.R index db37d3826..730957323 100644 --- a/R/evaluate.R +++ b/R/evaluate.R @@ -1,5 +1,3 @@ - - #' @title Evaluate Forecasts #' #' @description Evaluate forecasts in the directory, based on id or group, or (if \code{cast_ids = NULL} and \code{cast_groups = NULL}, the default) \code{evaluate_casts} will evaluate all and (if \code{cast_id = NULL} and \code{cast_group = NULL}, the default), \code{evaluate_cast} will evaluate the most recent cast. diff --git a/R/portalcast.R b/R/portalcast.R index c1363531e..cc5fdfba6 100644 --- a/R/portalcast.R +++ b/R/portalcast.R @@ -48,7 +48,7 @@ portalcast <- function (main = ".", # # the datasets here should come from the models selected -# and not as an argument +# and not as an argument ... or? maybe not? idk. think this out. # return_if_null(models) diff --git a/code_development/notes.R b/code_development/notes.R index d86369f2a..cfa073c5b 100644 --- a/code_development/notes.R +++ b/code_development/notes.R @@ -4,9 +4,11 @@ devtools::document() devtools::load_all() -main <- "./portalcasting" +main <- "~/portalcasting" +setup_production(main = main) + # # to do # From 43801c8a42ddfd671a1167aa5e3c1a433fd9891b Mon Sep 17 00:00:00 2001 From: juniperlsimonis Date: Thu, 21 Apr 2022 14:02:40 -0700 Subject: [PATCH 14/14] evaluate runs through properly using existing evaluation methods nothing saved, etc, but calculations can run and reproduce as existing --- DESCRIPTION | 2 +- NEWS.md | 16 +++++++++------- R/evaluate.R | 22 ++++++++++------------ man/evaluate-forecasts.Rd | 2 +- tests/testthat/test-22-evaluate.R | 3 ++- 5 files changed, 23 insertions(+), 22 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index cf2e38874..1cae564dd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: portalcasting Title: Functions Used in Predicting Portal Rodent Dynamics -Version: 0.36.0 +Version: 0.37.0 Authors@R: c( person(c("Juniper", "L."), "Simonis", email = "juniper.simonis@weecology.org", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 6b25e0a57..ee7124c86 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,15 @@ Version numbers follow [Semantic Versioning](https://semver.org/). +# [portalcasting 0.37.0](https://github.com/weecology/portalcasting/releases/tag/v0.37.0) +*2022-04-21* + +### Building out evaluation pipeline +* starting with what is already occurring, but formalizing as such as part of an `evaluate_casts` and `evaluate_cast` pair of functions +* `evaluate_casts` function now works automatically to evaluate all the casts using `evaluate_cast`, generating the error table as it does when being used, but nothing is saved out or updated. +* there is also no filter on evaluated casts by deafult, so the output from the forecasts without observations to evaluate is a table with a single row with NaN, and then they get wrapped up into the list. + * no errors, just noteworthy + # [portalcasting 0.36.0](https://github.com/weecology/portalcasting/releases/tag/v0.36.0) *2022-04-08* @@ -10,13 +19,6 @@ Version numbers follow [Semantic Versioning](https://semver.org/). * No more `most_abundant_species` function, as we're not using it on the website. -# portalcasting 0.36.0 -*In Progress* - -### Building out evaluation pipeline -* starting with what is already occurring, but formalizing as such - - # [portalcasting 0.35.0](https://github.com/weecology/portalcasting/releases/tag/v0.35.0) *2022-04-07* diff --git a/R/evaluate.R b/R/evaluate.R index 730957323..77365d6ae 100644 --- a/R/evaluate.R +++ b/R/evaluate.R @@ -13,7 +13,7 @@ #' #' @param verbose \code{logical} indicator of whether or not to print out all of the information (and thus just the tidy messages). #' -#' @return \code{NULL}, \code{\link[base]{invisible}}-ly. +#' @return A \code{data.frame}, or \code{list} of \code{data.frame}s. #' #' @name evaluate forecasts #' @@ -41,17 +41,19 @@ evaluate_casts <- function (main = ".", } + out <- named_null_list(element_names = cast_ids) + for (i in 1:ncast_ids) { - evaluate_cast(main = main, - settings = settings, - cast_id = cast_ids[i], - quiet = quiet, - verbose = verbose) + out[[i]] <- evaluate_cast(main = main, + settings = settings, + cast_id = cast_ids[i], + quiet = quiet, + verbose = verbose) } - invisible() + out } @@ -96,11 +98,7 @@ evaluate_cast <- function (main = ".", cast_tab <- add_covered_to_cast_tab(main = main, settings = settings, cast_tab = cast_tab) - cast_err <- measure_cast_level_error(cast_tab = cast_tab) - - - - invisible() + measure_cast_level_error(cast_tab = cast_tab) } diff --git a/man/evaluate-forecasts.Rd b/man/evaluate-forecasts.Rd index 5c187164b..cdbddda80 100644 --- a/man/evaluate-forecasts.Rd +++ b/man/evaluate-forecasts.Rd @@ -35,7 +35,7 @@ evaluate_cast( \code{cast_id} can only be a single value, whereas \code{cast_ids} can be multiple.} } \value{ -\code{NULL}, \code{\link[base]{invisible}}-ly. +A \code{data.frame}, or \code{list} of \code{data.frame}s. } \description{ Evaluate forecasts in the directory, based on id or group, or (if \code{cast_ids = NULL} and \code{cast_groups = NULL}, the default) \code{evaluate_casts} will evaluate all and (if \code{cast_id = NULL} and \code{cast_group = NULL}, the default), \code{evaluate_cast} will evaluate the most recent cast. diff --git a/tests/testthat/test-22-evaluate.R b/tests/testthat/test-22-evaluate.R index efcf18401..32ecc09d4 100644 --- a/tests/testthat/test-22-evaluate.R +++ b/tests/testthat/test-22-evaluate.R @@ -4,7 +4,7 @@ main <- "./testing" test_that(desc = "evaluate_casts evaluates casts", { - expect_null(evaluate_casts(main = main)) + expect_is(evaluate_casts(main = main, cast_ids = 1:2), "list") }) @@ -12,6 +12,7 @@ test_that(desc = "evaluate_casts evaluates casts", { test_that(desc = "evaluate_cast evaluates cast", { expect_null(evaluate_cast(main = main)) + expect_is(evaluate_cast(main = main, cast_id = 1), "data.frame") })