From ba1ac67557dce777d18f260591844c115f725677 Mon Sep 17 00:00:00 2001 From: DAPPERstats Date: Sat, 12 Oct 2019 16:01:13 -0700 Subject: [PATCH 1/3] v0.13.0 ### Full writing of `control_files` in model scripts * Previously, the controls list for the files in the model scripts was taken from the environment in which the script was run, which opens the script to everything, which is undesirable. * After the need to include a control list for runjags models forced an explicit writing of the list inputs, the code was available to transfer to the files control list. * This does mean that the function calls in the scripts are now super long and explicit, but that's ok. * To avoid super long model script lines (where event default inputs are repeated in the list functions), a function `control_list_arg` was made to generalize what was coded up from the runjags list for use also with the files control list. This function writes a script component that only includes arguments to the list function that are different from the formal definition. --- DESCRIPTION | 2 +- NAMESPACE | 1 + NEWS.md | 15 +++++++ R/args.R | 13 ++++-- R/prepare_models.R | 93 ++++++++++++++++++++++++++++------------ _pkgdown.yml | 1 + man/argument_checking.Rd | 9 +++- man/write_model.Rd | 18 +++++++- 8 files changed, 118 insertions(+), 34 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 15f83a6c7..2d4facc2a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: portalcasting Title: Functions Used in Predicting Portal Rodent Dynamics -Version: 0.12.1 +Version: 0.13.0 Authors@R: c( person(c("Juniper", "L."), "Simonis", email = "juniper.simonis@weecology.org", role = c("aut", "cre"), diff --git a/NAMESPACE b/NAMESPACE index 891d4182f..4435ed978 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,6 +27,7 @@ export(check_args) export(clear_tmp) export(climate_dl_control) export(combine_hist_and_cast) +export(control_list_arg) export(covariate_models) export(create) export(create_dir) diff --git a/NEWS.md b/NEWS.md index 102e019e6..44d59f654 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,21 @@ Version numbers follow [Semantic Versioning](https://semver.org/). +# [portalcasting 0.13.0](https://github.com/weecology/portalcasting/releases/tag/v0.13.0) +*2019-10-12* + +### Full writing of `control_files` in model scripts +* Previously, the controls list for the files in the model scripts was taken from the environment in which the script was run, which opens the script to everything, which is undesirable. +* After the need to include a control list for runjags models forced an explicit writing of the list inputs, the code was available to transfer to the files control list. +* This does mean that the function calls in the scripts are now super long and explicit, but that's ok. +* To avoid super long model script lines (where event default inputs are repeated in the list functions), a function `control_list_arg` was made to generalize what was coded up from the runjags list for use also with the files control list. This function writes a script component that only includes arguments to the list function that are different from the formal definition. + +# portalcasting 0.12.1 +*2019-10-12* + +### Fixes to the pkgdown site +* rmarkdown v1.16.0 has some issues with rendering images, so forcing use of v1.16.1 for now. +* Inclusion of new functions in reference list. # [portalcasting 0.12.0](https://github.com/weecology/portalcasting/releases/tag/v0.12.0) *2019-10-11* diff --git a/R/args.R b/R/args.R index 1ed2a73e7..cd349726f 100644 --- a/R/args.R +++ b/R/args.R @@ -91,9 +91,13 @@ #' \code{filename_moons}, #' \code{freq}, #' \code{jags_model}, -#' \code{level}, +#' \code{level}, +#' \code{list_function}, #' \code{main}, -#' \code{method} (if not \code{NULL}, must be \code{"unwtavg"}), +#' \code{method} (if not \code{NULL}, must be \code{"unwtavg"}, +#' \code{"unwtavg"}, \code{"rjags"}, \code{"simple"}, +#' \code{"interruptible"}, \code{"parallel"}, \code{"rjparallel"}, +#' \code{"background"}, \code{"bgparallel"}, or \code{"snow"}), #' \code{model} (inputted values are checked via #' \code{\link{verify_models}}), #' \code{name}, @@ -174,6 +178,7 @@ #' be \code{NA}: #' \code{control_climate_dl}, #' \code{control_files}, +#' \code{control_list}, #' \code{control_model}, #' \code{control_runjags}, #' \code{controls_models}, @@ -586,8 +591,9 @@ check_arg_list <- function(){ controls_rodents = arg_list(), control_runjags = arg_list(), control_files = arg_list(), + control_list= arg_list(), covariates = arg_df(), - covariatesTF = arg_logical(), + covariatesTF = arg_logical(), data_name = arg_character(), data = arg_character(length = NULL), data_set = arg_character(), @@ -632,6 +638,7 @@ check_arg_list <- function(){ lead_time = arg_nonnegintnum(), lev = arg_intnum(), level = arg_character(), + list_function = arg_character(), lon = arg_numeric(), main = arg_character(), max_E = arg_nonnegintnum(vals = avail_max_Es), diff --git a/R/prepare_models.R b/R/prepare_models.R index 8075f8600..7cc317931 100644 --- a/R/prepare_models.R +++ b/R/prepare_models.R @@ -262,6 +262,9 @@ prefab_models <- function(){ #' \code{model_template} creates the \code{character}-valued #' text for a model script to be housed in the model directory, as written #' out by \code{write_model}. \cr \cr +#' \code{control_list_arg} creates the \code{character}-valued +#' text for a specific list argument into model function within a model +#' script to be housed in the model directory. #' #' @param main \code{character} value of the name of the main component of #' the directory tree. @@ -306,16 +309,25 @@ prefab_models <- function(){ #' @param control_runjags \code{list} of arguments passed to #' \code{\link[runjags]{run.jags}} via \code{\link{runjags_control}}. #' +#' @param control_list \code{list} of arguments passed to +#' \code{list_function}. +#' +#' @param list_function \code{character} value name of the function to +#' send \code{control_list} arguments to within the model script. +#' #' @return \code{write_mode} \code{\link{write}}s the model script out #' and returns \code{NULL}. \cr \cr #' \code{model_template}: \code{character}-valued text for a model script -#' to be housed in the model directory +#' to be housed in the model directory. \cr \cr +#' \code{control_list_arg}: \code{character}-valued text for part of a +#' model script. \cr \cr #' #' @examples #' \donttest{ #' create_dir() #' write_model("AutoArima") #' model_template() +#' control_list_arg(runjags_control(nchains = 3), "runjags_control") #' } #' #' @export @@ -414,7 +426,6 @@ model_template <- function(name = NULL, data_sets = NULL, arg_checks = arg_checks)[[name]]$data_sets) return_if_null(data_sets) main_arg <- paste0(', main = "', main, '"') - control_files_arg <- paste0(', control_files = control_files') quiet_arg <- paste0(', quiet = ', quiet) verbose_arg <- paste0(', verbose = ', verbose) arg_checks_arg <- paste0(', arg_checks = ', arg_checks) @@ -426,31 +437,14 @@ model_template <- function(name = NULL, data_sets = NULL, if (!is.null(max_E)){ max_E_arg <- paste0(', max_E = ', max_E) } - control_runjags_arg <- NULL - if (!is.null(control_runjags)){ - nvals <- length(control_runjags) - list_vals <- NULL - for(i in 1:nvals){ - val_name <- names(control_runjags)[1] - val_value <- control_runjags[[1]] - if(is.character(val_value)){ - val_value <- paste0('"', val_value, '"') - } - list_vals <- paste0(val_name, ' = ', val_value) - } - if(nvals > 1){ - for(i in 2:nvals){ - val_name <- names(control_runjags)[i] - val_value <- control_runjags[[i]] - if(is.character(val_value)){ - val_value <- paste0('"', val_value, '"') - } - list_vals <- paste0(list_vals, ', ', val_name, ' = ', val_value) - } - } - control_runjags_arg <- paste0(', control_runjags = runjags_control(', - list_vals, ')') - } + control_runjags_arg <- control_list_arg(control_list = control_runjags, + list_function = "runjags_control", + arg_checks = arg_checks) + + control_files_arg <- control_list_arg(control_list = control_files, + list_function = "files_control", + arg_checks = arg_checks) + ds_args <- paste0('data_set = "', data_sets, '"') nds <- length(data_sets) out <- NULL @@ -471,6 +465,51 @@ model_template <- function(name = NULL, data_sets = NULL, } + + +#' @rdname write_model +#' +#' @export +#' +control_list_arg <- function(control_list = NULL, list_function = NULL, + arg_checks = TRUE){ + return_if_null(control_list) + return_if_null(list_function) + + list_name <- paste(strsplit(list_function, "_")[[1]][2:1], collapse = "_") + nvals <- length(control_list) + val_values <- rep(NA, nvals) + for(i in 1:nvals){ + val_name <- names(control_list)[i] + val_value <- control_list[[i]] + formal_value <- formals(eval(parse(text = list_function)))[[val_name]] + + if(!identical(val_value, formal_value)){ + if(is.character(val_value)){ + val_value <- paste0('"', val_value, '"') + } + if(is.null(val_value)){ + val_value <- "NULL" + } + val_values[i] <- val_value + } + } + update_values <- which(is.na(val_values) == FALSE) + nupdate_values <- length(update_values) + val_texts <- NULL + if(nupdate_values > 0){ + val_text <- rep(NA, nupdate_values) + update_val_names <- names(control_list)[update_values] + update_val_values <- val_values[update_values] + for(i in 1:nupdate_values){ + val_text[i] <- paste0(update_val_names[i], ' = ', update_val_values[i]) + } + val_texts <- paste0(val_text, collapse = ', ') + } + paste0(', ', list_name, ' = ', list_function, '(', val_texts, ')') +} + + #' @title Create a control list for a model #' #' @description Provides a ready-to-use template for the diff --git a/_pkgdown.yml b/_pkgdown.yml index 363fae271..6fc0c18d1 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -146,6 +146,7 @@ reference: - model_controls - write_model - model_template + - control_list_arg - prefab_models - title: "Prefabricated models" desc: "Functions used to run the prefab models" diff --git a/man/argument_checking.Rd b/man/argument_checking.Rd index 6c93ed089..588c36b6c 100644 --- a/man/argument_checking.Rd +++ b/man/argument_checking.Rd @@ -124,9 +124,13 @@ Argument details used for checking are produced simply via \code{filename_moons}, \code{freq}, \code{jags_model}, - \code{level}, + \code{level}, + \code{list_function}, \code{main}, - \code{method} (if not \code{NULL}, must be \code{"unwtavg"}), + \code{method} (if not \code{NULL}, must be \code{"unwtavg"}, + \code{"unwtavg"}, \code{"rjags"}, \code{"simple"}, + \code{"interruptible"}, \code{"parallel"}, \code{"rjparallel"}, + \code{"background"}, \code{"bgparallel"}, or \code{"snow"}), \code{model} (inputted values are checked via \code{\link{verify_models}}), \code{name}, @@ -207,6 +211,7 @@ Argument details used for checking are produced simply via be \code{NA}: \code{control_climate_dl}, \code{control_files}, + \code{control_list}, \code{control_model}, \code{control_runjags}, \code{controls_models}, diff --git a/man/write_model.Rd b/man/write_model.Rd index d257c13dc..291198981 100644 --- a/man/write_model.Rd +++ b/man/write_model.Rd @@ -3,6 +3,7 @@ \name{write_model} \alias{write_model} \alias{model_template} +\alias{control_list_arg} \title{Write the template for a model into model subdirectory} \usage{ write_model(name = NULL, data_sets = NULL, covariatesTF = NULL, @@ -14,6 +15,9 @@ model_template(name = NULL, data_sets = NULL, covariatesTF = FALSE, lag = NULL, main = ".", control_files = files_control(), max_E = NULL, control_runjags = NULL, quiet = FALSE, verbose = FALSE, arg_checks = TRUE) + +control_list_arg(control_list = NULL, list_function = NULL, + arg_checks = TRUE) } \arguments{ \item{name}{\code{character} value of the name of the model.} @@ -58,12 +62,20 @@ shown.} checked using standard protocols via \code{\link{check_args}}. The default (\code{arg_checks = TRUE}) ensures that all inputs are formatted correctly and provides directed error messages if not. \cr} + +\item{control_list}{\code{list} of arguments passed to +\code{list_function}.} + +\item{list_function}{\code{character} value name of the function to +send \code{control_list} arguments to within the model script.} } \value{ \code{write_mode} \code{\link{write}}s the model script out and returns \code{NULL}. \cr \cr \code{model_template}: \code{character}-valued text for a model script - to be housed in the model directory + to be housed in the model directory. \cr \cr + \code{control_list_arg}: \code{character}-valued text for part of a + model script. \cr \cr } \description{ \code{write_model} creates a template script (as written by @@ -71,12 +83,16 @@ formatted correctly and provides directed error messages if not. \cr} \code{model_template} creates the \code{character}-valued text for a model script to be housed in the model directory, as written out by \code{write_model}. \cr \cr + \code{control_list_arg} creates the \code{character}-valued + text for a specific list argument into model function within a model + script to be housed in the model directory. } \examples{ \donttest{ create_dir() write_model("AutoArima") model_template() + control_list_arg(runjags_control(nchains = 3), "runjags_control") } } From 82a36782f1210e8cfac761b4d29a156bfd058f26 Mon Sep 17 00:00:00 2001 From: DAPPERstats Date: Sat, 12 Oct 2019 16:04:57 -0700 Subject: [PATCH 2/3] Update portalcast.R --- R/portalcast.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/portalcast.R b/R/portalcast.R index 0af53ca02..31da549db 100644 --- a/R/portalcast.R +++ b/R/portalcast.R @@ -212,7 +212,7 @@ cast <- function(main = ".", models = prefab_models(), end_moon = NULL, model_running_message(model = model, quiet = quiet, arg_checks = arg_checks) run_status <- tryCatch( - source(model, local = TRUE), + source(model), error = function(x){NA} ) model_done_message(model = model, run_status = run_status, quiet = quiet, From 91e307681d4f1edbda3be7832cb1e554da18b6ee Mon Sep 17 00:00:00 2001 From: DAPPERstats Date: Sat, 12 Oct 2019 16:37:51 -0700 Subject: [PATCH 3/3] Update test-09-prepare_models.R --- tests/testthat/test-09-prepare_models.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/testthat/test-09-prepare_models.R b/tests/testthat/test-09-prepare_models.R index 33bcd7c3d..66aeb6eb3 100644 --- a/tests/testthat/test-09-prepare_models.R +++ b/tests/testthat/test-09-prepare_models.R @@ -81,3 +81,11 @@ test_that("model_template", { expect_equal(length(temp2), 4) }) + +test_that("control_list_arg", { + expect_is(control_list_arg(runjags_control(nchains = 3), "runjags_control"), + "character") + expect_is(control_list_arg(runjags_control(nchains = NULL), + "runjags_control"), + "character") +})