From 85b1d01dd3b20efc910f80d6920f31d8d8411101 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 18 Dec 2023 14:23:01 -0500 Subject: [PATCH 01/68] add error messages for checking multi-host data inputs --- R/error_messages.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/R/error_messages.R b/R/error_messages.R index b434b0b0..46b9062e 100644 --- a/R/error_messages.R +++ b/R/error_messages.R @@ -172,3 +172,13 @@ weather_size_probabilitic_error <- weather_sd_layer_error <- "weather coefficient sd file number of layers not equal to number of layers in weather coefficient file" + +multihost_file_length_error <- + "infected_file_list and host_file_list are not of the same length, ensure both of these files are + of the length of the number of host species you want to simulate" + +competency_table_column_length_error <- + "competency_table doesn't have the same number of columns as number of files in host_file_list" + +pest_host_table_row_length_error <- + "pest_host_table doesn't have the same number of rows as number of files in host_file_list" \ No newline at end of file From 980113b024017afe3f85b629aab668a225b7d8e0 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 18 Dec 2023 14:23:31 -0500 Subject: [PATCH 02/68] add checks for multihost data inputs --- R/checks.R | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/R/checks.R b/R/checks.R index 94e4cefe..194c1e21 100644 --- a/R/checks.R +++ b/R/checks.R @@ -312,6 +312,36 @@ bayesian_mnn_checks <- function(prior_means, } } + +multihost_checks <- function(infected_file_list, host_file_list, competency_table, pest_host_table) { + checks_passed <- TRUE + if (length(infected_file_list) != length(host_file_list)) { + checks_pass <- FALSE + failed_check <- multihost_file_length_error + } + + if (!checks_passed & length(infected_file_list) != (ncol(competency_table) -1)) { + checks_passed <- FALSE + failed_check <- competency_table_column_length_error + } + + if (!checks_passed & length(infected_file_list) != nrow(pest_host_table)) { + checks_passed <- FALSE + failed_check <- pest_host_table_row_length_error + } + + if (checks_passed) { + outs <- list(checks_passed) + names(outs) <- c("checks_passed") + return(outs) + } else { + outs <- list(checks_passed, failed_check) + names(outs) <- failed_check_list + return(outs) + } +} + + multispecies_checks <- function(species, infected_files, parameter_means, From d1876592e4d57facaca4c2aa8aaae318bfbcb03b Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 18 Dec 2023 15:03:06 -0500 Subject: [PATCH 03/68] switch from infected and host file to file_list to capture that multiple hosts are being used as inputs. --- R/calibrate.R | 8 ++++---- R/pops.r | 25 +++++++++++++------------ R/pops_multirun.R | 8 ++++---- R/validate.R | 8 ++++---- 4 files changed, 25 insertions(+), 24 deletions(-) diff --git a/R/calibrate.R b/R/calibrate.R index 506fe866..df7ff595 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -123,8 +123,8 @@ calibrate <- function(infected_years_file, params_to_estimate = c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE), number_of_generations = 7, generation_size = 1000, - infected_file, - host_file, + infected_file_list, + host_file_list, total_populations_file, temp = FALSE, temperature_coefficient_file = "", @@ -213,8 +213,8 @@ calibrate <- function(infected_years_file, config$params_to_estimate <- params_to_estimate config$number_of_generations <- number_of_generations config$generation_size <- generation_size - config$infected_file <- infected_file - config$host_file <- host_file + config$infected_file_list <- infected_file_list + config$host_file_list <- host_file_list config$total_populations_file <- total_populations_file config$temp <- temp config$temperature_coefficient_file <- temperature_coefficient_file diff --git a/R/pops.r b/R/pops.r index d4a61a97..75782bbb 100644 --- a/R/pops.r +++ b/R/pops.r @@ -8,13 +8,14 @@ #' a single stochastic realization of the model and is predominantly used for #' automated tests of model features. #' -#' @param infected_file Raster file with initial infections. Units for infections are based on data +#' @param infected_file_list paths to raster files with initial infections and standard deviation +#' for each host can be based in 2 formats (a single file with number of hosts or a single file with +#' 2 layers number of hosts and standard deviation).. Units for infections are based on data #' availability and the way the units used for your host file is created (e.g. percent area, # of #' hosts per cell, etc.). -#' @param host_file path to raster files with number of hosts and standard deviation on those -#' estimates can be based in 3 formats (a single file with number of hosts, a single file with 2 -#' layers number of hosts and standard deviation, or two files 1 with number of hosts and the other -#' with standard deviation of those estimates). The units for this can be of many formats the two +#' @param host_file_list paths to raster files with number of hosts and standard deviation on those +#' estimates can be based in 2 formats (a single file with number of hosts or a single file with 2 +#' layers number of hosts and standard deviation). The units for this can be of many formats the two #' most common that we use are either percent area (0 to 100) or # of hosts in the cell. Usually #' depends on data available and estimation methods. #' @param total_populations_file path to raster file with number of total populations of all hosts @@ -105,8 +106,8 @@ #' percent_natural_dispersal, anthropogenic_dispersal_distance, natural kappa, anthropogenic kappa, #' network_min_distance, and network_max_distance) Should be 8x8 matrix. #' @param start_exposed Do your initial conditions start as exposed or infected (only used if -#' model_type is "SEI"). Default False. If this is TRUE need to have both an infected_file (this -#' can be a raster of all 0's) and exposed_file +#' model_type is "SEI"). Default False. If this is TRUE need to have both infected_files (this +#' can be a raster of all 0's) and exposed_files #' @param generate_stochasticity Boolean to indicate whether to use stochasticity in reproductive #' functions default is TRUE #' @param establishment_stochasticity Boolean to indicate whether to use stochasticity in @@ -151,7 +152,7 @@ #' along the edge. "jump" automatically moves to the nearest node when moving through the network. #' "teleport" moves from node to node most likely used for airport and seaport networks. #' @param use_initial_condition_uncertainty Boolean to indicate whether or not to propagate and -#' partition uncertainty from initial conditions. If TRUE the infected_file needs to have 2 layers +#' partition uncertainty from initial conditions. If TRUE the infected_files needs to have 2 layers #' one with the mean value and one with the standard deviation. If an SEI model is used the #' exposed_file needs to have 2 layers one with the mean value and one with the standard #' deviation @@ -198,8 +199,8 @@ #' @export #' -pops <- function(infected_file, - host_file, +pops <- function(infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, @@ -275,8 +276,8 @@ pops <- function(infected_file, config <- c() config$random_seed <- random_seed - config$infected_file <- infected_file - config$host_file <- host_file + config$infected_file_list <- infected_file_list + config$host_file_list <- host_file_list config$total_populations_file <- total_populations_file config$parameter_means <- parameter_means config$parameter_cov_matrix <- parameter_cov_matrix diff --git a/R/pops_multirun.R b/R/pops_multirun.R index ff723b58..ac1a9b8a 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -33,8 +33,8 @@ #' @return list of infected and susceptible per year #' @export #' -pops_multirun <- function(infected_file, - host_file, +pops_multirun <- function(infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, @@ -113,8 +113,8 @@ pops_multirun <- function(infected_file, start_with_soil_populations = FALSE) { config <- c() config$random_seed <- random_seed - config$infected_file <- infected_file - config$host_file <- host_file + config$infected_file_list <- infected_file_list + config$host_file_list <- host_file_list config$total_populations_file <- total_populations_file config$parameter_means <- parameter_means config$parameter_cov_matrix <- parameter_cov_matrix diff --git a/R/validate.R b/R/validate.R index 8fb4e7bb..4919e18c 100644 --- a/R/validate.R +++ b/R/validate.R @@ -51,8 +51,8 @@ validate <- function(infected_years_file, number_of_cores = NA, parameter_means, parameter_cov_matrix, - infected_file, - host_file, + infected_file_list, + host_file_list, total_populations_file, temp = FALSE, temperature_coefficient_file = "", @@ -129,8 +129,8 @@ validate <- function(infected_years_file, start_with_soil_populations = FALSE) { config <- c() config$infected_years_file <- infected_years_file - config$infected_file <- infected_file - config$host_file <- host_file + config$infected_file_list <- infected_file_list + config$host_file_list <- host_file_list config$total_populations_file <- total_populations_file config$parameter_means <- parameter_means config$parameter_cov_matrix <- parameter_cov_matrix From 303dc564253e37ee290a424ef880affa8b8f0e4a Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 18 Dec 2023 15:19:55 -0500 Subject: [PATCH 04/68] replace mortality_on, time_lag, and rate with pest_host_table which contains these plus susceptibility. --- R/calibrate.R | 10 ++-------- R/pops.r | 18 ++++++------------ R/pops_multirun.R | 10 ++-------- R/validate.R | 10 ++-------- 4 files changed, 12 insertions(+), 36 deletions(-) diff --git a/R/calibrate.R b/R/calibrate.R index df7ff595..98b037b6 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -123,6 +123,7 @@ calibrate <- function(infected_years_file, params_to_estimate = c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE), number_of_generations = 7, generation_size = 1000, + pest_host_table, infected_file_list, host_file_list, total_populations_file, @@ -145,9 +146,6 @@ calibrate <- function(infected_years_file, temperature_file = "", lethal_temperature = -12.87, lethal_temperature_month = 1, - mortality_on = FALSE, - mortality_rate = 0, - mortality_time_lag = 0, mortality_frequency = "year", mortality_frequency_n = 1, management = FALSE, @@ -235,9 +233,6 @@ calibrate <- function(infected_years_file, config$survival_rate_month <- survival_rate_month config$survival_rate_day <- survival_rate_day config$survival_rates_file <- survival_rates_file - config$mortality_on <- mortality_on - config$mortality_rate <- mortality_rate - config$mortality_time_lag <- mortality_time_lag config$management <- management config$treatment_dates <- treatment_dates config$treatments_file <- treatments_file @@ -296,6 +291,7 @@ calibrate <- function(infected_years_file, config$use_soils <- use_soils config$soil_starting_pest_file <- soil_starting_pest_file config$start_with_soil_populations <- start_with_soil_populations + config$pest_host_table <- pest_host_table # call configuration function to perform data checks and transform data into # format used in pops c++ @@ -407,8 +403,6 @@ calibrate <- function(infected_years_file, spatial_indices = config$spatial_indices, season_month_start_end = config$season_month_start_end, soil_reservoirs = config$soil_reservoirs, - mortality_rate = config$mortality_rate, - mortality_time_lag = config$mortality_time_lag, start_date = config$start_date, end_date = config$end_date, treatment_method = config$treatment_method, diff --git a/R/pops.r b/R/pops.r index 75782bbb..ca64fc4f 100644 --- a/R/pops.r +++ b/R/pops.r @@ -51,10 +51,6 @@ #' mortality occurs for your pest or pathogen (-50 to 60) #' @param lethal_temperature_month The month in which lethal temperature related mortality occurs #' for your pest or pathogen integer value between 1 and 12 -#' @param mortality_on Boolean to turn host mortality on and off (TRUE or FALSE) -#' @param mortality_rate Rate at which mortality occurs value between 0 and 1 -#' @param mortality_time_lag Time lag from infection until mortality can occur in time steps -#' integer >= 1 #' @param mortality_frequency Sets the frequency of mortality calculations occur either ('year', #' 'month', week', 'day', 'time step', or 'every_n_steps') #' @param mortality_frequency_n Sets number of units from mortality_frequency in which to run the @@ -186,6 +182,10 @@ #' the pest all values in the raster are between 0 and 1. #' @param start_with_soil_populations Boolean to indicate whether to use a starting soil pest or #' pathogen population if TRUE then soil_starting_pest_file is required. +#' @param pest_host_table The file path to a csv that contains the susceptibility, mortality rate, +#' and mortality time lag as columns with each row being the species. Host species must be in the +#' same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table +#' columns. #' #' @useDynLib PoPS, .registration = TRUE #' @importFrom terra app rast xres yres classify extract ext as.points ncol nrow project @@ -204,6 +204,7 @@ pops <- function(infected_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table, temp = FALSE, temperature_coefficient_file = "", precip = FALSE, @@ -223,9 +224,6 @@ pops <- function(infected_file_list, temperature_file = "", lethal_temperature = -12.87, lethal_temperature_month = 1, - mortality_on = FALSE, - mortality_rate = 0, - mortality_time_lag = 0, mortality_frequency = "year", mortality_frequency_n = 1, management = FALSE, @@ -300,9 +298,6 @@ pops <- function(infected_file_list, config$survival_rate_month <- survival_rate_month config$survival_rate_day <- survival_rate_day config$survival_rates_file <- survival_rates_file - config$mortality_on <- mortality_on - config$mortality_rate <- mortality_rate - config$mortality_time_lag <- mortality_time_lag config$management <- management config$treatment_dates <- treatment_dates config$treatments_file <- treatments_file @@ -360,6 +355,7 @@ pops <- function(infected_file_list, config$use_soils <- use_soils config$soil_starting_pest_file <- soil_starting_pest_file config$start_with_soil_populations <- start_with_soil_populations + config$pest_host_table <- pest_host_table config <- configuration(config) @@ -450,8 +446,6 @@ pops <- function(infected_file_list, spatial_indices = config$spatial_indices, season_month_start_end = config$season_month_start_end, soil_reservoirs = config$soil_reservoirs, - mortality_rate = config$mortality_rate, - mortality_time_lag = config$mortality_time_lag, start_date = config$start_date, end_date = config$end_date, treatment_method = config$treatment_method, diff --git a/R/pops_multirun.R b/R/pops_multirun.R index ac1a9b8a..ea195078 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -38,6 +38,7 @@ pops_multirun <- function(infected_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table, temp = FALSE, temperature_coefficient_file = "", precip = FALSE, @@ -57,9 +58,6 @@ pops_multirun <- function(infected_file_list, temperature_file = "", lethal_temperature = -12.87, lethal_temperature_month = 1, - mortality_on = FALSE, - mortality_rate = 0, - mortality_time_lag = 0, mortality_frequency = "year", mortality_frequency_n = 1, management = FALSE, @@ -137,9 +135,6 @@ pops_multirun <- function(infected_file_list, config$survival_rate_month <- survival_rate_month config$survival_rate_day <- survival_rate_day config$survival_rates_file <- survival_rates_file - config$mortality_on <- mortality_on - config$mortality_rate <- mortality_rate - config$mortality_time_lag <- mortality_time_lag config$management <- management config$treatment_dates <- treatment_dates config$treatments_file <- treatments_file @@ -195,6 +190,7 @@ pops_multirun <- function(infected_file_list, config$use_soils <- use_soils config$soil_starting_pest_file <- soil_starting_pest_file config$start_with_soil_populations <- start_with_soil_populations + config$pest_host_table <- pest_host_table config <- configuration(config) @@ -305,8 +301,6 @@ pops_multirun <- function(infected_file_list, spatial_indices = config$spatial_indices, season_month_start_end = config$season_month_start_end, soil_reservoirs = config$soil_reservoirs, - mortality_rate = config$mortality_rate, - mortality_time_lag = config$mortality_time_lag, start_date = config$start_date, end_date = config$end_date, treatment_method = config$treatment_method, diff --git a/R/validate.R b/R/validate.R index 4919e18c..df251b77 100644 --- a/R/validate.R +++ b/R/validate.R @@ -51,6 +51,7 @@ validate <- function(infected_years_file, number_of_cores = NA, parameter_means, parameter_cov_matrix, + pest_host_table, infected_file_list, host_file_list, total_populations_file, @@ -73,9 +74,6 @@ validate <- function(infected_years_file, temperature_file = "", lethal_temperature = -12.87, lethal_temperature_month = 1, - mortality_on = FALSE, - mortality_rate = 0, - mortality_time_lag = 0, mortality_frequency = "year", mortality_frequency_n = 1, management = FALSE, @@ -153,9 +151,6 @@ validate <- function(infected_years_file, config$survival_rate_month <- survival_rate_month config$survival_rate_day <- survival_rate_day config$survival_rates_file <- survival_rates_file - config$mortality_on <- mortality_on - config$mortality_rate <- mortality_rate - config$mortality_time_lag <- mortality_time_lag config$management <- management config$treatment_dates <- treatment_dates config$treatments_file <- treatments_file @@ -214,6 +209,7 @@ validate <- function(infected_years_file, config$use_soils <- use_soils config$soil_starting_pest_file <- soil_starting_pest_file config$start_with_soil_populations <- start_with_soil_populations + config$pest_host_table <- pest_host_table config <- configuration(config) @@ -324,8 +320,6 @@ validate <- function(infected_years_file, spatial_indices = config$spatial_indices, season_month_start_end = config$season_month_start_end, soil_reservoirs = config$soil_reservoirs, - mortality_rate = config$mortality_rate, - mortality_time_lag = config$mortality_time_lag, start_date = config$start_date, end_date = config$end_date, treatment_method = config$treatment_method, From 0b6632f3a8b87941654ccfd178cb99a03ed1a4e6 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 18 Dec 2023 15:22:03 -0500 Subject: [PATCH 05/68] update docs --- man/calibrate.Rd | 37 +++++++++++++++++-------------------- man/pops.Rd | 37 +++++++++++++++++-------------------- man/pops_model.Rd | 7 +------ man/pops_multirun.Rd | 37 +++++++++++++++++-------------------- man/validate.Rd | 37 +++++++++++++++++-------------------- 5 files changed, 69 insertions(+), 86 deletions(-) diff --git a/man/calibrate.Rd b/man/calibrate.Rd index 16d1df22..7f944b4e 100644 --- a/man/calibrate.Rd +++ b/man/calibrate.Rd @@ -13,8 +13,9 @@ calibrate( params_to_estimate = c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE), number_of_generations = 7, generation_size = 1000, - infected_file, - host_file, + pest_host_table, + infected_file_list, + host_file_list, total_populations_file, temp = FALSE, temperature_coefficient_file = "", @@ -35,9 +36,6 @@ calibrate( temperature_file = "", lethal_temperature = -12.87, lethal_temperature_month = 1, - mortality_on = FALSE, - mortality_rate = 0, - mortality_time_lag = 0, mortality_frequency = "year", mortality_frequency_n = 1, management = FALSE, @@ -153,14 +151,20 @@ until 1,000 model runs are less than the threshold value. We recommend running at least 1,000 but the greater this number the more accurate the model parameters selected will be.} -\item{infected_file}{Raster file with initial infections. Units for infections are based on data +\item{pest_host_table}{The file path to a csv that contains the susceptibility, mortality rate, +and mortality time lag as columns with each row being the species. Host species must be in the +same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table +columns.} + +\item{infected_file_list}{paths to raster files with initial infections and standard deviation +for each host can be based in 2 formats (a single file with number of hosts or a single file with +2 layers number of hosts and standard deviation).. Units for infections are based on data availability and the way the units used for your host file is created (e.g. percent area, # of hosts per cell, etc.).} -\item{host_file}{path to raster files with number of hosts and standard deviation on those -estimates can be based in 3 formats (a single file with number of hosts, a single file with 2 -layers number of hosts and standard deviation, or two files 1 with number of hosts and the other -with standard deviation of those estimates). The units for this can be of many formats the two +\item{host_file_list}{paths to raster files with number of hosts and standard deviation on those +estimates can be based in 2 formats (a single file with number of hosts or a single file with 2 +layers number of hosts and standard deviation). The units for this can be of many formats the two most common that we use are either percent area (0 to 100) or # of hosts in the cell. Usually depends on data available and estimation methods.} @@ -229,13 +233,6 @@ mortality occurs for your pest or pathogen (-50 to 60)} \item{lethal_temperature_month}{The month in which lethal temperature related mortality occurs for your pest or pathogen integer value between 1 and 12} -\item{mortality_on}{Boolean to turn host mortality on and off (TRUE or FALSE)} - -\item{mortality_rate}{Rate at which mortality occurs value between 0 and 1} - -\item{mortality_time_lag}{Time lag from infection until mortality can occur in time steps -integer >= 1} - \item{mortality_frequency}{Sets the frequency of mortality calculations occur either ('year', 'month', week', 'day', 'time step', or 'every_n_steps')} @@ -302,8 +299,8 @@ of animals, and date.} \item{use_movements}{This is a boolean to turn on use of the movement module.} \item{start_exposed}{Do your initial conditions start as exposed or infected (only used if -model_type is "SEI"). Default False. If this is TRUE need to have both an infected_file (this -can be a raster of all 0's) and exposed_file} +model_type is "SEI"). Default False. If this is TRUE need to have both infected_files (this +can be a raster of all 0's) and exposed_files} \item{generate_stochasticity}{Boolean to indicate whether to use stochasticity in reproductive functions default is TRUE} @@ -383,7 +380,7 @@ comparing simulations vs. observations. Must be one of "quantity", "allocation", "mcc, quantity, and configuration"). Default is "mcc"} \item{use_initial_condition_uncertainty}{Boolean to indicate whether or not to propagate and -partition uncertainty from initial conditions. If TRUE the infected_file needs to have 2 layers +partition uncertainty from initial conditions. If TRUE the infected_files needs to have 2 layers one with the mean value and one with the standard deviation. If an SEI model is used the exposed_file needs to have 2 layers one with the mean value and one with the standard deviation} diff --git a/man/pops.Rd b/man/pops.Rd index c6a825e6..c09dda4b 100644 --- a/man/pops.Rd +++ b/man/pops.Rd @@ -5,11 +5,12 @@ \title{PoPS (Pest or Pathogen Spread) model} \usage{ pops( - infected_file, - host_file, + infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table, temp = FALSE, temperature_coefficient_file = "", precip = FALSE, @@ -29,9 +30,6 @@ pops( temperature_file = "", lethal_temperature = -12.87, lethal_temperature_month = 1, - mortality_on = FALSE, - mortality_rate = 0, - mortality_time_lag = 0, mortality_frequency = "year", mortality_frequency_n = 1, management = FALSE, @@ -82,14 +80,15 @@ pops( ) } \arguments{ -\item{infected_file}{Raster file with initial infections. Units for infections are based on data +\item{infected_file_list}{paths to raster files with initial infections and standard deviation +for each host can be based in 2 formats (a single file with number of hosts or a single file with +2 layers number of hosts and standard deviation).. Units for infections are based on data availability and the way the units used for your host file is created (e.g. percent area, # of hosts per cell, etc.).} -\item{host_file}{path to raster files with number of hosts and standard deviation on those -estimates can be based in 3 formats (a single file with number of hosts, a single file with 2 -layers number of hosts and standard deviation, or two files 1 with number of hosts and the other -with standard deviation of those estimates). The units for this can be of many formats the two +\item{host_file_list}{paths to raster files with number of hosts and standard deviation on those +estimates can be based in 2 formats (a single file with number of hosts or a single file with 2 +layers number of hosts and standard deviation). The units for this can be of many formats the two most common that we use are either percent area (0 to 100) or # of hosts in the cell. Usually depends on data available and estimation methods.} @@ -108,6 +107,11 @@ estimation ordered from (reproductive_rate, natural_dispersal_distance, percent_natural_dispersal, anthropogenic_dispersal_distance, natural kappa, anthropogenic kappa, network_min_distance, and network_max_distance) Should be 8x8 matrix.} +\item{pest_host_table}{The file path to a csv that contains the susceptibility, mortality rate, +and mortality time lag as columns with each row being the species. Host species must be in the +same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table +columns.} + \item{temp}{boolean that allows the use of temperature coefficients to modify spread (TRUE or FALSE)} @@ -167,13 +171,6 @@ mortality occurs for your pest or pathogen (-50 to 60)} \item{lethal_temperature_month}{The month in which lethal temperature related mortality occurs for your pest or pathogen integer value between 1 and 12} -\item{mortality_on}{Boolean to turn host mortality on and off (TRUE or FALSE)} - -\item{mortality_rate}{Rate at which mortality occurs value between 0 and 1} - -\item{mortality_time_lag}{Time lag from infection until mortality can occur in time steps -integer >= 1} - \item{mortality_frequency}{Sets the frequency of mortality calculations occur either ('year', 'month', week', 'day', 'time step', or 'every_n_steps')} @@ -230,8 +227,8 @@ of animals, and date.} \item{use_movements}{This is a boolean to turn on use of the movement module.} \item{start_exposed}{Do your initial conditions start as exposed or infected (only used if -model_type is "SEI"). Default False. If this is TRUE need to have both an infected_file (this -can be a raster of all 0's) and exposed_file} +model_type is "SEI"). Default False. If this is TRUE need to have both infected_files (this +can be a raster of all 0's) and exposed_files} \item{generate_stochasticity}{Boolean to indicate whether to use stochasticity in reproductive functions default is TRUE} @@ -285,7 +282,7 @@ along the edge. "jump" automatically moves to the nearest node when moving throu "teleport" moves from node to node most likely used for airport and seaport networks.} \item{use_initial_condition_uncertainty}{Boolean to indicate whether or not to propagate and -partition uncertainty from initial conditions. If TRUE the infected_file needs to have 2 layers +partition uncertainty from initial conditions. If TRUE the infected_files needs to have 2 layers one with the mean value and one with the standard deviation. If an SEI model is used the exposed_file needs to have 2 layers one with the mean value and one with the standard deviation} diff --git a/man/pops_model.Rd b/man/pops_model.Rd index 85c159a3..663be917 100644 --- a/man/pops_model.Rd +++ b/man/pops_model.Rd @@ -134,7 +134,7 @@ model type} \item{total_hosts}{matrix of all hosts} -\item{mortality_on}{Boolean to turn host mortality on and off (TRUE or FALSE)} +\item{mortality_on}{Boolean to indicate if mortality is used} \item{mortality_tracker}{matrix of 0's to track mortality per year} @@ -193,11 +193,6 @@ host under optimal weather conditions} \item{soil_reservoirs}{list of matrices with soil pests created from soil_pest_file.} -\item{mortality_rate}{Rate at which mortality occurs value between 0 and 1} - -\item{mortality_time_lag}{Time lag from infection until mortality can occur in time steps -integer >= 1} - \item{start_date}{Date to start the simulation with format ('YYYY_MM_DD')} \item{end_date}{Date to end the simulation with format ('YYYY_MM_DD')} diff --git a/man/pops_multirun.Rd b/man/pops_multirun.Rd index cc515156..f2803580 100644 --- a/man/pops_multirun.Rd +++ b/man/pops_multirun.Rd @@ -5,11 +5,12 @@ \title{PoPS (Pest or Pathogen Spread) model Multiple Runs} \usage{ pops_multirun( - infected_file, - host_file, + infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table, temp = FALSE, temperature_coefficient_file = "", precip = FALSE, @@ -29,9 +30,6 @@ pops_multirun( temperature_file = "", lethal_temperature = -12.87, lethal_temperature_month = 1, - mortality_on = FALSE, - mortality_rate = 0, - mortality_time_lag = 0, mortality_frequency = "year", mortality_frequency_n = 1, management = FALSE, @@ -86,14 +84,15 @@ pops_multirun( ) } \arguments{ -\item{infected_file}{Raster file with initial infections. Units for infections are based on data +\item{infected_file_list}{paths to raster files with initial infections and standard deviation +for each host can be based in 2 formats (a single file with number of hosts or a single file with +2 layers number of hosts and standard deviation).. Units for infections are based on data availability and the way the units used for your host file is created (e.g. percent area, # of hosts per cell, etc.).} -\item{host_file}{path to raster files with number of hosts and standard deviation on those -estimates can be based in 3 formats (a single file with number of hosts, a single file with 2 -layers number of hosts and standard deviation, or two files 1 with number of hosts and the other -with standard deviation of those estimates). The units for this can be of many formats the two +\item{host_file_list}{paths to raster files with number of hosts and standard deviation on those +estimates can be based in 2 formats (a single file with number of hosts or a single file with 2 +layers number of hosts and standard deviation). The units for this can be of many formats the two most common that we use are either percent area (0 to 100) or # of hosts in the cell. Usually depends on data available and estimation methods.} @@ -112,6 +111,11 @@ estimation ordered from (reproductive_rate, natural_dispersal_distance, percent_natural_dispersal, anthropogenic_dispersal_distance, natural kappa, anthropogenic kappa, network_min_distance, and network_max_distance) Should be 8x8 matrix.} +\item{pest_host_table}{The file path to a csv that contains the susceptibility, mortality rate, +and mortality time lag as columns with each row being the species. Host species must be in the +same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table +columns.} + \item{temp}{boolean that allows the use of temperature coefficients to modify spread (TRUE or FALSE)} @@ -171,13 +175,6 @@ mortality occurs for your pest or pathogen (-50 to 60)} \item{lethal_temperature_month}{The month in which lethal temperature related mortality occurs for your pest or pathogen integer value between 1 and 12} -\item{mortality_on}{Boolean to turn host mortality on and off (TRUE or FALSE)} - -\item{mortality_rate}{Rate at which mortality occurs value between 0 and 1} - -\item{mortality_time_lag}{Time lag from infection until mortality can occur in time steps -integer >= 1} - \item{mortality_frequency}{Sets the frequency of mortality calculations occur either ('year', 'month', week', 'day', 'time step', or 'every_n_steps')} @@ -240,8 +237,8 @@ of animals, and date.} \item{use_movements}{This is a boolean to turn on use of the movement module.} \item{start_exposed}{Do your initial conditions start as exposed or infected (only used if -model_type is "SEI"). Default False. If this is TRUE need to have both an infected_file (this -can be a raster of all 0's) and exposed_file} +model_type is "SEI"). Default False. If this is TRUE need to have both infected_files (this +can be a raster of all 0's) and exposed_files} \item{generate_stochasticity}{Boolean to indicate whether to use stochasticity in reproductive functions default is TRUE} @@ -301,7 +298,7 @@ along the edge. "jump" automatically moves to the nearest node when moving throu "teleport" moves from node to node most likely used for airport and seaport networks.} \item{use_initial_condition_uncertainty}{Boolean to indicate whether or not to propagate and -partition uncertainty from initial conditions. If TRUE the infected_file needs to have 2 layers +partition uncertainty from initial conditions. If TRUE the infected_files needs to have 2 layers one with the mean value and one with the standard deviation. If an SEI model is used the exposed_file needs to have 2 layers one with the mean value and one with the standard deviation} diff --git a/man/validate.Rd b/man/validate.Rd index acf60787..91ee7d51 100644 --- a/man/validate.Rd +++ b/man/validate.Rd @@ -11,8 +11,9 @@ validate( number_of_cores = NA, parameter_means, parameter_cov_matrix, - infected_file, - host_file, + pest_host_table, + infected_file_list, + host_file_list, total_populations_file, temp = FALSE, temperature_coefficient_file = "", @@ -33,9 +34,6 @@ validate( temperature_file = "", lethal_temperature = -12.87, lethal_temperature_month = 1, - mortality_on = FALSE, - mortality_rate = 0, - mortality_time_lag = 0, mortality_frequency = "year", mortality_frequency_n = 1, management = FALSE, @@ -105,14 +103,20 @@ If not set uses the # of CPU cores - 1. must be an integer >= 1} \item{parameter_cov_matrix}{the parameter covariance matrix from the ABC calibration function (posterior covariance matrix)} -\item{infected_file}{Raster file with initial infections. Units for infections are based on data +\item{pest_host_table}{The file path to a csv that contains the susceptibility, mortality rate, +and mortality time lag as columns with each row being the species. Host species must be in the +same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table +columns.} + +\item{infected_file_list}{paths to raster files with initial infections and standard deviation +for each host can be based in 2 formats (a single file with number of hosts or a single file with +2 layers number of hosts and standard deviation).. Units for infections are based on data availability and the way the units used for your host file is created (e.g. percent area, # of hosts per cell, etc.).} -\item{host_file}{path to raster files with number of hosts and standard deviation on those -estimates can be based in 3 formats (a single file with number of hosts, a single file with 2 -layers number of hosts and standard deviation, or two files 1 with number of hosts and the other -with standard deviation of those estimates). The units for this can be of many formats the two +\item{host_file_list}{paths to raster files with number of hosts and standard deviation on those +estimates can be based in 2 formats (a single file with number of hosts or a single file with 2 +layers number of hosts and standard deviation). The units for this can be of many formats the two most common that we use are either percent area (0 to 100) or # of hosts in the cell. Usually depends on data available and estimation methods.} @@ -181,13 +185,6 @@ mortality occurs for your pest or pathogen (-50 to 60)} \item{lethal_temperature_month}{The month in which lethal temperature related mortality occurs for your pest or pathogen integer value between 1 and 12} -\item{mortality_on}{Boolean to turn host mortality on and off (TRUE or FALSE)} - -\item{mortality_rate}{Rate at which mortality occurs value between 0 and 1} - -\item{mortality_time_lag}{Time lag from infection until mortality can occur in time steps -integer >= 1} - \item{mortality_frequency}{Sets the frequency of mortality calculations occur either ('year', 'month', week', 'day', 'time step', or 'every_n_steps')} @@ -246,8 +243,8 @@ of animals, and date.} \item{use_movements}{This is a boolean to turn on use of the movement module.} \item{start_exposed}{Do your initial conditions start as exposed or infected (only used if -model_type is "SEI"). Default False. If this is TRUE need to have both an infected_file (this -can be a raster of all 0's) and exposed_file} +model_type is "SEI"). Default False. If this is TRUE need to have both infected_files (this +can be a raster of all 0's) and exposed_files} \item{generate_stochasticity}{Boolean to indicate whether to use stochasticity in reproductive functions default is TRUE} @@ -311,7 +308,7 @@ simulations and observations. Default is FALSE.} disagreement for comparing model runs. Default is FALSE.} \item{use_initial_condition_uncertainty}{Boolean to indicate whether or not to propagate and -partition uncertainty from initial conditions. If TRUE the infected_file needs to have 2 layers +partition uncertainty from initial conditions. If TRUE the infected_files needs to have 2 layers one with the mean value and one with the standard deviation. If an SEI model is used the exposed_file needs to have 2 layers one with the mean value and one with the standard deviation} From de68975a3e50fdc2caed8197142eb78c30670d01 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 18 Dec 2023 15:24:50 -0500 Subject: [PATCH 06/68] update mortality on for pops_model. --- R/pops_model.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/pops_model.R b/R/pops_model.R index 547ca876..4a97a391 100644 --- a/R/pops_model.R +++ b/R/pops_model.R @@ -11,6 +11,7 @@ #' @param weather Boolean that is true if weather is used #' @param infected matrix of infected hosts #' @param susceptible matrix of susceptible hosts +#' @param mortality_on Boolean to indicate if mortality is used #' @param mortality_tracker matrix of 0's to track mortality per year #' @param mortality matrix to track cumulative mortality #' @param resistant matrix to track resistant population over time From ce7cfb6b67195e102e52f5123eac7111c062531e Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 18 Dec 2023 15:37:39 -0500 Subject: [PATCH 07/68] add competecy-table parameter. --- R/calibrate.R | 2 ++ R/pops.r | 6 ++++++ R/pops_multirun.R | 2 ++ R/validate.R | 2 ++ man/calibrate.Rd | 5 +++++ man/pops.Rd | 5 +++++ man/pops_multirun.Rd | 5 +++++ man/validate.Rd | 5 +++++ 8 files changed, 32 insertions(+) diff --git a/R/calibrate.R b/R/calibrate.R index 98b037b6..bb36e4b5 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -124,6 +124,7 @@ calibrate <- function(infected_years_file, number_of_generations = 7, generation_size = 1000, pest_host_table, + competency_table, infected_file_list, host_file_list, total_populations_file, @@ -292,6 +293,7 @@ calibrate <- function(infected_years_file, config$soil_starting_pest_file <- soil_starting_pest_file config$start_with_soil_populations <- start_with_soil_populations config$pest_host_table <- pest_host_table + config$competency_table <- competency_table # call configuration function to perform data checks and transform data into # format used in pops c++ diff --git a/R/pops.r b/R/pops.r index ca64fc4f..2f07b85e 100644 --- a/R/pops.r +++ b/R/pops.r @@ -186,6 +186,10 @@ #' and mortality time lag as columns with each row being the species. Host species must be in the #' same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table #' columns. +#' @param competency_table A csv with the hosts as the first n columns (n being the number of hosts) +#' and the last column being the competency value. Each row is a set of booleans for host presence +#' and the competency value for that combination of hosts in a cell. +#' #' #' @useDynLib PoPS, .registration = TRUE #' @importFrom terra app rast xres yres classify extract ext as.points ncol nrow project @@ -205,6 +209,7 @@ pops <- function(infected_file_list, parameter_means, parameter_cov_matrix, pest_host_table, + competency_table, temp = FALSE, temperature_coefficient_file = "", precip = FALSE, @@ -356,6 +361,7 @@ pops <- function(infected_file_list, config$soil_starting_pest_file <- soil_starting_pest_file config$start_with_soil_populations <- start_with_soil_populations config$pest_host_table <- pest_host_table + config$competency_table <- competency_table config <- configuration(config) diff --git a/R/pops_multirun.R b/R/pops_multirun.R index ea195078..aa2cbf39 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -39,6 +39,7 @@ pops_multirun <- function(infected_file_list, parameter_means, parameter_cov_matrix, pest_host_table, + competency_table, temp = FALSE, temperature_coefficient_file = "", precip = FALSE, @@ -191,6 +192,7 @@ pops_multirun <- function(infected_file_list, config$soil_starting_pest_file <- soil_starting_pest_file config$start_with_soil_populations <- start_with_soil_populations config$pest_host_table <- pest_host_table + config$competency_table <- competency_table config <- configuration(config) diff --git a/R/validate.R b/R/validate.R index df251b77..b2edaa7f 100644 --- a/R/validate.R +++ b/R/validate.R @@ -52,6 +52,7 @@ validate <- function(infected_years_file, parameter_means, parameter_cov_matrix, pest_host_table, + competency_table, infected_file_list, host_file_list, total_populations_file, @@ -210,6 +211,7 @@ validate <- function(infected_years_file, config$soil_starting_pest_file <- soil_starting_pest_file config$start_with_soil_populations <- start_with_soil_populations config$pest_host_table <- pest_host_table + config$competency_table <- competency_table config <- configuration(config) diff --git a/man/calibrate.Rd b/man/calibrate.Rd index 7f944b4e..685b2ecc 100644 --- a/man/calibrate.Rd +++ b/man/calibrate.Rd @@ -14,6 +14,7 @@ calibrate( number_of_generations = 7, generation_size = 1000, pest_host_table, + competency_table, infected_file_list, host_file_list, total_populations_file, @@ -156,6 +157,10 @@ and mortality time lag as columns with each row being the species. Host species same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table columns.} +\item{competency_table}{A csv with the hosts as the first n columns (n being the number of hosts) +and the last column being the competency value. Each row is a set of booleans for host presence +and the competency value for that combination of hosts in a cell.} + \item{infected_file_list}{paths to raster files with initial infections and standard deviation for each host can be based in 2 formats (a single file with number of hosts or a single file with 2 layers number of hosts and standard deviation).. Units for infections are based on data diff --git a/man/pops.Rd b/man/pops.Rd index c09dda4b..21490d3b 100644 --- a/man/pops.Rd +++ b/man/pops.Rd @@ -11,6 +11,7 @@ pops( parameter_means, parameter_cov_matrix, pest_host_table, + competency_table, temp = FALSE, temperature_coefficient_file = "", precip = FALSE, @@ -112,6 +113,10 @@ and mortality time lag as columns with each row being the species. Host species same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table columns.} +\item{competency_table}{A csv with the hosts as the first n columns (n being the number of hosts) +and the last column being the competency value. Each row is a set of booleans for host presence +and the competency value for that combination of hosts in a cell.} + \item{temp}{boolean that allows the use of temperature coefficients to modify spread (TRUE or FALSE)} diff --git a/man/pops_multirun.Rd b/man/pops_multirun.Rd index f2803580..1803cf26 100644 --- a/man/pops_multirun.Rd +++ b/man/pops_multirun.Rd @@ -11,6 +11,7 @@ pops_multirun( parameter_means, parameter_cov_matrix, pest_host_table, + competency_table, temp = FALSE, temperature_coefficient_file = "", precip = FALSE, @@ -116,6 +117,10 @@ and mortality time lag as columns with each row being the species. Host species same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table columns.} +\item{competency_table}{A csv with the hosts as the first n columns (n being the number of hosts) +and the last column being the competency value. Each row is a set of booleans for host presence +and the competency value for that combination of hosts in a cell.} + \item{temp}{boolean that allows the use of temperature coefficients to modify spread (TRUE or FALSE)} diff --git a/man/validate.Rd b/man/validate.Rd index 91ee7d51..3475512f 100644 --- a/man/validate.Rd +++ b/man/validate.Rd @@ -12,6 +12,7 @@ validate( parameter_means, parameter_cov_matrix, pest_host_table, + competency_table, infected_file_list, host_file_list, total_populations_file, @@ -108,6 +109,10 @@ and mortality time lag as columns with each row being the species. Host species same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table columns.} +\item{competency_table}{A csv with the hosts as the first n columns (n being the number of hosts) +and the last column being the competency value. Each row is a set of booleans for host presence +and the competency value for that combination of hosts in a cell.} + \item{infected_file_list}{paths to raster files with initial infections and standard deviation for each host can be based in 2 formats (a single file with number of hosts or a single file with 2 layers number of hosts and standard deviation).. Units for infections are based on data From 7f7e5757ab8264ea809780d826df0dd1ae3e9040 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 18 Dec 2023 16:07:40 -0500 Subject: [PATCH 08/68] update docs --- R/pops.r | 12 ++++++------ man/calibrate.Rd | 12 ++++++------ man/pops.Rd | 12 ++++++------ man/pops_multirun.Rd | 12 ++++++------ man/validate.Rd | 12 ++++++------ 5 files changed, 30 insertions(+), 30 deletions(-) diff --git a/R/pops.r b/R/pops.r index 2f07b85e..05970966 100644 --- a/R/pops.r +++ b/R/pops.r @@ -182,13 +182,13 @@ #' the pest all values in the raster are between 0 and 1. #' @param start_with_soil_populations Boolean to indicate whether to use a starting soil pest or #' pathogen population if TRUE then soil_starting_pest_file is required. -#' @param pest_host_table The file path to a csv that contains the susceptibility, mortality rate, -#' and mortality time lag as columns with each row being the species. Host species must be in the -#' same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table -#' columns. +#' @param pest_host_table The file path to a csv that has these columns in this order +#' susceptibility, mortality rate, and mortality time lag as columns with each row being the +#' species. Host species must be in the same order in the host_file_list, infected_file_list, +#' pest_host_table rows, and competency_table columns. #' @param competency_table A csv with the hosts as the first n columns (n being the number of hosts) -#' and the last column being the competency value. Each row is a set of booleans for host presence -#' and the competency value for that combination of hosts in a cell. +#' and the last column being the competency value. Each row is a set of Boolean for host presence +#' and the competency value (between 0 and 1) for that combination of hosts in a cell. #' #' #' @useDynLib PoPS, .registration = TRUE diff --git a/man/calibrate.Rd b/man/calibrate.Rd index 685b2ecc..adcea2e1 100644 --- a/man/calibrate.Rd +++ b/man/calibrate.Rd @@ -152,14 +152,14 @@ until 1,000 model runs are less than the threshold value. We recommend running at least 1,000 but the greater this number the more accurate the model parameters selected will be.} -\item{pest_host_table}{The file path to a csv that contains the susceptibility, mortality rate, -and mortality time lag as columns with each row being the species. Host species must be in the -same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table -columns.} +\item{pest_host_table}{The file path to a csv that has these columns in this order +susceptibility, mortality rate, and mortality time lag as columns with each row being the +species. Host species must be in the same order in the host_file_list, infected_file_list, +pest_host_table rows, and competency_table columns.} \item{competency_table}{A csv with the hosts as the first n columns (n being the number of hosts) -and the last column being the competency value. Each row is a set of booleans for host presence -and the competency value for that combination of hosts in a cell.} +and the last column being the competency value. Each row is a set of Boolean for host presence +and the competency value (between 0 and 1) for that combination of hosts in a cell.} \item{infected_file_list}{paths to raster files with initial infections and standard deviation for each host can be based in 2 formats (a single file with number of hosts or a single file with diff --git a/man/pops.Rd b/man/pops.Rd index 21490d3b..0e2c6c87 100644 --- a/man/pops.Rd +++ b/man/pops.Rd @@ -108,14 +108,14 @@ estimation ordered from (reproductive_rate, natural_dispersal_distance, percent_natural_dispersal, anthropogenic_dispersal_distance, natural kappa, anthropogenic kappa, network_min_distance, and network_max_distance) Should be 8x8 matrix.} -\item{pest_host_table}{The file path to a csv that contains the susceptibility, mortality rate, -and mortality time lag as columns with each row being the species. Host species must be in the -same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table -columns.} +\item{pest_host_table}{The file path to a csv that has these columns in this order +susceptibility, mortality rate, and mortality time lag as columns with each row being the +species. Host species must be in the same order in the host_file_list, infected_file_list, +pest_host_table rows, and competency_table columns.} \item{competency_table}{A csv with the hosts as the first n columns (n being the number of hosts) -and the last column being the competency value. Each row is a set of booleans for host presence -and the competency value for that combination of hosts in a cell.} +and the last column being the competency value. Each row is a set of Boolean for host presence +and the competency value (between 0 and 1) for that combination of hosts in a cell.} \item{temp}{boolean that allows the use of temperature coefficients to modify spread (TRUE or FALSE)} diff --git a/man/pops_multirun.Rd b/man/pops_multirun.Rd index 1803cf26..ffbc61dc 100644 --- a/man/pops_multirun.Rd +++ b/man/pops_multirun.Rd @@ -112,14 +112,14 @@ estimation ordered from (reproductive_rate, natural_dispersal_distance, percent_natural_dispersal, anthropogenic_dispersal_distance, natural kappa, anthropogenic kappa, network_min_distance, and network_max_distance) Should be 8x8 matrix.} -\item{pest_host_table}{The file path to a csv that contains the susceptibility, mortality rate, -and mortality time lag as columns with each row being the species. Host species must be in the -same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table -columns.} +\item{pest_host_table}{The file path to a csv that has these columns in this order +susceptibility, mortality rate, and mortality time lag as columns with each row being the +species. Host species must be in the same order in the host_file_list, infected_file_list, +pest_host_table rows, and competency_table columns.} \item{competency_table}{A csv with the hosts as the first n columns (n being the number of hosts) -and the last column being the competency value. Each row is a set of booleans for host presence -and the competency value for that combination of hosts in a cell.} +and the last column being the competency value. Each row is a set of Boolean for host presence +and the competency value (between 0 and 1) for that combination of hosts in a cell.} \item{temp}{boolean that allows the use of temperature coefficients to modify spread (TRUE or FALSE)} diff --git a/man/validate.Rd b/man/validate.Rd index 3475512f..bbb48894 100644 --- a/man/validate.Rd +++ b/man/validate.Rd @@ -104,14 +104,14 @@ If not set uses the # of CPU cores - 1. must be an integer >= 1} \item{parameter_cov_matrix}{the parameter covariance matrix from the ABC calibration function (posterior covariance matrix)} -\item{pest_host_table}{The file path to a csv that contains the susceptibility, mortality rate, -and mortality time lag as columns with each row being the species. Host species must be in the -same order in the host_file_list, infected_file_list, pest_host_table rows, and competency_table -columns.} +\item{pest_host_table}{The file path to a csv that has these columns in this order +susceptibility, mortality rate, and mortality time lag as columns with each row being the +species. Host species must be in the same order in the host_file_list, infected_file_list, +pest_host_table rows, and competency_table columns.} \item{competency_table}{A csv with the hosts as the first n columns (n being the number of hosts) -and the last column being the competency value. Each row is a set of booleans for host presence -and the competency value for that combination of hosts in a cell.} +and the last column being the competency value. Each row is a set of Boolean for host presence +and the competency value (between 0 and 1) for that combination of hosts in a cell.} \item{infected_file_list}{paths to raster files with initial infections and standard deviation for each host can be based in 2 formats (a single file with number of hosts or a single file with From 9c373ee08fa028cc5ca730c4edc149fe846fcd9c Mon Sep 17 00:00:00 2001 From: Anna Petrasova Date: Mon, 18 Dec 2023 16:09:37 -0500 Subject: [PATCH 09/68] accept multi host in pops_model_cpp --- R/RcppExports.R | 6 +- inst/include/PoPS_RcppExports.h | 8 +- src/RcppExports.cpp | 27 ++--- src/pops.cpp | 174 ++++++++++++++++++-------------- 4 files changed, 113 insertions(+), 102 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index 8d188761..166dc0b0 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -1,11 +1,11 @@ # Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 -pops_model_cpp <- function(random_seed, multiple_random_seeds, random_seeds, lethal_temperature, lethal_temperature_month, infected, total_exposed, exposed, susceptible, total_populations, total_hosts, mortality_tracker, mortality, quarantine_areas, quarantine_directions, treatment_maps, treatment_dates, pesticide_duration, resistant, movements, movements_dates, temperature, survival_rates, weather_coefficient, weather_coefficient_sd, bbox, res, rows_cols, soil_reservoirs, reproductive_rate, spatial_indices, season_month_start_end, frequency_config, bool_config, mortality_rate = 0.0, mortality_time_lag = 2L, start_date = "2018-01-01", end_date = "2018-12-31", treatment_method = "ratio", natural_kernel_type = "cauchy", anthropogenic_kernel_type = "cauchy", percent_natural_dispersal = 0.0, natural_distance_scale = 21, anthropogenic_distance_scale = 0.0, natural_dir = "NONE", natural_kappa = 0, anthropogenic_dir = "NONE", anthropogenic_kappa = 0, frequencies_n_config = NULL, model_type_ = "SI", latency_period = 0L, establishment_probability = 0, dispersal_percentage = 0.99, survival_rate_month = 0L, survival_rate_day = 0L, overpopulation_config = NULL, network_config = NULL, network_data_config = NULL, weather_size = 0L, weather_type = "deterministic", dispersers_to_soils_percentage = 0) { - .Call(`_PoPS_pops_model_cpp`, random_seed, multiple_random_seeds, random_seeds, lethal_temperature, lethal_temperature_month, infected, total_exposed, exposed, susceptible, total_populations, total_hosts, mortality_tracker, mortality, quarantine_areas, quarantine_directions, treatment_maps, treatment_dates, pesticide_duration, resistant, movements, movements_dates, temperature, survival_rates, weather_coefficient, weather_coefficient_sd, bbox, res, rows_cols, soil_reservoirs, reproductive_rate, spatial_indices, season_month_start_end, frequency_config, bool_config, mortality_rate, mortality_time_lag, start_date, end_date, treatment_method, natural_kernel_type, anthropogenic_kernel_type, percent_natural_dispersal, natural_distance_scale, anthropogenic_distance_scale, natural_dir, natural_kappa, anthropogenic_dir, anthropogenic_kappa, frequencies_n_config, model_type_, latency_period, establishment_probability, dispersal_percentage, survival_rate_month, survival_rate_day, overpopulation_config, network_config, network_data_config, weather_size, weather_type, dispersers_to_soils_percentage) +pops_model_cpp <- function(random_seed, multiple_random_seeds, random_seeds, lethal_temperature, lethal_temperature_month, host_pools, total_populations, competency_table, pest_host_table, quarantine_areas, quarantine_directions, treatment_maps, treatment_dates, pesticide_duration, movements, movements_dates, temperature, survival_rates, weather_coefficient, weather_coefficient_sd, bbox, res, rows_cols, soil_reservoirs, reproductive_rate, spatial_indices, season_month_start_end, frequency_config, bool_config, start_date = "2018-01-01", end_date = "2018-12-31", treatment_method = "ratio", natural_kernel_type = "cauchy", anthropogenic_kernel_type = "cauchy", percent_natural_dispersal = 0.0, natural_distance_scale = 21, anthropogenic_distance_scale = 0.0, natural_dir = "NONE", natural_kappa = 0, anthropogenic_dir = "NONE", anthropogenic_kappa = 0, frequencies_n_config = NULL, model_type_ = "SI", latency_period = 0L, establishment_probability = 0, dispersal_percentage = 0.99, survival_rate_month = 0L, survival_rate_day = 0L, overpopulation_config = NULL, network_config = NULL, network_data_config = NULL, weather_size = 0L, weather_type = "deterministic", dispersers_to_soils_percentage = 0) { + .Call(`_PoPS_pops_model_cpp`, random_seed, multiple_random_seeds, random_seeds, lethal_temperature, lethal_temperature_month, host_pools, total_populations, competency_table, pest_host_table, quarantine_areas, quarantine_directions, treatment_maps, treatment_dates, pesticide_duration, movements, movements_dates, temperature, survival_rates, weather_coefficient, weather_coefficient_sd, bbox, res, rows_cols, soil_reservoirs, reproductive_rate, spatial_indices, season_month_start_end, frequency_config, bool_config, start_date, end_date, treatment_method, natural_kernel_type, anthropogenic_kernel_type, percent_natural_dispersal, natural_distance_scale, anthropogenic_distance_scale, natural_dir, natural_kappa, anthropogenic_dir, anthropogenic_kappa, frequencies_n_config, model_type_, latency_period, establishment_probability, dispersal_percentage, survival_rate_month, survival_rate_day, overpopulation_config, network_config, network_data_config, weather_size, weather_type, dispersers_to_soils_percentage) } # Register entry points for exported C++ functions methods::setLoadAction(function(ns) { - .Call('_PoPS_RcppExport_registerCCallable', PACKAGE = 'PoPS') + .Call(`_PoPS_RcppExport_registerCCallable`) }) diff --git a/inst/include/PoPS_RcppExports.h b/inst/include/PoPS_RcppExports.h index df011e15..b0e48deb 100644 --- a/inst/include/PoPS_RcppExports.h +++ b/inst/include/PoPS_RcppExports.h @@ -24,17 +24,17 @@ namespace PoPS { } } - inline List pops_model_cpp(int random_seed, bool multiple_random_seeds, std::vector random_seeds, double lethal_temperature, int lethal_temperature_month, IntegerMatrix infected, IntegerMatrix total_exposed, std::vector exposed, IntegerMatrix susceptible, IntegerMatrix total_populations, IntegerMatrix total_hosts, std::vector mortality_tracker, IntegerMatrix mortality, IntegerMatrix quarantine_areas, std::string quarantine_directions, std::vector treatment_maps, std::vector treatment_dates, std::vector pesticide_duration, IntegerMatrix resistant, std::vector> movements, std::vector movements_dates, std::vector temperature, std::vector survival_rates, std::vector weather_coefficient, std::vector weather_coefficient_sd, List bbox, List res, List rows_cols, std::vector soil_reservoirs, double reproductive_rate, std::vector> spatial_indices, List season_month_start_end, List frequency_config, List bool_config, double mortality_rate = 0.0, int mortality_time_lag = 2, std::string start_date = "2018-01-01", std::string end_date = "2018-12-31", std::string treatment_method = "ratio", std::string natural_kernel_type = "cauchy", std::string anthropogenic_kernel_type = "cauchy", double percent_natural_dispersal = 0.0, double natural_distance_scale = 21, double anthropogenic_distance_scale = 0.0, std::string natural_dir = "NONE", double natural_kappa = 0, std::string anthropogenic_dir = "NONE", double anthropogenic_kappa = 0, Nullable frequencies_n_config = R_NilValue, std::string model_type_ = "SI", int latency_period = 0, double establishment_probability = 0, double dispersal_percentage = 0.99, int survival_rate_month = 0, int survival_rate_day = 0, Nullable overpopulation_config = R_NilValue, Nullable network_config = R_NilValue, Nullable network_data_config = R_NilValue, int weather_size = 0, std::string weather_type = "deterministic", double dispersers_to_soils_percentage = 0) { - typedef SEXP(*Ptr_pops_model_cpp)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); + inline List pops_model_cpp(int random_seed, bool multiple_random_seeds, std::vector random_seeds, double lethal_temperature, int lethal_temperature_month, std::vector host_pools, IntegerMatrix total_populations, std::vector> competency_table, std::vector> pest_host_table, IntegerMatrix quarantine_areas, std::string quarantine_directions, std::vector treatment_maps, std::vector treatment_dates, std::vector pesticide_duration, std::vector> movements, std::vector movements_dates, std::vector temperature, std::vector survival_rates, std::vector weather_coefficient, std::vector weather_coefficient_sd, List bbox, List res, List rows_cols, std::vector soil_reservoirs, double reproductive_rate, std::vector> spatial_indices, List season_month_start_end, List frequency_config, List bool_config, std::string start_date = "2018-01-01", std::string end_date = "2018-12-31", std::string treatment_method = "ratio", std::string natural_kernel_type = "cauchy", std::string anthropogenic_kernel_type = "cauchy", double percent_natural_dispersal = 0.0, double natural_distance_scale = 21, double anthropogenic_distance_scale = 0.0, std::string natural_dir = "NONE", double natural_kappa = 0, std::string anthropogenic_dir = "NONE", double anthropogenic_kappa = 0, Nullable frequencies_n_config = R_NilValue, std::string model_type_ = "SI", int latency_period = 0, double establishment_probability = 0, double dispersal_percentage = 0.99, int survival_rate_month = 0, int survival_rate_day = 0, Nullable overpopulation_config = R_NilValue, Nullable network_config = R_NilValue, Nullable network_data_config = R_NilValue, int weather_size = 0, std::string weather_type = "deterministic", double dispersers_to_soils_percentage = 0) { + typedef SEXP(*Ptr_pops_model_cpp)(SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP,SEXP); static Ptr_pops_model_cpp p_pops_model_cpp = NULL; if (p_pops_model_cpp == NULL) { - validateSignature("List(*pops_model_cpp)(int,bool,std::vector,double,int,IntegerMatrix,IntegerMatrix,std::vector,IntegerMatrix,IntegerMatrix,IntegerMatrix,std::vector,IntegerMatrix,IntegerMatrix,std::string,std::vector,std::vector,std::vector,IntegerMatrix,std::vector>,std::vector,std::vector,std::vector,std::vector,std::vector,List,List,List,std::vector,double,std::vector>,List,List,List,double,int,std::string,std::string,std::string,std::string,std::string,double,double,double,std::string,double,std::string,double,Nullable,std::string,int,double,double,int,int,Nullable,Nullable,Nullable,int,std::string,double)"); + validateSignature("List(*pops_model_cpp)(int,bool,std::vector,double,int,std::vector,IntegerMatrix,std::vector>,std::vector>,IntegerMatrix,std::string,std::vector,std::vector,std::vector,std::vector>,std::vector,std::vector,std::vector,std::vector,std::vector,List,List,List,std::vector,double,std::vector>,List,List,List,std::string,std::string,std::string,std::string,std::string,double,double,double,std::string,double,std::string,double,Nullable,std::string,int,double,double,int,int,Nullable,Nullable,Nullable,int,std::string,double)"); p_pops_model_cpp = (Ptr_pops_model_cpp)R_GetCCallable("PoPS", "_PoPS_pops_model_cpp"); } RObject rcpp_result_gen; { RNGScope RCPP_rngScope_gen; - rcpp_result_gen = p_pops_model_cpp(Shield(Rcpp::wrap(random_seed)), Shield(Rcpp::wrap(multiple_random_seeds)), Shield(Rcpp::wrap(random_seeds)), Shield(Rcpp::wrap(lethal_temperature)), Shield(Rcpp::wrap(lethal_temperature_month)), Shield(Rcpp::wrap(infected)), Shield(Rcpp::wrap(total_exposed)), Shield(Rcpp::wrap(exposed)), Shield(Rcpp::wrap(susceptible)), Shield(Rcpp::wrap(total_populations)), Shield(Rcpp::wrap(total_hosts)), Shield(Rcpp::wrap(mortality_tracker)), Shield(Rcpp::wrap(mortality)), Shield(Rcpp::wrap(quarantine_areas)), Shield(Rcpp::wrap(quarantine_directions)), Shield(Rcpp::wrap(treatment_maps)), Shield(Rcpp::wrap(treatment_dates)), Shield(Rcpp::wrap(pesticide_duration)), Shield(Rcpp::wrap(resistant)), Shield(Rcpp::wrap(movements)), Shield(Rcpp::wrap(movements_dates)), Shield(Rcpp::wrap(temperature)), Shield(Rcpp::wrap(survival_rates)), Shield(Rcpp::wrap(weather_coefficient)), Shield(Rcpp::wrap(weather_coefficient_sd)), Shield(Rcpp::wrap(bbox)), Shield(Rcpp::wrap(res)), Shield(Rcpp::wrap(rows_cols)), Shield(Rcpp::wrap(soil_reservoirs)), Shield(Rcpp::wrap(reproductive_rate)), Shield(Rcpp::wrap(spatial_indices)), Shield(Rcpp::wrap(season_month_start_end)), Shield(Rcpp::wrap(frequency_config)), Shield(Rcpp::wrap(bool_config)), Shield(Rcpp::wrap(mortality_rate)), Shield(Rcpp::wrap(mortality_time_lag)), Shield(Rcpp::wrap(start_date)), Shield(Rcpp::wrap(end_date)), Shield(Rcpp::wrap(treatment_method)), Shield(Rcpp::wrap(natural_kernel_type)), Shield(Rcpp::wrap(anthropogenic_kernel_type)), Shield(Rcpp::wrap(percent_natural_dispersal)), Shield(Rcpp::wrap(natural_distance_scale)), Shield(Rcpp::wrap(anthropogenic_distance_scale)), Shield(Rcpp::wrap(natural_dir)), Shield(Rcpp::wrap(natural_kappa)), Shield(Rcpp::wrap(anthropogenic_dir)), Shield(Rcpp::wrap(anthropogenic_kappa)), Shield(Rcpp::wrap(frequencies_n_config)), Shield(Rcpp::wrap(model_type_)), Shield(Rcpp::wrap(latency_period)), Shield(Rcpp::wrap(establishment_probability)), Shield(Rcpp::wrap(dispersal_percentage)), Shield(Rcpp::wrap(survival_rate_month)), Shield(Rcpp::wrap(survival_rate_day)), Shield(Rcpp::wrap(overpopulation_config)), Shield(Rcpp::wrap(network_config)), Shield(Rcpp::wrap(network_data_config)), Shield(Rcpp::wrap(weather_size)), Shield(Rcpp::wrap(weather_type)), Shield(Rcpp::wrap(dispersers_to_soils_percentage))); + rcpp_result_gen = p_pops_model_cpp(Shield(Rcpp::wrap(random_seed)), Shield(Rcpp::wrap(multiple_random_seeds)), Shield(Rcpp::wrap(random_seeds)), Shield(Rcpp::wrap(lethal_temperature)), Shield(Rcpp::wrap(lethal_temperature_month)), Shield(Rcpp::wrap(host_pools)), Shield(Rcpp::wrap(total_populations)), Shield(Rcpp::wrap(competency_table)), Shield(Rcpp::wrap(pest_host_table)), Shield(Rcpp::wrap(quarantine_areas)), Shield(Rcpp::wrap(quarantine_directions)), Shield(Rcpp::wrap(treatment_maps)), Shield(Rcpp::wrap(treatment_dates)), Shield(Rcpp::wrap(pesticide_duration)), Shield(Rcpp::wrap(movements)), Shield(Rcpp::wrap(movements_dates)), Shield(Rcpp::wrap(temperature)), Shield(Rcpp::wrap(survival_rates)), Shield(Rcpp::wrap(weather_coefficient)), Shield(Rcpp::wrap(weather_coefficient_sd)), Shield(Rcpp::wrap(bbox)), Shield(Rcpp::wrap(res)), Shield(Rcpp::wrap(rows_cols)), Shield(Rcpp::wrap(soil_reservoirs)), Shield(Rcpp::wrap(reproductive_rate)), Shield(Rcpp::wrap(spatial_indices)), Shield(Rcpp::wrap(season_month_start_end)), Shield(Rcpp::wrap(frequency_config)), Shield(Rcpp::wrap(bool_config)), Shield(Rcpp::wrap(start_date)), Shield(Rcpp::wrap(end_date)), Shield(Rcpp::wrap(treatment_method)), Shield(Rcpp::wrap(natural_kernel_type)), Shield(Rcpp::wrap(anthropogenic_kernel_type)), Shield(Rcpp::wrap(percent_natural_dispersal)), Shield(Rcpp::wrap(natural_distance_scale)), Shield(Rcpp::wrap(anthropogenic_distance_scale)), Shield(Rcpp::wrap(natural_dir)), Shield(Rcpp::wrap(natural_kappa)), Shield(Rcpp::wrap(anthropogenic_dir)), Shield(Rcpp::wrap(anthropogenic_kappa)), Shield(Rcpp::wrap(frequencies_n_config)), Shield(Rcpp::wrap(model_type_)), Shield(Rcpp::wrap(latency_period)), Shield(Rcpp::wrap(establishment_probability)), Shield(Rcpp::wrap(dispersal_percentage)), Shield(Rcpp::wrap(survival_rate_month)), Shield(Rcpp::wrap(survival_rate_day)), Shield(Rcpp::wrap(overpopulation_config)), Shield(Rcpp::wrap(network_config)), Shield(Rcpp::wrap(network_data_config)), Shield(Rcpp::wrap(weather_size)), Shield(Rcpp::wrap(weather_type)), Shield(Rcpp::wrap(dispersers_to_soils_percentage))); } if (rcpp_result_gen.inherits("interrupted-error")) throw Rcpp::internal::InterruptedException(); diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 8d147d66..b84dbd0b 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -14,8 +14,8 @@ Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); #endif // pops_model_cpp -List pops_model_cpp(int random_seed, bool multiple_random_seeds, std::vector random_seeds, double lethal_temperature, int lethal_temperature_month, IntegerMatrix infected, IntegerMatrix total_exposed, std::vector exposed, IntegerMatrix susceptible, IntegerMatrix total_populations, IntegerMatrix total_hosts, std::vector mortality_tracker, IntegerMatrix mortality, IntegerMatrix quarantine_areas, std::string quarantine_directions, std::vector treatment_maps, std::vector treatment_dates, std::vector pesticide_duration, IntegerMatrix resistant, std::vector> movements, std::vector movements_dates, std::vector temperature, std::vector survival_rates, std::vector weather_coefficient, std::vector weather_coefficient_sd, List bbox, List res, List rows_cols, std::vector soil_reservoirs, double reproductive_rate, std::vector> spatial_indices, List season_month_start_end, List frequency_config, List bool_config, double mortality_rate, int mortality_time_lag, std::string start_date, std::string end_date, std::string treatment_method, std::string natural_kernel_type, std::string anthropogenic_kernel_type, double percent_natural_dispersal, double natural_distance_scale, double anthropogenic_distance_scale, std::string natural_dir, double natural_kappa, std::string anthropogenic_dir, double anthropogenic_kappa, Nullable frequencies_n_config, std::string model_type_, int latency_period, double establishment_probability, double dispersal_percentage, int survival_rate_month, int survival_rate_day, Nullable overpopulation_config, Nullable network_config, Nullable network_data_config, int weather_size, std::string weather_type, double dispersers_to_soils_percentage); -static SEXP _PoPS_pops_model_cpp_try(SEXP random_seedSEXP, SEXP multiple_random_seedsSEXP, SEXP random_seedsSEXP, SEXP lethal_temperatureSEXP, SEXP lethal_temperature_monthSEXP, SEXP infectedSEXP, SEXP total_exposedSEXP, SEXP exposedSEXP, SEXP susceptibleSEXP, SEXP total_populationsSEXP, SEXP total_hostsSEXP, SEXP mortality_trackerSEXP, SEXP mortalitySEXP, SEXP quarantine_areasSEXP, SEXP quarantine_directionsSEXP, SEXP treatment_mapsSEXP, SEXP treatment_datesSEXP, SEXP pesticide_durationSEXP, SEXP resistantSEXP, SEXP movementsSEXP, SEXP movements_datesSEXP, SEXP temperatureSEXP, SEXP survival_ratesSEXP, SEXP weather_coefficientSEXP, SEXP weather_coefficient_sdSEXP, SEXP bboxSEXP, SEXP resSEXP, SEXP rows_colsSEXP, SEXP soil_reservoirsSEXP, SEXP reproductive_rateSEXP, SEXP spatial_indicesSEXP, SEXP season_month_start_endSEXP, SEXP frequency_configSEXP, SEXP bool_configSEXP, SEXP mortality_rateSEXP, SEXP mortality_time_lagSEXP, SEXP start_dateSEXP, SEXP end_dateSEXP, SEXP treatment_methodSEXP, SEXP natural_kernel_typeSEXP, SEXP anthropogenic_kernel_typeSEXP, SEXP percent_natural_dispersalSEXP, SEXP natural_distance_scaleSEXP, SEXP anthropogenic_distance_scaleSEXP, SEXP natural_dirSEXP, SEXP natural_kappaSEXP, SEXP anthropogenic_dirSEXP, SEXP anthropogenic_kappaSEXP, SEXP frequencies_n_configSEXP, SEXP model_type_SEXP, SEXP latency_periodSEXP, SEXP establishment_probabilitySEXP, SEXP dispersal_percentageSEXP, SEXP survival_rate_monthSEXP, SEXP survival_rate_daySEXP, SEXP overpopulation_configSEXP, SEXP network_configSEXP, SEXP network_data_configSEXP, SEXP weather_sizeSEXP, SEXP weather_typeSEXP, SEXP dispersers_to_soils_percentageSEXP) { +List pops_model_cpp(int random_seed, bool multiple_random_seeds, std::vector random_seeds, double lethal_temperature, int lethal_temperature_month, std::vector host_pools, IntegerMatrix total_populations, std::vector> competency_table, std::vector> pest_host_table, IntegerMatrix quarantine_areas, std::string quarantine_directions, std::vector treatment_maps, std::vector treatment_dates, std::vector pesticide_duration, std::vector> movements, std::vector movements_dates, std::vector temperature, std::vector survival_rates, std::vector weather_coefficient, std::vector weather_coefficient_sd, List bbox, List res, List rows_cols, std::vector soil_reservoirs, double reproductive_rate, std::vector> spatial_indices, List season_month_start_end, List frequency_config, List bool_config, std::string start_date, std::string end_date, std::string treatment_method, std::string natural_kernel_type, std::string anthropogenic_kernel_type, double percent_natural_dispersal, double natural_distance_scale, double anthropogenic_distance_scale, std::string natural_dir, double natural_kappa, std::string anthropogenic_dir, double anthropogenic_kappa, Nullable frequencies_n_config, std::string model_type_, int latency_period, double establishment_probability, double dispersal_percentage, int survival_rate_month, int survival_rate_day, Nullable overpopulation_config, Nullable network_config, Nullable network_data_config, int weather_size, std::string weather_type, double dispersers_to_soils_percentage); +static SEXP _PoPS_pops_model_cpp_try(SEXP random_seedSEXP, SEXP multiple_random_seedsSEXP, SEXP random_seedsSEXP, SEXP lethal_temperatureSEXP, SEXP lethal_temperature_monthSEXP, SEXP host_poolsSEXP, SEXP total_populationsSEXP, SEXP competency_tableSEXP, SEXP pest_host_tableSEXP, SEXP quarantine_areasSEXP, SEXP quarantine_directionsSEXP, SEXP treatment_mapsSEXP, SEXP treatment_datesSEXP, SEXP pesticide_durationSEXP, SEXP movementsSEXP, SEXP movements_datesSEXP, SEXP temperatureSEXP, SEXP survival_ratesSEXP, SEXP weather_coefficientSEXP, SEXP weather_coefficient_sdSEXP, SEXP bboxSEXP, SEXP resSEXP, SEXP rows_colsSEXP, SEXP soil_reservoirsSEXP, SEXP reproductive_rateSEXP, SEXP spatial_indicesSEXP, SEXP season_month_start_endSEXP, SEXP frequency_configSEXP, SEXP bool_configSEXP, SEXP start_dateSEXP, SEXP end_dateSEXP, SEXP treatment_methodSEXP, SEXP natural_kernel_typeSEXP, SEXP anthropogenic_kernel_typeSEXP, SEXP percent_natural_dispersalSEXP, SEXP natural_distance_scaleSEXP, SEXP anthropogenic_distance_scaleSEXP, SEXP natural_dirSEXP, SEXP natural_kappaSEXP, SEXP anthropogenic_dirSEXP, SEXP anthropogenic_kappaSEXP, SEXP frequencies_n_configSEXP, SEXP model_type_SEXP, SEXP latency_periodSEXP, SEXP establishment_probabilitySEXP, SEXP dispersal_percentageSEXP, SEXP survival_rate_monthSEXP, SEXP survival_rate_daySEXP, SEXP overpopulation_configSEXP, SEXP network_configSEXP, SEXP network_data_configSEXP, SEXP weather_sizeSEXP, SEXP weather_typeSEXP, SEXP dispersers_to_soils_percentageSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< int >::type random_seed(random_seedSEXP); @@ -23,20 +23,15 @@ BEGIN_RCPP Rcpp::traits::input_parameter< std::vector >::type random_seeds(random_seedsSEXP); Rcpp::traits::input_parameter< double >::type lethal_temperature(lethal_temperatureSEXP); Rcpp::traits::input_parameter< int >::type lethal_temperature_month(lethal_temperature_monthSEXP); - Rcpp::traits::input_parameter< IntegerMatrix >::type infected(infectedSEXP); - Rcpp::traits::input_parameter< IntegerMatrix >::type total_exposed(total_exposedSEXP); - Rcpp::traits::input_parameter< std::vector >::type exposed(exposedSEXP); - Rcpp::traits::input_parameter< IntegerMatrix >::type susceptible(susceptibleSEXP); + Rcpp::traits::input_parameter< std::vector >::type host_pools(host_poolsSEXP); Rcpp::traits::input_parameter< IntegerMatrix >::type total_populations(total_populationsSEXP); - Rcpp::traits::input_parameter< IntegerMatrix >::type total_hosts(total_hostsSEXP); - Rcpp::traits::input_parameter< std::vector >::type mortality_tracker(mortality_trackerSEXP); - Rcpp::traits::input_parameter< IntegerMatrix >::type mortality(mortalitySEXP); + Rcpp::traits::input_parameter< std::vector> >::type competency_table(competency_tableSEXP); + Rcpp::traits::input_parameter< std::vector> >::type pest_host_table(pest_host_tableSEXP); Rcpp::traits::input_parameter< IntegerMatrix >::type quarantine_areas(quarantine_areasSEXP); Rcpp::traits::input_parameter< std::string >::type quarantine_directions(quarantine_directionsSEXP); Rcpp::traits::input_parameter< std::vector >::type treatment_maps(treatment_mapsSEXP); Rcpp::traits::input_parameter< std::vector >::type treatment_dates(treatment_datesSEXP); Rcpp::traits::input_parameter< std::vector >::type pesticide_duration(pesticide_durationSEXP); - Rcpp::traits::input_parameter< IntegerMatrix >::type resistant(resistantSEXP); Rcpp::traits::input_parameter< std::vector> >::type movements(movementsSEXP); Rcpp::traits::input_parameter< std::vector >::type movements_dates(movements_datesSEXP); Rcpp::traits::input_parameter< std::vector >::type temperature(temperatureSEXP); @@ -52,8 +47,6 @@ BEGIN_RCPP Rcpp::traits::input_parameter< List >::type season_month_start_end(season_month_start_endSEXP); Rcpp::traits::input_parameter< List >::type frequency_config(frequency_configSEXP); Rcpp::traits::input_parameter< List >::type bool_config(bool_configSEXP); - Rcpp::traits::input_parameter< double >::type mortality_rate(mortality_rateSEXP); - Rcpp::traits::input_parameter< int >::type mortality_time_lag(mortality_time_lagSEXP); Rcpp::traits::input_parameter< std::string >::type start_date(start_dateSEXP); Rcpp::traits::input_parameter< std::string >::type end_date(end_dateSEXP); Rcpp::traits::input_parameter< std::string >::type treatment_method(treatment_methodSEXP); @@ -79,15 +72,15 @@ BEGIN_RCPP Rcpp::traits::input_parameter< int >::type weather_size(weather_sizeSEXP); Rcpp::traits::input_parameter< std::string >::type weather_type(weather_typeSEXP); Rcpp::traits::input_parameter< double >::type dispersers_to_soils_percentage(dispersers_to_soils_percentageSEXP); - rcpp_result_gen = Rcpp::wrap(pops_model_cpp(random_seed, multiple_random_seeds, random_seeds, lethal_temperature, lethal_temperature_month, infected, total_exposed, exposed, susceptible, total_populations, total_hosts, mortality_tracker, mortality, quarantine_areas, quarantine_directions, treatment_maps, treatment_dates, pesticide_duration, resistant, movements, movements_dates, temperature, survival_rates, weather_coefficient, weather_coefficient_sd, bbox, res, rows_cols, soil_reservoirs, reproductive_rate, spatial_indices, season_month_start_end, frequency_config, bool_config, mortality_rate, mortality_time_lag, start_date, end_date, treatment_method, natural_kernel_type, anthropogenic_kernel_type, percent_natural_dispersal, natural_distance_scale, anthropogenic_distance_scale, natural_dir, natural_kappa, anthropogenic_dir, anthropogenic_kappa, frequencies_n_config, model_type_, latency_period, establishment_probability, dispersal_percentage, survival_rate_month, survival_rate_day, overpopulation_config, network_config, network_data_config, weather_size, weather_type, dispersers_to_soils_percentage)); + rcpp_result_gen = Rcpp::wrap(pops_model_cpp(random_seed, multiple_random_seeds, random_seeds, lethal_temperature, lethal_temperature_month, host_pools, total_populations, competency_table, pest_host_table, quarantine_areas, quarantine_directions, treatment_maps, treatment_dates, pesticide_duration, movements, movements_dates, temperature, survival_rates, weather_coefficient, weather_coefficient_sd, bbox, res, rows_cols, soil_reservoirs, reproductive_rate, spatial_indices, season_month_start_end, frequency_config, bool_config, start_date, end_date, treatment_method, natural_kernel_type, anthropogenic_kernel_type, percent_natural_dispersal, natural_distance_scale, anthropogenic_distance_scale, natural_dir, natural_kappa, anthropogenic_dir, anthropogenic_kappa, frequencies_n_config, model_type_, latency_period, establishment_probability, dispersal_percentage, survival_rate_month, survival_rate_day, overpopulation_config, network_config, network_data_config, weather_size, weather_type, dispersers_to_soils_percentage)); return rcpp_result_gen; END_RCPP_RETURN_ERROR } -RcppExport SEXP _PoPS_pops_model_cpp(SEXP random_seedSEXP, SEXP multiple_random_seedsSEXP, SEXP random_seedsSEXP, SEXP lethal_temperatureSEXP, SEXP lethal_temperature_monthSEXP, SEXP infectedSEXP, SEXP total_exposedSEXP, SEXP exposedSEXP, SEXP susceptibleSEXP, SEXP total_populationsSEXP, SEXP total_hostsSEXP, SEXP mortality_trackerSEXP, SEXP mortalitySEXP, SEXP quarantine_areasSEXP, SEXP quarantine_directionsSEXP, SEXP treatment_mapsSEXP, SEXP treatment_datesSEXP, SEXP pesticide_durationSEXP, SEXP resistantSEXP, SEXP movementsSEXP, SEXP movements_datesSEXP, SEXP temperatureSEXP, SEXP survival_ratesSEXP, SEXP weather_coefficientSEXP, SEXP weather_coefficient_sdSEXP, SEXP bboxSEXP, SEXP resSEXP, SEXP rows_colsSEXP, SEXP soil_reservoirsSEXP, SEXP reproductive_rateSEXP, SEXP spatial_indicesSEXP, SEXP season_month_start_endSEXP, SEXP frequency_configSEXP, SEXP bool_configSEXP, SEXP mortality_rateSEXP, SEXP mortality_time_lagSEXP, SEXP start_dateSEXP, SEXP end_dateSEXP, SEXP treatment_methodSEXP, SEXP natural_kernel_typeSEXP, SEXP anthropogenic_kernel_typeSEXP, SEXP percent_natural_dispersalSEXP, SEXP natural_distance_scaleSEXP, SEXP anthropogenic_distance_scaleSEXP, SEXP natural_dirSEXP, SEXP natural_kappaSEXP, SEXP anthropogenic_dirSEXP, SEXP anthropogenic_kappaSEXP, SEXP frequencies_n_configSEXP, SEXP model_type_SEXP, SEXP latency_periodSEXP, SEXP establishment_probabilitySEXP, SEXP dispersal_percentageSEXP, SEXP survival_rate_monthSEXP, SEXP survival_rate_daySEXP, SEXP overpopulation_configSEXP, SEXP network_configSEXP, SEXP network_data_configSEXP, SEXP weather_sizeSEXP, SEXP weather_typeSEXP, SEXP dispersers_to_soils_percentageSEXP) { +RcppExport SEXP _PoPS_pops_model_cpp(SEXP random_seedSEXP, SEXP multiple_random_seedsSEXP, SEXP random_seedsSEXP, SEXP lethal_temperatureSEXP, SEXP lethal_temperature_monthSEXP, SEXP host_poolsSEXP, SEXP total_populationsSEXP, SEXP competency_tableSEXP, SEXP pest_host_tableSEXP, SEXP quarantine_areasSEXP, SEXP quarantine_directionsSEXP, SEXP treatment_mapsSEXP, SEXP treatment_datesSEXP, SEXP pesticide_durationSEXP, SEXP movementsSEXP, SEXP movements_datesSEXP, SEXP temperatureSEXP, SEXP survival_ratesSEXP, SEXP weather_coefficientSEXP, SEXP weather_coefficient_sdSEXP, SEXP bboxSEXP, SEXP resSEXP, SEXP rows_colsSEXP, SEXP soil_reservoirsSEXP, SEXP reproductive_rateSEXP, SEXP spatial_indicesSEXP, SEXP season_month_start_endSEXP, SEXP frequency_configSEXP, SEXP bool_configSEXP, SEXP start_dateSEXP, SEXP end_dateSEXP, SEXP treatment_methodSEXP, SEXP natural_kernel_typeSEXP, SEXP anthropogenic_kernel_typeSEXP, SEXP percent_natural_dispersalSEXP, SEXP natural_distance_scaleSEXP, SEXP anthropogenic_distance_scaleSEXP, SEXP natural_dirSEXP, SEXP natural_kappaSEXP, SEXP anthropogenic_dirSEXP, SEXP anthropogenic_kappaSEXP, SEXP frequencies_n_configSEXP, SEXP model_type_SEXP, SEXP latency_periodSEXP, SEXP establishment_probabilitySEXP, SEXP dispersal_percentageSEXP, SEXP survival_rate_monthSEXP, SEXP survival_rate_daySEXP, SEXP overpopulation_configSEXP, SEXP network_configSEXP, SEXP network_data_configSEXP, SEXP weather_sizeSEXP, SEXP weather_typeSEXP, SEXP dispersers_to_soils_percentageSEXP) { SEXP rcpp_result_gen; { Rcpp::RNGScope rcpp_rngScope_gen; - rcpp_result_gen = PROTECT(_PoPS_pops_model_cpp_try(random_seedSEXP, multiple_random_seedsSEXP, random_seedsSEXP, lethal_temperatureSEXP, lethal_temperature_monthSEXP, infectedSEXP, total_exposedSEXP, exposedSEXP, susceptibleSEXP, total_populationsSEXP, total_hostsSEXP, mortality_trackerSEXP, mortalitySEXP, quarantine_areasSEXP, quarantine_directionsSEXP, treatment_mapsSEXP, treatment_datesSEXP, pesticide_durationSEXP, resistantSEXP, movementsSEXP, movements_datesSEXP, temperatureSEXP, survival_ratesSEXP, weather_coefficientSEXP, weather_coefficient_sdSEXP, bboxSEXP, resSEXP, rows_colsSEXP, soil_reservoirsSEXP, reproductive_rateSEXP, spatial_indicesSEXP, season_month_start_endSEXP, frequency_configSEXP, bool_configSEXP, mortality_rateSEXP, mortality_time_lagSEXP, start_dateSEXP, end_dateSEXP, treatment_methodSEXP, natural_kernel_typeSEXP, anthropogenic_kernel_typeSEXP, percent_natural_dispersalSEXP, natural_distance_scaleSEXP, anthropogenic_distance_scaleSEXP, natural_dirSEXP, natural_kappaSEXP, anthropogenic_dirSEXP, anthropogenic_kappaSEXP, frequencies_n_configSEXP, model_type_SEXP, latency_periodSEXP, establishment_probabilitySEXP, dispersal_percentageSEXP, survival_rate_monthSEXP, survival_rate_daySEXP, overpopulation_configSEXP, network_configSEXP, network_data_configSEXP, weather_sizeSEXP, weather_typeSEXP, dispersers_to_soils_percentageSEXP)); + rcpp_result_gen = PROTECT(_PoPS_pops_model_cpp_try(random_seedSEXP, multiple_random_seedsSEXP, random_seedsSEXP, lethal_temperatureSEXP, lethal_temperature_monthSEXP, host_poolsSEXP, total_populationsSEXP, competency_tableSEXP, pest_host_tableSEXP, quarantine_areasSEXP, quarantine_directionsSEXP, treatment_mapsSEXP, treatment_datesSEXP, pesticide_durationSEXP, movementsSEXP, movements_datesSEXP, temperatureSEXP, survival_ratesSEXP, weather_coefficientSEXP, weather_coefficient_sdSEXP, bboxSEXP, resSEXP, rows_colsSEXP, soil_reservoirsSEXP, reproductive_rateSEXP, spatial_indicesSEXP, season_month_start_endSEXP, frequency_configSEXP, bool_configSEXP, start_dateSEXP, end_dateSEXP, treatment_methodSEXP, natural_kernel_typeSEXP, anthropogenic_kernel_typeSEXP, percent_natural_dispersalSEXP, natural_distance_scaleSEXP, anthropogenic_distance_scaleSEXP, natural_dirSEXP, natural_kappaSEXP, anthropogenic_dirSEXP, anthropogenic_kappaSEXP, frequencies_n_configSEXP, model_type_SEXP, latency_periodSEXP, establishment_probabilitySEXP, dispersal_percentageSEXP, survival_rate_monthSEXP, survival_rate_daySEXP, overpopulation_configSEXP, network_configSEXP, network_data_configSEXP, weather_sizeSEXP, weather_typeSEXP, dispersers_to_soils_percentageSEXP)); } Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error"); if (rcpp_isInterrupt_gen) { @@ -112,7 +105,7 @@ RcppExport SEXP _PoPS_pops_model_cpp(SEXP random_seedSEXP, SEXP multiple_random_ static int _PoPS_RcppExport_validate(const char* sig) { static std::set signatures; if (signatures.empty()) { - signatures.insert("List(*pops_model_cpp)(int,bool,std::vector,double,int,IntegerMatrix,IntegerMatrix,std::vector,IntegerMatrix,IntegerMatrix,IntegerMatrix,std::vector,IntegerMatrix,IntegerMatrix,std::string,std::vector,std::vector,std::vector,IntegerMatrix,std::vector>,std::vector,std::vector,std::vector,std::vector,std::vector,List,List,List,std::vector,double,std::vector>,List,List,List,double,int,std::string,std::string,std::string,std::string,std::string,double,double,double,std::string,double,std::string,double,Nullable,std::string,int,double,double,int,int,Nullable,Nullable,Nullable,int,std::string,double)"); + signatures.insert("List(*pops_model_cpp)(int,bool,std::vector,double,int,std::vector,IntegerMatrix,std::vector>,std::vector>,IntegerMatrix,std::string,std::vector,std::vector,std::vector,std::vector>,std::vector,std::vector,std::vector,std::vector,std::vector,List,List,List,std::vector,double,std::vector>,List,List,List,std::string,std::string,std::string,std::string,std::string,double,double,double,std::string,double,std::string,double,Nullable,std::string,int,double,double,int,int,Nullable,Nullable,Nullable,int,std::string,double)"); } return signatures.find(sig) != signatures.end(); } @@ -125,7 +118,7 @@ RcppExport SEXP _PoPS_RcppExport_registerCCallable() { } static const R_CallMethodDef CallEntries[] = { - {"_PoPS_pops_model_cpp", (DL_FUNC) &_PoPS_pops_model_cpp, 61}, + {"_PoPS_pops_model_cpp", (DL_FUNC) &_PoPS_pops_model_cpp, 54}, {"_PoPS_RcppExport_registerCCallable", (DL_FUNC) &_PoPS_RcppExport_registerCCallable, 0}, {NULL, NULL, 0} }; diff --git a/src/pops.cpp b/src/pops.cpp index 6764dbec..7fd928a7 100644 --- a/src/pops.cpp +++ b/src/pops.cpp @@ -32,6 +32,16 @@ using std::to_string; using namespace Rcpp; using namespace pops; +struct OutputHostPool { + std::vector infected; + std::vector susceptible; + std::vector total_exposed; + std::vector resistant; + std::vector> exposed; + std::vector mortality; + std::vector> mortality_tracker; +}; + // Enable C++11 via this plugin (Rcpp 0.10.3 or later) // [[Rcpp::plugins(cpp11)]] @@ -44,20 +54,15 @@ List pops_model_cpp( std::vector random_seeds, double lethal_temperature, int lethal_temperature_month, - IntegerMatrix infected, - IntegerMatrix total_exposed, - std::vector exposed, - IntegerMatrix susceptible, + std::vector host_pools, IntegerMatrix total_populations, - IntegerMatrix total_hosts, - std::vector mortality_tracker, - IntegerMatrix mortality, + std::vector> competency_table, + std::vector> pest_host_table, IntegerMatrix quarantine_areas, std::string quarantine_directions, std::vector treatment_maps, std::vector treatment_dates, std::vector pesticide_duration, - IntegerMatrix resistant, std::vector> movements, std::vector movements_dates, std::vector temperature, @@ -73,8 +78,6 @@ List pops_model_cpp( List season_month_start_end, List frequency_config, List bool_config, - double mortality_rate = 0.0, - int mortality_time_lag = 2, std::string start_date = "2018-01-01", std::string end_date = "2018-12-31", std::string treatment_method = "ratio", @@ -147,8 +150,6 @@ List pops_model_cpp( std::string mortality_frequency = frequency_config["mortality_frequency"]; // use_treatment set later config.use_mortality = bool_config["mortality_on"]; - config.mortality_rate = mortality_rate; - config.mortality_time_lag = mortality_time_lag; if (output_frequency == "time_step") { output_frequency = time_step; } @@ -194,28 +195,19 @@ List pops_model_cpp( bool use_soils = bool_config["use_soils"]; config.dispersers_to_soils_percentage = dispersers_to_soils_percentage; - config.create_pest_host_table_from_parameters(1); - std::vector> spread_rates_vector; std::tuple spread_rates; IntegerMatrix dispersers(config.rows, config.cols); IntegerMatrix total_dispersers(config.rows, config.cols); IntegerMatrix established_dispersers(config.rows, config.cols); - int num_infected; std::vector number_infected; double area_infect; std::vector area_infected; - std::vector infected_vector; - std::vector susceptible_vector; - std::vector mortality_vector; - std::vector resistant_vector; + std::vector output_host_pool_vector(host_pools.size()); std::vector total_populations_vector; - std::vector total_exposed_vector; std::vector dispersers_vector; - std::vector exposed_v; - std::vector> exposed_vector; std::vector> soil_reservoirs_vector; std::vector soil_v; @@ -263,40 +255,50 @@ List pops_model_cpp( Rcpp::as(net_data_config["network_filename"])}; network->load(network_stream); } - std::vector> competency_table_data; - competency_table_data.push_back({1, 1}); - competency_table_data.push_back({0, 0}); - config.read_competency_table(competency_table_data); + config.read_competency_table(competency_table); PoPSModel model(config); - PestHostTable pest_host_table( - config, model.environment()); - CompetencyTable competency_table( - config, model.environment()); - PoPSModel::StandardSingleHostPool host_pool( - mt, - susceptible, - exposed, - config.latency_period_steps, - infected, - total_exposed, - resistant, - mortality_tracker, - mortality, - total_hosts, - model.environment(), - config.generate_stochasticity, - config.reproductive_rate, - config.establishment_stochasticity, - config.establishment_probability, - config.rows, - config.cols, - spatial_indices); - - PoPSModel::StandardMultiHostPool multi_host_pool({&host_pool}, config); - multi_host_pool.set_pest_host_table(pest_host_table); - multi_host_pool.set_competency_table(competency_table); + std::vector> host_pool_vector; + std::vector host_pool_vector_plain; + host_pool_vector.reserve(host_pools.size()); + host_pool_vector_plain.reserve(host_pools.size()); + for (unsigned i = 0; i < host_pools.size(); i++) { + IntegerMatrix infected = host_pools[i]["infected"]; + IntegerMatrix susceptible = host_pools[i]["susceptible"]; + std::vector exposed = host_pools[i]["exposed"]; + IntegerMatrix total_exposed = host_pools[i]["total_exposed"]; + IntegerMatrix resistant = host_pools[i]["resistant"]; + IntegerMatrix total_hosts = host_pools[i]["total_hosts"]; + IntegerMatrix mortality = host_pools[i]["mortality"]; + std::vector mortality_tracker = host_pools[i]["mortality_tracker"]; + host_pool_vector.emplace_back(new PoPSModel::StandardSingleHostPool( + mt, + susceptible, + exposed, + config.latency_period_steps, + infected, + total_exposed, + resistant, + mortality_tracker, + mortality, + total_hosts, + model.environment(), + config.generate_stochasticity, + config.reproductive_rate, + config.establishment_stochasticity, + config.establishment_probability, + config.rows, + config.cols, + spatial_indices)); + + host_pool_vector_plain.push_back(host_pool_vector[i].get()); + } + PoPSModel::StandardMultiHostPool multi_host_pool(host_pool_vector_plain, config); + PestHostTable pest_host(config, model.environment()); + multi_host_pool.set_pest_host_table(pest_host); + CompetencyTable competency(config, model.environment()); + multi_host_pool.set_competency_table(competency); PoPSModel::StandardPestPool pest_pool( dispersers, established_dispersers, @@ -383,27 +385,40 @@ List pops_model_cpp( } if (config.use_mortality && config.mortality_schedule()[current_index]) { - mortality_vector.push_back(Rcpp::clone(mortality)); + for (unsigned i = 0; i < host_pools.size(); i++) { + IntegerMatrix mortality = host_pools[i]["mortality"]; + output_host_pool_vector[i].mortality.push_back(Rcpp::clone(mortality)); + } } if (config.output_schedule()[current_index]) { - infected_vector.push_back(Rcpp::clone(infected)); - susceptible_vector.push_back(Rcpp::clone(susceptible)); - resistant_vector.push_back(Rcpp::clone(resistant)); - total_populations_vector.push_back(Rcpp::clone(total_populations)); - total_exposed_vector.push_back(Rcpp::clone(total_exposed)); - dispersers_vector.push_back(Rcpp::clone(total_dispersers)); - - if (config.model_type == "SEI") { - exposed_v.clear(); - - for (unsigned e = 0; e < exposed.size(); e++) { - exposed_v.push_back(Rcpp::clone(exposed[e])); + int num_infected = 0; + IntegerMatrix all_infected(config.rows, config.cols); + for (unsigned i = 0; i < host_pools.size(); i++) { + IntegerMatrix infected = host_pools[i]["infected"]; + IntegerMatrix susceptible = host_pools[i]["susceptible"]; + IntegerMatrix resistant = host_pools[i]["resistant"]; + IntegerMatrix total_exposed = host_pools[i]["total_exposed"]; + output_host_pool_vector[i].infected.push_back(Rcpp::clone(infected)); + output_host_pool_vector[i].susceptible.push_back(Rcpp::clone(susceptible)); + output_host_pool_vector[i].resistant.push_back(Rcpp::clone(resistant)); + output_host_pool_vector[i].total_exposed.push_back(Rcpp::clone(total_exposed)); + std::vector exposed_v; + std::vector tmp_exposed = host_pools[i]["exposed"]; + if (config.model_type == "SEI") { + for (unsigned e = 0; e < tmp_exposed.size(); e++) { + exposed_v.push_back(Rcpp::clone(tmp_exposed[e])); } + } + else { + exposed_v = tmp_exposed; + } + output_host_pool_vector[i].exposed.push_back(exposed_v); + num_infected += sum_of_infected(infected, spatial_indices); + all_infected += infected; } - else { - exposed_v = exposed; - } + total_populations_vector.push_back(Rcpp::clone(total_populations)); + dispersers_vector.push_back(Rcpp::clone(total_dispersers)); if (use_soils) { soil_v.clear(); @@ -415,13 +430,11 @@ List pops_model_cpp( soil_v = soil_reservoirs; } - exposed_vector.push_back(exposed_v); soil_reservoirs_vector.push_back(soil_v); - num_infected = sum_of_infected(infected, spatial_indices); number_infected.push_back(num_infected); area_infect = area_of_infected( - infected, config.ew_res, config.ns_res, spatial_indices); + all_infected, config.ew_res, config.ns_res, spatial_indices); area_infected.push_back(area_infect); total_dispersers(config.rows, config.cols); } @@ -447,18 +460,23 @@ List pops_model_cpp( escape_directions.push_back(quarantine_enum_to_string(escape_direction)); } } + std::vector output_host_pool_v; + for (unsigned i = 0; i < output_host_pool_vector.size(); i++) { + List host = List::create(Named("infected") = output_host_pool_vector[i].infected, + Named("susceptible") = output_host_pool_vector[i].susceptible, + Named("total_exposed") = output_host_pool_vector[i].total_exposed, + Named("mortality") = output_host_pool_vector[i].mortality, + Named("exposed") = output_host_pool_vector[i].exposed, + Named("resistant") = output_host_pool_vector[i].resistant); + output_host_pool_v.push_back(host); + } return List::create( - _["infected"] = infected_vector, - _["exposed"] = exposed_vector, - _["susceptible"] = susceptible_vector, - _["resistant"] = resistant_vector, - _["mortality"] = mortality_vector, + _["host_pools"] = output_host_pool_v, _["rates"] = spread_rates_vector, _["number_infected"] = number_infected, _["area_infected"] = area_infected, _["total_populations"] = total_populations_vector, - _["total_exposed"] = total_exposed_vector, _["propogules"] = dispersers_vector, _["quarantine_escape"] = quarantine_escapes, _["quarantine_escape_distance"] = escape_dists, From f039c15542a558dd509f17bede70b1d5ed936ef6 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 18 Dec 2023 16:33:56 -0500 Subject: [PATCH 10/68] fix typo --- R/configuration.R | 221 +++++++++++++++++++++++++--------------------- R/pops.r | 2 +- R/pops_multirun.R | 2 +- R/validate.R | 2 +- 4 files changed, 123 insertions(+), 104 deletions(-) diff --git a/R/configuration.R b/R/configuration.R index 81ddda0f..179b193c 100644 --- a/R/configuration.R +++ b/R/configuration.R @@ -75,6 +75,13 @@ configuration <- function(config) { return(config) } + # check that multi-host dimensions are ensured + multihost_check <- + multihost_checks(infected_file_list, host_file_list, competency_table, pest_host_table) + if (!multihost_check$checks_passed) { + config$failure <- multihost_check$failed_check + } + seasons <- seq(1, 12, 1) if (config$season_month_start %in% seasons && config$season_month_end %in% seasons) { @@ -131,19 +138,19 @@ configuration <- function(config) { return(config) } - # check that initial raster file exists + # check that total populations raster has the same crs, resolution, and extent if (config$function_name %in% aws_bucket_list) { - infected_check <- initial_raster_checks(config$infected_file, config$use_s3, config$bucket) + total_populations_check <- + initial_raster_checks(config$total_populations_file, config$use_s3, config$bucket) } else { - infected_check <- initial_raster_checks(config$infected_file) + total_populations_check <- initial_raster_checks(config$total_populations_file) } - if (infected_check$checks_passed) { - infected <- infected_check$raster - infected <- terra::classify(infected, matrix(c(NA, 0), ncol = 2, byrow = TRUE), right = NA) + if (total_populations_check$checks_passed) { + total_populations <- total_populations_check$raster } else { - config$failure <- infected_check$failed_check + config$failure <- total_populations_check$failed_check if (config$failure == file_exists_error) { - config$failure <- detailed_file_exists_error(config$infected_file) + config$failure <- detailed_file_exists_error(config$total_populations_file) } return(config) } @@ -156,40 +163,6 @@ configuration <- function(config) { terra::values(one_matrix) <- 0 one_matrix <- terra::as.matrix(one_matrix, wide = TRUE) - # check that host raster has the same crs, resolution, and extent - if (config$function_name %in% aws_bucket_list) { - host_check <- secondary_raster_checks(config$host_file, infected, config$use_s3, config$bucket) - } else { - host_check <- secondary_raster_checks(config$host_file, infected) - } - if (host_check$checks_passed) { - host <- host_check$raster - config$host <- host - } else { - config$failure <- host_check$failed_check - if (config$failure == file_exists_error) { - config$failure <- detailed_file_exists_error(config$host_file) - } - return(config) - } - - # check that total populations raster has the same crs, resolution, and extent - if (config$function_name %in% aws_bucket_list) { - total_populations_check <- - secondary_raster_checks(config$total_populations_file, infected, config$use_s3, config$bucket) - } else { - total_populations_check <- secondary_raster_checks(config$total_populations_file, infected) - } - if (total_populations_check$checks_passed) { - total_populations <- total_populations_check$raster - } else { - config$failure <- total_populations_check$failed_check - if (config$failure == file_exists_error) { - config$failure <- detailed_file_exists_error(config$total_populations_file) - } - return(config) - } - # check that soils raster has the same crs, resolutin, and extent. if (config$use_soils) { config$soil_survival_steps <- ceiling(1 / config$dispersers_to_soils_percentage) @@ -527,50 +500,123 @@ configuration <- function(config) { config$movements_dates <- config$start_date } - exposed <- list(zero_matrix) - config$total_exposed <- zero_matrix + # loop over infected and host files to create multi-host setup + host_pools <- c() + for (i in 1:length(infected_file_list)) { + # check that infection rasters have the same crs, resolution, and extent + if (config$function_name %in% aws_bucket_list) { + infected_check <- + secondary_raster_checks(config$infected_file_list[i], total_populations, config$use_s3, config$bucket) + } else { + infected_check <- secondary_raster_checks(config$infected_file_list[i], total_populations) + } + if (infected_check$checks_passed) { + infected <- infected_check$raster + infected <- terra::classify(infected, matrix(c(NA, 0), ncol = 2, byrow = TRUE), right = NA) + } else { + config$failure <- infected_check$failed_check + if (config$failure == file_exists_error) { + config$failure <- detailed_file_exists_error(config$infected_file) + } + return(config) + } - if (config$model_type == "SEI" && config$latency_period > 1) { - for (ex in 2:(config$latency_period + 1)) { - exposed[[ex]] <- zero_matrix + if (config$use_initial_condition_uncertainty) { + if (terra::nlyr(infected) == 2) { + infected_mean <- terra::as.matrix(infected[[1]], wide = TRUE) + infected_sd <- terra::as.matrix(infected[[2]], wide = TRUE) + } else { + config$failure <- initial_cond_uncert_error + return(config) + } + } else { + infected_mean <- terra::as.matrix(infected[[1]], wide = TRUE) + infected_sd <- zero_matrix } - } - if (config$model_type == "SEI" && config$start_exposed) { + config$infected_mean <- infected_mean + config$infected_sd <- infected_sd + # check that host raster has the same crs, resolution, and extent if (config$function_name %in% aws_bucket_list) { - exposed_check <- - secondary_raster_checks(config$exposed_file, infected, config$use_s3, config$bucket) + host_check <- secondary_raster_checks(config$host_file_list[i], infected, config$use_s3, config$bucket) } else { - exposed_check <- secondary_raster_checks(config$exposed_file, infected) + host_check <- secondary_raster_checks(config$host_file_list[i], infected) } - if (exposed_check$checks_passed) { - exposed2 <- exposed_check$raster - if (config$use_initial_condition_uncertainty) { - if (terra::nlyr(exposed2) == 2) { - exposed_mean <- terra::as.matrix(exposed2[[1]], wide = TRUE) - exposed_sd <- terra::as.matrix(exposed2[[2]], wide = TRUE) + if (host_check$checks_passed) { + host <- host_check$raster + config$host <- host + } else { + config$failure <- host_check$failed_check + if (config$failure == file_exists_error) { + config$failure <- detailed_file_exists_error(config$host_file) + } + return(config) + } + + if (config$use_host_uncertainty) { + if (terra::nlyr(host) == 2) { + host_mean <- terra::as.matrix(host[[1]], wide = TRUE) + host_sd <- terra::as.matrix(host[[2]], wide = TRUE) + } else { + config$failure <- host_uncert_error + return(config) + } + } else { + host_mean <- terra::as.matrix(host[[1]], wide = TRUE) + host_sd <- zero_matrix + } + config$host_mean <- host_mean + config$host_sd <- host_sd + + exposed <- list(zero_matrix) + config$total_exposed <- zero_matrix + + if (config$model_type == "SEI" && config$latency_period > 1) { + for (ex in 2:(config$latency_period + 1)) { + exposed[[ex]] <- zero_matrix + } + } + + if (config$model_type == "SEI" && config$start_exposed) { + if (config$function_name %in% aws_bucket_list) { + exposed_check <- + secondary_raster_checks(config$exposed_file, infected, config$use_s3, config$bucket) + } else { + exposed_check <- secondary_raster_checks(config$exposed_file, infected) + } + if (exposed_check$checks_passed) { + exposed2 <- exposed_check$raster + if (config$use_initial_condition_uncertainty) { + if (terra::nlyr(exposed2) == 2) { + exposed_mean <- terra::as.matrix(exposed2[[1]], wide = TRUE) + exposed_sd <- terra::as.matrix(exposed2[[2]], wide = TRUE) + } else { + config$failure <- initial_cond_uncert_error + return(config) + } } else { - config$failure <- initial_cond_uncert_error - return(config) + exposed_mean <- terra::as.matrix(exposed2[[1]], wide = TRUE) + exposed_sd <- zero_matrix } } else { - exposed_mean <- terra::as.matrix(exposed2[[1]], wide = TRUE) - exposed_sd <- zero_matrix + config$failure <- exposed_check$failed_check + if (config$failure == file_exists_error) { + config$failure <- detailed_file_exists_error(config$exposed_file) + } + return(config) } } else { - config$failure <- exposed_check$failed_check - if (config$failure == file_exists_error) { - config$failure <- detailed_file_exists_error(config$exposed_file) - } - return(config) + exposed_mean <- zero_matrix + exposed_sd <- zero_matrix } - } else { - exposed_mean <- zero_matrix - exposed_sd <- zero_matrix - } - config$exposed_mean <- exposed_mean - config$exposed_sd <- exposed_sd + config$exposed_mean <- exposed_mean + config$exposed_sd <- exposed_sd + + + host_pool <- list(infected, susceptible, exposed, total_exposed, resistant, mortality_tracker) + host_pools[i] <- host_pool + } # create spatial indices for computational speed up. suitable <- host[[1]] + infected[[1]] @@ -615,20 +661,7 @@ configuration <- function(config) { rows_cols$num_cols <- terra::ncol(infected) config$rows_cols <- rows_cols - if (config$use_host_uncertainty) { - if (terra::nlyr(host) == 2) { - host_mean <- terra::as.matrix(host[[1]], wide = TRUE) - host_sd <- terra::as.matrix(host[[2]], wide = TRUE) - } else { - config$failure <- host_uncert_error - return(config) - } - } else { - host_mean <- terra::as.matrix(host[[1]], wide = TRUE) - host_sd <- zero_matrix - } - config$host_mean <- host_mean - config$host_sd <- host_sd + if (!is.null(config$mask)) { if (config$function_name %in% aws_bucket_list) { @@ -660,21 +693,7 @@ configuration <- function(config) { config$mask_matrix <- terra::as.matrix(mask, wide = TRUE) } - if (config$use_initial_condition_uncertainty) { - if (terra::nlyr(infected) == 2) { - infected_mean <- terra::as.matrix(infected[[1]], wide = TRUE) - infected_sd <- terra::as.matrix(infected[[2]], wide = TRUE) - } else { - config$failure <- initial_cond_uncert_error - return(config) - } - } else { - infected_mean <- terra::as.matrix(infected[[1]], wide = TRUE) - infected_sd <- zero_matrix - } - config$infected_mean <- infected_mean - config$infected_sd <- infected_sd exposed[[config$latency_period + 1]] <- exposed_mean config$total_exposed <- exposed_mean diff --git a/R/pops.r b/R/pops.r index 05970966..2d933677 100644 --- a/R/pops.r +++ b/R/pops.r @@ -378,7 +378,7 @@ pops <- function(infected_file_list, } exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) while (any(exposed2 < 0)) { - exposed2 <- matrix_norm_distribution(config$infected_mean, config$infected_sd) + exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) } exposed <- config$exposed exposed[[config$latency_period + 1]] <- exposed2 diff --git a/R/pops_multirun.R b/R/pops_multirun.R index aa2cbf39..341bb92c 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -228,7 +228,7 @@ pops_multirun <- function(infected_file_list, } exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) while (any(exposed2 < 0)) { - exposed2 <- matrix_norm_distribution(config$infected_mean, config$infected_sd) + exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) } exposed <- config$exposed exposed[[config$latency_period + 1]] <- exposed2 diff --git a/R/validate.R b/R/validate.R index b2edaa7f..e7457bb4 100644 --- a/R/validate.R +++ b/R/validate.R @@ -247,7 +247,7 @@ validate <- function(infected_years_file, } exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) while (any(exposed2 < 0)) { - exposed2 <- matrix_norm_distribution(config$infected_mean, config$infected_sd) + exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) } exposed <- config$exposed exposed[[config$latency_period + 1]] <- exposed2 From c0a507e736b05bb489908e4294a8202e5b924f2c Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 18 Dec 2023 16:34:11 -0500 Subject: [PATCH 11/68] fix typo2 --- R/calibrate.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/calibrate.R b/R/calibrate.R index bb36e4b5..89e9efdc 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -330,7 +330,7 @@ calibrate <- function(infected_years_file, } exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) while (any(exposed2 < 0)) { - exposed2 <- matrix_norm_distribution(config$infected_mean, config$infected_sd) + exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) } exposed <- config$exposed exposed[[config$latency_period + 1]] <- exposed2 From 8cdb1e2188c41db15c83b1dd1906db53ba5c0b93 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 19 Dec 2023 10:56:02 -0500 Subject: [PATCH 12/68] add pest host table verification and setup for input into cpp --- R/checks.R | 14 ++++++++++---- R/error_messages.R | 6 +++++- R/lists.R | 1 + 3 files changed, 16 insertions(+), 5 deletions(-) diff --git a/R/checks.R b/R/checks.R index 194c1e21..fed4b4d9 100644 --- a/R/checks.R +++ b/R/checks.R @@ -312,7 +312,6 @@ bayesian_mnn_checks <- function(prior_means, } } - multihost_checks <- function(infected_file_list, host_file_list, competency_table, pest_host_table) { checks_passed <- TRUE if (length(infected_file_list) != length(host_file_list)) { @@ -330,9 +329,17 @@ multihost_checks <- function(infected_file_list, host_file_list, competency_tabl failed_check <- pest_host_table_row_length_error } + if (!checks_passed & identical(names(pest_host_table), pest_host_table_list)) { + checks_passed <- FALSE + failed_check <- pest_host_table_wrong_columns + } else { + host_names <- pest_host_table$host + pest_host_table <- pest_host_table[, 2:4] + pest_host_table_list <- split(pest_host_table, seq(nrow(pest_host_table))) + if (checks_passed) { - outs <- list(checks_passed) - names(outs) <- c("checks_passed") + outs <- list(checks_passed, host_names, pest_host_table_list) + names(outs) <- c("checks_passed", "host_names", "pest_host_table_list") return(outs) } else { outs <- list(checks_passed, failed_check) @@ -341,7 +348,6 @@ multihost_checks <- function(infected_file_list, host_file_list, competency_tabl } } - multispecies_checks <- function(species, infected_files, parameter_means, diff --git a/R/error_messages.R b/R/error_messages.R index 46b9062e..56c50628 100644 --- a/R/error_messages.R +++ b/R/error_messages.R @@ -181,4 +181,8 @@ competency_table_column_length_error <- "competency_table doesn't have the same number of columns as number of files in host_file_list" pest_host_table_row_length_error <- - "pest_host_table doesn't have the same number of rows as number of files in host_file_list" \ No newline at end of file + "pest_host_table doesn't have the same number of rows as number of files in host_file_list" + +pest_host_table_wrong_columns <- + "pest_host_table must the 4 columns named and order: host, susceptibility, mortality_rate, + mortality_time_lag" \ No newline at end of file diff --git a/R/lists.R b/R/lists.R index cc0a13c6..e06e86aa 100644 --- a/R/lists.R +++ b/R/lists.R @@ -121,3 +121,4 @@ failed_check_list <- c("checks_passed", "failed_check") output_frequency_list <- c("week", "month", "day", "year", "time_step", "every_n_steps", "final_step") csv_list <- c("csv", "txt") +pest_host_table_list <- c("host", "susceptibility", "mortality_rate", "mortality_time_lag") From 36714a170e62e9384ee82348c054f177ed4bc0a0 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 19 Dec 2023 12:13:12 -0500 Subject: [PATCH 13/68] add pest host table examples for tests --- inst/extdata/pest_host_table.csv | 4 ++++ inst/extdata/pest_host_table_singlehost.csv | 2 ++ 2 files changed, 6 insertions(+) create mode 100644 inst/extdata/pest_host_table.csv create mode 100644 inst/extdata/pest_host_table_singlehost.csv diff --git a/inst/extdata/pest_host_table.csv b/inst/extdata/pest_host_table.csv new file mode 100644 index 00000000..4d1da095 --- /dev/null +++ b/inst/extdata/pest_host_table.csv @@ -0,0 +1,4 @@ +host,susceptibility,mortality_rate,mortality_time_lag +oak,0.7,0.1,1 +tanoak,1,0.5,1 +bay laurel,0.5,0,0 \ No newline at end of file diff --git a/inst/extdata/pest_host_table_singlehost.csv b/inst/extdata/pest_host_table_singlehost.csv new file mode 100644 index 00000000..bbf4ef49 --- /dev/null +++ b/inst/extdata/pest_host_table_singlehost.csv @@ -0,0 +1,2 @@ +host,susceptibility,mortality_rate,mortality_time_lag +oak,0.7,0.1,1 \ No newline at end of file From da2c977769d055735f9610c863da7c8b797b6939 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 19 Dec 2023 12:13:33 -0500 Subject: [PATCH 14/68] add competency tables for tests. --- inst/extdata/competency_table_multihost.csv | 5 +++++ inst/extdata/competency_table_singlehost.csv | 3 +++ 2 files changed, 8 insertions(+) create mode 100644 inst/extdata/competency_table_multihost.csv create mode 100644 inst/extdata/competency_table_singlehost.csv diff --git a/inst/extdata/competency_table_multihost.csv b/inst/extdata/competency_table_multihost.csv new file mode 100644 index 00000000..5414f0ea --- /dev/null +++ b/inst/extdata/competency_table_multihost.csv @@ -0,0 +1,5 @@ +oak,tanoak,bay laurel,competency_mean,compentency_sd +0,0,0,0,0 +1,0,0,0,0 +0,1,0,1,0.1 +0,0,1,0.7,0.1 \ No newline at end of file diff --git a/inst/extdata/competency_table_singlehost.csv b/inst/extdata/competency_table_singlehost.csv new file mode 100644 index 00000000..63951f53 --- /dev/null +++ b/inst/extdata/competency_table_singlehost.csv @@ -0,0 +1,3 @@ +tanoak,competency_mean,compentency_sd +0,0,0 +1,1,0.1 \ No newline at end of file From 6a9e5678e97d2c29b4a5e63e0be01b0e58ff1a93 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 20 Dec 2023 10:10:17 -0500 Subject: [PATCH 15/68] add checks for competency table --- R/checks.R | 17 +++++++++++++---- R/error_messages.R | 4 ++++ R/helpers.R | 16 ++++++++++++++++ R/pops.r | 5 +++-- 4 files changed, 36 insertions(+), 6 deletions(-) diff --git a/R/checks.R b/R/checks.R index fed4b4d9..0077c0e7 100644 --- a/R/checks.R +++ b/R/checks.R @@ -312,18 +312,26 @@ bayesian_mnn_checks <- function(prior_means, } } -multihost_checks <- function(infected_file_list, host_file_list, competency_table, pest_host_table) { +multihost_checks <- + function(infected_file_list, host_file_list, competency_table, pest_host_table) { checks_passed <- TRUE if (length(infected_file_list) != length(host_file_list)) { checks_pass <- FALSE failed_check <- multihost_file_length_error } - if (!checks_passed & length(infected_file_list) != (ncol(competency_table) -1)) { + if (!checks_passed & length(infected_file_list) != (ncol(competency_table) - 2)) { checks_passed <- FALSE failed_check <- competency_table_column_length_error } + if (!checks_passed & (length(infected_file_list) + 1) <= nrow(competency_table)) { + checks_passed <- FALSE + failed_check <- competency_table_row_length_error + } else { + competency_table_list <- competency_table_list_creator(competency_table) + } + if (!checks_passed & length(infected_file_list) != nrow(pest_host_table)) { checks_passed <- FALSE failed_check <- pest_host_table_row_length_error @@ -336,10 +344,11 @@ multihost_checks <- function(infected_file_list, host_file_list, competency_tabl host_names <- pest_host_table$host pest_host_table <- pest_host_table[, 2:4] pest_host_table_list <- split(pest_host_table, seq(nrow(pest_host_table))) + } if (checks_passed) { - outs <- list(checks_passed, host_names, pest_host_table_list) - names(outs) <- c("checks_passed", "host_names", "pest_host_table_list") + outs <- list(checks_passed, host_names, pest_host_table_list, competency_table_list) + names(outs) <- c("checks_passed", "host_names", "pest_host_table_list", "competency_table_list") return(outs) } else { outs <- list(checks_passed, failed_check) diff --git a/R/error_messages.R b/R/error_messages.R index 56c50628..3c984d0b 100644 --- a/R/error_messages.R +++ b/R/error_messages.R @@ -180,6 +180,10 @@ multihost_file_length_error <- competency_table_column_length_error <- "competency_table doesn't have the same number of columns as number of files in host_file_list" +competency_table_row_length_error <- + "competency_table needs to have at least 1 more row than the number of hosts being modeled which + is represented by the number of file in the host_file_list" + pest_host_table_row_length_error <- "pest_host_table doesn't have the same number of rows as number of files in host_file_list" diff --git a/R/helpers.R b/R/helpers.R index b702de46..7feafced 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -270,3 +270,19 @@ combined_sd <- function(v1, v2, m1, m2, n1, n2) { (((n1 - 1) * v1 + (n2 - 1) * v2) / (n1 + n2 - 1)) + (((n1 * n2) * (m1 - m2)^2) / ((n1 + n2) * (n1 + n2 - 1))) } + +competency_table_list_creator <- function(competency_table) { + competency_table2 <- competency_table[, 1:(ncol(competency_table) - 1)] + competencies <- + rnorm(n = nrow(competency_table), mean = competency_table$competency_mean, sd = competency_table$compentency_sd) + names(competency_table2)[ncol(competency_table2)] <- "competency" + if (any(competencies > 1) || any(competencies < 0)) { + competencies <- + rnorm(n = nrow(competency_table), + mean = competency_table$competency_mean, sd = competency_table$compentency_sd) + } + competency_table2$competency <- competencies + competency_table2 <- competency_table2 + competency_table_list <- split(competency_table2, seq(nrow(competency_table2))) + return(competency_table_list) +} \ No newline at end of file diff --git a/R/pops.r b/R/pops.r index 2d933677..449b7f88 100644 --- a/R/pops.r +++ b/R/pops.r @@ -182,10 +182,11 @@ #' the pest all values in the raster are between 0 and 1. #' @param start_with_soil_populations Boolean to indicate whether to use a starting soil pest or #' pathogen population if TRUE then soil_starting_pest_file is required. -#' @param pest_host_table The file path to a csv that has these columns in this order +#' @param pest_host_table The file path to a csv that has these columns in this order: host, #' susceptibility, mortality rate, and mortality time lag as columns with each row being the #' species. Host species must be in the same order in the host_file_list, infected_file_list, -#' pest_host_table rows, and competency_table columns. +#' pest_host_table rows, and competency_table columns. The host column is only used for metadata +#' and labeling output files. #' @param competency_table A csv with the hosts as the first n columns (n being the number of hosts) #' and the last column being the competency value. Each row is a set of Boolean for host presence #' and the competency value (between 0 and 1) for that combination of hosts in a cell. From 4cd45f88a9bf59bf335775f6954f6e30a5db99cc Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 20 Dec 2023 10:10:45 -0500 Subject: [PATCH 16/68] update configuration to create competency table --- R/configuration.R | 72 +++++++++++++++++++++++++---------------------- 1 file changed, 39 insertions(+), 33 deletions(-) diff --git a/R/configuration.R b/R/configuration.R index 179b193c..be0eca58 100644 --- a/R/configuration.R +++ b/R/configuration.R @@ -75,10 +75,17 @@ configuration <- function(config) { return(config) } + config$pest_host_table <- read.csv(config$pest_host_table) + config$competency_table <- read.csv(config$competency_table) + # check that multi-host dimensions are ensured multihost_check <- multihost_checks(infected_file_list, host_file_list, competency_table, pest_host_table) - if (!multihost_check$checks_passed) { + if (multihost_check$checks_passed) { + config$host_names <- multihost_check$host_names + config$pest_host_table_list <- multihost_check$pest_host_table_list + config$competency_table_list <- multihost_check$competency_table_list + } else { config$failure <- multihost_check$failed_check } @@ -613,8 +620,38 @@ configuration <- function(config) { config$exposed_mean <- exposed_mean config$exposed_sd <- exposed_sd + exposed[[config$latency_period + 1]] <- exposed_mean + config$total_exposed <- exposed_mean + config$exposed <- exposed + + susceptible_mean <- host_mean - infected_mean - exposed_mean + susceptible_mean[susceptible_mean < 0] <- 0 + config$susceptible_mean <- terra::as.matrix(susceptible_mean, wide = TRUE) + + config$total_populations <- terra::as.matrix(total_populations, wide = TRUE) + config$mortality <- zero_matrix + config$resistant <- zero_matrix + + mortality_tracker <- list(zero_matrix) + if (config$mortality_on) { + mortality_length <- 1 / config$mortality_rate + config$mortality_time_lag + for (mt in 2:(mortality_length)) { + mortality_tracker[[mt]] <- mortality_tracker + } + } + # add currently infected cells to last element of the mortality tracker so + # that mortality occurs at the appropriate interval + if (config$mortality_on) { + mortality_tracker[[length(mortality_tracker)]] <- infected_mean + } + + + config$mortality_tracker <- mortality_tracker + - host_pool <- list(infected, susceptible, exposed, total_exposed, resistant, mortality_tracker) + host_pool <- + list(infected, susceptible, exposed, total_exposed, resistant, total_hosts, mortality, + mortality_tracker) host_pools[i] <- host_pool } @@ -693,20 +730,6 @@ configuration <- function(config) { config$mask_matrix <- terra::as.matrix(mask, wide = TRUE) } - - - exposed[[config$latency_period + 1]] <- exposed_mean - config$total_exposed <- exposed_mean - config$exposed <- exposed - - susceptible_mean <- host_mean - infected_mean - exposed_mean - susceptible_mean[susceptible_mean < 0] <- 0 - config$susceptible_mean <- terra::as.matrix(susceptible_mean, wide = TRUE) - - config$total_populations <- terra::as.matrix(total_populations, wide = TRUE) - config$mortality <- zero_matrix - config$resistant <- zero_matrix - # check that quarantine raster has the same crs, resolution, and extent if (config$use_quarantine) { if (config$function_name %in% aws_bucket_list) { @@ -731,23 +754,6 @@ configuration <- function(config) { config$quarantine_areas <- zero_matrix } - mortality_tracker <- zero_matrix - mortality_tracker2 <- list(mortality_tracker) - if (config$mortality_on) { - mortality_length <- 1 / config$mortality_rate + config$mortality_time_lag - for (mt in 2:(mortality_length)) { - mortality_tracker2[[mt]] <- mortality_tracker - } - } - # add currently infected cells to last element of the mortality tracker so - # that mortality occurs at the appropriate interval - if (config$mortality_on) { - mortality_tracker2[[length(mortality_tracker2)]] <- infected_mean - } - - - config$mortality_tracker <- mortality_tracker2 - if (config$function_name %in% parallel_function_list) { if (is.na(config$number_of_cores) || config$number_of_cores > parallel::detectCores()) { From 71420318b4ca2a0d4fbe037bb378214a3f9f47c2 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 20 Dec 2023 10:25:55 -0500 Subject: [PATCH 17/68] update pops_model.R to use multihost --- R/RcppExports.R | 2 +- R/pops_model.R | 39 +++++++++------------------------------ man/calibrate.Rd | 5 +++-- man/pops.Rd | 5 +++-- man/pops_model.Rd | 41 +++++++++++++++-------------------------- man/pops_multirun.Rd | 5 +++-- man/validate.Rd | 5 +++-- 7 files changed, 37 insertions(+), 65 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index 166dc0b0..98e9d486 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -7,5 +7,5 @@ pops_model_cpp <- function(random_seed, multiple_random_seeds, random_seeds, let # Register entry points for exported C++ functions methods::setLoadAction(function(ns) { - .Call(`_PoPS_RcppExport_registerCCallable`) + .Call('_PoPS_RcppExport_registerCCallable', PACKAGE = 'PoPS') }) diff --git a/R/pops_model.R b/R/pops_model.R index 4a97a391..de13f8f1 100644 --- a/R/pops_model.R +++ b/R/pops_model.R @@ -9,14 +9,11 @@ #' #' @inheritParams pops #' @param weather Boolean that is true if weather is used -#' @param infected matrix of infected hosts -#' @param susceptible matrix of susceptible hosts #' @param mortality_on Boolean to indicate if mortality is used -#' @param mortality_tracker matrix of 0's to track mortality per year -#' @param mortality matrix to track cumulative mortality -#' @param resistant matrix to track resistant population over time +#' @param host_pools list of host_pool lists with each host_pool list containing matrices of +#' infected, susceptible, exposed, total_hosts, total_exposed, resistant, mortality, and +#' mortality_tracker for that host. #' @param total_populations matrix of total populations -#' @param total_hosts matrix of all hosts #' @param treatment_maps list of matrices where treatment or management has #' occurred in a given year #' @param temperature vector of matrices of temperature values used to check @@ -34,10 +31,6 @@ #' @param use_movements this is a boolean to turn on use of the movement module. #' @param movements_dates this is a list of dates passed as strings in the #' format 'YYYY-MM-DD' -#' @param exposed vector of matrices of the exposed class for use with "SEI" -#' model type -#' @param total_exposed sum of all exposed cohorts in exposed class for use with -#' "SEI" model type #' @param model_type_ What type of model most represents your system. Options #' are "SEI" (Susceptible - Exposed - Infected/Infested) or "SI" #' (Susceptible - Infected/Infested). Default value is "SI". @@ -100,21 +93,16 @@ pops_model <- use_survival_rates, survival_rate_month, survival_rate_day, - infected, - total_exposed, - exposed, - susceptible, + host_pools, total_populations, - total_hosts, + competency_table, + pest_host_table, mortality_on, - mortality_tracker, - mortality, quarantine_areas, quarantine_directions, treatment_maps, treatment_dates, pesticide_duration, - resistant, use_movements, movements, movements_dates, @@ -130,8 +118,6 @@ pops_model <- spatial_indices, season_month_start_end, soil_reservoirs, - mortality_rate = 0.0, - mortality_time_lag = 2, start_date = "2018-01-01", end_date = "2018-12-31", treatment_method = "ratio", @@ -236,20 +222,15 @@ pops_model <- random_seeds, lethal_temperature = lethal_temperature, lethal_temperature_month = lethal_temperature_month, - infected = infected, - total_exposed = total_exposed, - exposed = exposed, - susceptible = susceptible, + host_pools = host_pools, total_populations = total_populations, - total_hosts = total_hosts, - mortality_tracker = mortality_tracker, - mortality = mortality, + competency_table = compotency_table_list, + pest_host_table = pest_host_table_list, quarantine_areas = quarantine_areas, quarantine_directions = quarantine_directions, treatment_maps = treatment_maps, treatment_dates = treatment_dates, pesticide_duration = pesticide_duration, - resistant = resistant, movements = movements, movements_dates = movements_dates, temperature = temperature, @@ -265,8 +246,6 @@ pops_model <- season_month_start_end = season_month_start_end, frequency_config = frequency_config, bool_config = bool_config, - mortality_rate = mortality_rate, - mortality_time_lag = mortality_time_lag, start_date = start_date, end_date = end_date, treatment_method = treatment_method, diff --git a/man/calibrate.Rd b/man/calibrate.Rd index adcea2e1..f5405180 100644 --- a/man/calibrate.Rd +++ b/man/calibrate.Rd @@ -152,10 +152,11 @@ until 1,000 model runs are less than the threshold value. We recommend running at least 1,000 but the greater this number the more accurate the model parameters selected will be.} -\item{pest_host_table}{The file path to a csv that has these columns in this order +\item{pest_host_table}{The file path to a csv that has these columns in this order: host, susceptibility, mortality rate, and mortality time lag as columns with each row being the species. Host species must be in the same order in the host_file_list, infected_file_list, -pest_host_table rows, and competency_table columns.} +pest_host_table rows, and competency_table columns. The host column is only used for metadata +and labeling output files.} \item{competency_table}{A csv with the hosts as the first n columns (n being the number of hosts) and the last column being the competency value. Each row is a set of Boolean for host presence diff --git a/man/pops.Rd b/man/pops.Rd index 0e2c6c87..a5d0ce11 100644 --- a/man/pops.Rd +++ b/man/pops.Rd @@ -108,10 +108,11 @@ estimation ordered from (reproductive_rate, natural_dispersal_distance, percent_natural_dispersal, anthropogenic_dispersal_distance, natural kappa, anthropogenic kappa, network_min_distance, and network_max_distance) Should be 8x8 matrix.} -\item{pest_host_table}{The file path to a csv that has these columns in this order +\item{pest_host_table}{The file path to a csv that has these columns in this order: host, susceptibility, mortality rate, and mortality time lag as columns with each row being the species. Host species must be in the same order in the host_file_list, infected_file_list, -pest_host_table rows, and competency_table columns.} +pest_host_table rows, and competency_table columns. The host column is only used for metadata +and labeling output files.} \item{competency_table}{A csv with the hosts as the first n columns (n being the number of hosts) and the last column being the competency value. Each row is a set of Boolean for host presence diff --git a/man/pops_model.Rd b/man/pops_model.Rd index 663be917..8f50759b 100644 --- a/man/pops_model.Rd +++ b/man/pops_model.Rd @@ -14,21 +14,16 @@ pops_model( use_survival_rates, survival_rate_month, survival_rate_day, - infected, - total_exposed, - exposed, - susceptible, + host_pools, total_populations, - total_hosts, + competency_table, + pest_host_table, mortality_on, - mortality_tracker, - mortality, quarantine_areas, quarantine_directions, treatment_maps, treatment_dates, pesticide_duration, - resistant, use_movements, movements, movements_dates, @@ -44,8 +39,6 @@ pops_model( spatial_indices, season_month_start_end, soil_reservoirs, - mortality_rate = 0, - mortality_time_lag = 2, start_date = "2018-01-01", end_date = "2018-12-31", treatment_method = "ratio", @@ -120,25 +113,23 @@ month before for this parameter as it is when the survival rates raster will be \item{survival_rate_day}{What day should the survival rates be applied} -\item{infected}{matrix of infected hosts} - -\item{total_exposed}{sum of all exposed cohorts in exposed class for use with -"SEI" model type} - -\item{exposed}{vector of matrices of the exposed class for use with "SEI" -model type} - -\item{susceptible}{matrix of susceptible hosts} +\item{host_pools}{list of host_pool lists with each host_pool list containing matrices of +infected, susceptible, exposed, total_hosts, total_exposed, resistant, mortality, and +mortality_tracker for that host.} \item{total_populations}{matrix of total populations} -\item{total_hosts}{matrix of all hosts} +\item{competency_table}{A csv with the hosts as the first n columns (n being the number of hosts) +and the last column being the competency value. Each row is a set of Boolean for host presence +and the competency value (between 0 and 1) for that combination of hosts in a cell.} -\item{mortality_on}{Boolean to indicate if mortality is used} +\item{pest_host_table}{The file path to a csv that has these columns in this order: host, +susceptibility, mortality rate, and mortality time lag as columns with each row being the +species. Host species must be in the same order in the host_file_list, infected_file_list, +pest_host_table rows, and competency_table columns. The host column is only used for metadata +and labeling output files.} -\item{mortality_tracker}{matrix of 0's to track mortality per year} - -\item{mortality}{matrix to track cumulative mortality} +\item{mortality_on}{Boolean to indicate if mortality is used} \item{quarantine_areas}{areas that are set as quarantined for computing escape from quarantine statistics.} @@ -156,8 +147,6 @@ occurred in a given year} host is susceptible again. If value is 0 treatment is a culling (i.e. host removal) not a pesticide treatment. (needs to be the same length as treatment_dates and treatment_file)} -\item{resistant}{matrix to track resistant population over time} - \item{use_movements}{this is a boolean to turn on use of the movement module.} \item{movements}{a matrix with columns lon_from, lat_from, lon_to, lat_to, diff --git a/man/pops_multirun.Rd b/man/pops_multirun.Rd index ffbc61dc..81b933db 100644 --- a/man/pops_multirun.Rd +++ b/man/pops_multirun.Rd @@ -112,10 +112,11 @@ estimation ordered from (reproductive_rate, natural_dispersal_distance, percent_natural_dispersal, anthropogenic_dispersal_distance, natural kappa, anthropogenic kappa, network_min_distance, and network_max_distance) Should be 8x8 matrix.} -\item{pest_host_table}{The file path to a csv that has these columns in this order +\item{pest_host_table}{The file path to a csv that has these columns in this order: host, susceptibility, mortality rate, and mortality time lag as columns with each row being the species. Host species must be in the same order in the host_file_list, infected_file_list, -pest_host_table rows, and competency_table columns.} +pest_host_table rows, and competency_table columns. The host column is only used for metadata +and labeling output files.} \item{competency_table}{A csv with the hosts as the first n columns (n being the number of hosts) and the last column being the competency value. Each row is a set of Boolean for host presence diff --git a/man/validate.Rd b/man/validate.Rd index bbb48894..2e679d6c 100644 --- a/man/validate.Rd +++ b/man/validate.Rd @@ -104,10 +104,11 @@ If not set uses the # of CPU cores - 1. must be an integer >= 1} \item{parameter_cov_matrix}{the parameter covariance matrix from the ABC calibration function (posterior covariance matrix)} -\item{pest_host_table}{The file path to a csv that has these columns in this order +\item{pest_host_table}{The file path to a csv that has these columns in this order: host, susceptibility, mortality rate, and mortality time lag as columns with each row being the species. Host species must be in the same order in the host_file_list, infected_file_list, -pest_host_table rows, and competency_table columns.} +pest_host_table rows, and competency_table columns. The host column is only used for metadata +and labeling output files.} \item{competency_table}{A csv with the hosts as the first n columns (n being the number of hosts) and the last column being the competency value. Each row is a set of Boolean for host presence From 717a02683ac87183d6e2f1aa618bba7d4225d337 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 20 Dec 2023 12:28:21 -0500 Subject: [PATCH 18/68] draw competency table for each model run in functions --- R/calibrate.R | 2 ++ R/pops.r | 13 +++++-------- R/pops_model.R | 4 ++-- R/pops_multirun.R | 1 + R/validate.R | 2 ++ 5 files changed, 12 insertions(+), 10 deletions(-) diff --git a/R/calibrate.R b/R/calibrate.R index 89e9efdc..5141f4e6 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -365,6 +365,8 @@ calibrate <- function(infected_years_file, config$mortality_tracker <- mortality_tracker2 } + config$competency_table_list <- competency_table_list_creator(competency_table) + data <- pops_model( random_seed = config$random_seed, multiple_random_seeds = config$multiple_random_seeds, diff --git a/R/pops.r b/R/pops.r index 449b7f88..ac970b66 100644 --- a/R/pops.r +++ b/R/pops.r @@ -414,6 +414,8 @@ pops <- function(infected_file_list, config$mortality_tracker <- mortality_tracker2 } + config$competency_table_list <- competency_table_list_creator(competency_table) + data <- pops_model(random_seed = config$random_seed[1], multiple_random_seeds = config$multiple_random_seeds, random_seeds = unname(as.matrix(config$random_seeds[1, ])[1, ]), @@ -423,21 +425,16 @@ pops <- function(infected_file_list, use_survival_rates = config$use_survival_rates, survival_rate_month = config$survival_rate_month, survival_rate_day = config$survival_rate_day, - infected = config$infected, - total_exposed = config$total_exposed, - exposed = config$exposed, - susceptible = config$susceptible, + host_pools = config$host_pools, total_populations = config$total_populations, - total_hosts = config$total_hosts, + competency_table = config$competency_table_list, + pest_host_table = config$pest_host_table_list, mortality_on = config$mortality_on, - mortality_tracker = config$mortality_tracker, - mortality = config$mortality, quarantine_areas = config$quarantine_areas, quarantine_directions = config$quarantine_directions, treatment_maps = config$treatment_maps, treatment_dates = config$treatment_dates, pesticide_duration = config$pesticide_duration, - resistant = config$resistant, use_movements = config$use_movements, movements = config$movements, movements_dates = config$movements_dates, diff --git a/R/pops_model.R b/R/pops_model.R index de13f8f1..96ce4294 100644 --- a/R/pops_model.R +++ b/R/pops_model.R @@ -224,8 +224,8 @@ pops_model <- lethal_temperature_month = lethal_temperature_month, host_pools = host_pools, total_populations = total_populations, - competency_table = compotency_table_list, - pest_host_table = pest_host_table_list, + competency_table = compotency_table, + pest_host_table = pest_host_table, quarantine_areas = quarantine_areas, quarantine_directions = quarantine_directions, treatment_maps = treatment_maps, diff --git a/R/pops_multirun.R b/R/pops_multirun.R index 341bb92c..2a004cea 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -262,6 +262,7 @@ pops_multirun <- function(infected_file_list, mortality_tracker2[[length(mortality_tracker2)]] <- config$infected config$mortality_tracker <- mortality_tracker2 } + config$competency_table_list <- competency_table_list_creator(competency_table) data <- PoPS::pops_model( random_seed = config$random_seed[1], diff --git a/R/validate.R b/R/validate.R index e7457bb4..90190df2 100644 --- a/R/validate.R +++ b/R/validate.R @@ -282,6 +282,8 @@ validate <- function(infected_years_file, config$mortality_tracker <- mortality_tracker2 } + config$competency_table_list <- competency_table_list_creator(competency_table) + data <- pops_model( random_seed = config$random_seed[i], multiple_random_seeds = config$multiple_random_seeds, From 56698c71d1b95e5434f8b55bbfd2a8898e5e55c9 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Sat, 23 Dec 2023 07:48:16 -0500 Subject: [PATCH 19/68] add checks for values in pest_host_table and competency_table --- R/checks.R | 14 ++++++++++++++ R/error_messages.R | 8 +++++++- 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/R/checks.R b/R/checks.R index 0077c0e7..160ef6a4 100644 --- a/R/checks.R +++ b/R/checks.R @@ -325,6 +325,13 @@ multihost_checks <- failed_check <- competency_table_column_length_error } + if (!checks_passed && all(competency_table$competency_mean <= 1) && + all(competency_table$competency_mean >= 0) && all(competency_table$competency_sd <= 1) && + all(competency_table$competency_sd >= 0)) { + checks_passed <- FALSE + failed_check <- competency_value_error + } + if (!checks_passed & (length(infected_file_list) + 1) <= nrow(competency_table)) { checks_passed <- FALSE failed_check <- competency_table_row_length_error @@ -337,6 +344,13 @@ multihost_checks <- failed_check <- pest_host_table_row_length_error } + if (!checks_passed & all(pest_host_table$susceptibility >= 0) & + all(pest_host_table$susceptibility <= 1) & all(pest_host_table$mortality_rate >= 0) & + all(pest_host_table$mortality_rate <= 1)) { + checks_passed <- FALSE + failed_check <- pest_host_table_value_error + } + if (!checks_passed & identical(names(pest_host_table), pest_host_table_list)) { checks_passed <- FALSE failed_check <- pest_host_table_wrong_columns diff --git a/R/error_messages.R b/R/error_messages.R index 3c984d0b..732c80dc 100644 --- a/R/error_messages.R +++ b/R/error_messages.R @@ -184,9 +184,15 @@ competency_table_row_length_error <- "competency_table needs to have at least 1 more row than the number of hosts being modeled which is represented by the number of file in the host_file_list" +competency_value_error <- + "competency_table competency_mean and competency_sd values must be between 0 and 1" + pest_host_table_row_length_error <- "pest_host_table doesn't have the same number of rows as number of files in host_file_list" pest_host_table_wrong_columns <- "pest_host_table must the 4 columns named and order: host, susceptibility, mortality_rate, - mortality_time_lag" \ No newline at end of file + mortality_time_lag" + +pest_host_table_value_error <- + "pest_host_table susceptiblity and mortality_rate must be between 0 and 1" \ No newline at end of file From 6bf155fab463c1a628f3ebd87d7a8c7a6441c6ad Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 25 Dec 2023 06:15:54 -0500 Subject: [PATCH 20/68] edit multihost checks --- R/configuration.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/configuration.R b/R/configuration.R index be0eca58..ac64654b 100644 --- a/R/configuration.R +++ b/R/configuration.R @@ -80,7 +80,8 @@ configuration <- function(config) { # check that multi-host dimensions are ensured multihost_check <- - multihost_checks(infected_file_list, host_file_list, competency_table, pest_host_table) + multihost_checks(config$infected_file_list, config$host_file_list, config$competency_table, + config$pest_host_table) if (multihost_check$checks_passed) { config$host_names <- multihost_check$host_names config$pest_host_table_list <- multihost_check$pest_host_table_list From 3ebc86745bd14db4a1599c78aa0b89bde287a6f7 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 10 Jan 2024 08:25:21 -0500 Subject: [PATCH 21/68] remove unused variables --- R/calibrate.R | 11 +++-------- R/pops_model.R | 2 +- R/pops_multirun.R | 10 +++------- R/validate.R | 11 +++-------- 4 files changed, 10 insertions(+), 24 deletions(-) diff --git a/R/calibrate.R b/R/calibrate.R index 5141f4e6..d61180f2 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -377,21 +377,16 @@ calibrate <- function(infected_years_file, use_survival_rates = config$use_survival_rates, survival_rate_month = config$survival_rate_month, survival_rate_day = config$survival_rate_day, - infected = config$infected, - total_exposed = config$total_exposed, - exposed = config$exposed, - susceptible = config$susceptible, + host_pools = config$host_pools, total_populations = config$total_populations, - total_hosts = config$total_hosts, + competency_table = config$competency_table_list, + pest_host_table = config$pest_host_table_list, mortality_on = config$mortality_on, - mortality_tracker = config$mortality_tracker, - mortality = config$mortality, quarantine_areas = config$quarantine_areas, quarantine_directions = config$quarantine_directions, treatment_maps = config$treatment_maps, treatment_dates = config$treatment_dates, pesticide_duration = config$pesticide_duration, - resistant = config$resistant, use_movements = config$use_movements, movements = config$movements, movements_dates = config$movements_dates, diff --git a/R/pops_model.R b/R/pops_model.R index 96ce4294..fd57e828 100644 --- a/R/pops_model.R +++ b/R/pops_model.R @@ -224,7 +224,7 @@ pops_model <- lethal_temperature_month = lethal_temperature_month, host_pools = host_pools, total_populations = total_populations, - competency_table = compotency_table, + competency_table = competency_table, pest_host_table = pest_host_table, quarantine_areas = quarantine_areas, quarantine_directions = quarantine_directions, diff --git a/R/pops_multirun.R b/R/pops_multirun.R index 2a004cea..975b43e1 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -274,21 +274,17 @@ pops_multirun <- function(infected_file_list, use_survival_rates = config$use_survival_rates, survival_rate_month = config$survival_rate_month, survival_rate_day = config$survival_rate_day, - infected = config$infected, - total_exposed = config$total_exposed, - exposed = config$exposed, - susceptible = config$susceptible, + host_pools = config$host_pools, total_populations = config$total_populations, - total_hosts = config$total_hosts, + competency_table = config$competency_table_list, + pest_host_table = config$pest_host_table_list, mortality_on = config$mortality_on, - mortality_tracker = config$mortality_tracker, mortality = config$mortality, quarantine_areas = config$quarantine_areas, quarantine_directions = config$quarantine_directions, treatment_maps = config$treatment_maps, treatment_dates = config$treatment_dates, pesticide_duration = config$pesticide_duration, - resistant = config$resistant, use_movements = config$use_movements, movements = config$movements, movements_dates = config$movements_dates, diff --git a/R/validate.R b/R/validate.R index 90190df2..11f3a8ba 100644 --- a/R/validate.R +++ b/R/validate.R @@ -294,21 +294,16 @@ validate <- function(infected_years_file, use_survival_rates = config$use_survival_rates, survival_rate_month = config$survival_rate_month, survival_rate_day = config$survival_rate_day, - infected = config$infected, - total_exposed = config$total_exposed, - exposed = config$exposed, - susceptible = config$susceptible, + host_pools = config$host_pools, total_populations = config$total_populations, - total_hosts = config$total_hosts, + competency_table = config$competency_table_list, + pest_host_table = config$pest_host_table_list, mortality_on = config$mortality_on, - mortality_tracker = config$mortality_tracker, - mortality = config$mortality, quarantine_areas = config$quarantine_areas, quarantine_directions = config$quarantine_directions, treatment_maps = config$treatment_maps, treatment_dates = config$treatment_dates, pesticide_duration = config$pesticide_duration, - resistant = config$resistant, use_movements = config$use_movements, movements = config$movements, movements_dates = config$movements_dates, From ea5ca513fb81a5bb3566ef70d9e313c3d3cc0081 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 10 Jan 2024 08:26:06 -0500 Subject: [PATCH 22/68] fix typos and lint errors --- R/checks.R | 16 ++++++++-------- R/error_messages.R | 2 +- R/helpers.R | 7 ++++--- 3 files changed, 13 insertions(+), 12 deletions(-) diff --git a/R/checks.R b/R/checks.R index 160ef6a4..a63c67f7 100644 --- a/R/checks.R +++ b/R/checks.R @@ -316,11 +316,11 @@ multihost_checks <- function(infected_file_list, host_file_list, competency_table, pest_host_table) { checks_passed <- TRUE if (length(infected_file_list) != length(host_file_list)) { - checks_pass <- FALSE + checks_passed <- FALSE failed_check <- multihost_file_length_error } - if (!checks_passed & length(infected_file_list) != (ncol(competency_table) - 2)) { + if (!checks_passed && length(infected_file_list) != (ncol(competency_table) - 2)) { checks_passed <- FALSE failed_check <- competency_table_column_length_error } @@ -332,32 +332,32 @@ multihost_checks <- failed_check <- competency_value_error } - if (!checks_passed & (length(infected_file_list) + 1) <= nrow(competency_table)) { + if (!checks_passed && (length(infected_file_list) + 1) <= nrow(competency_table)) { checks_passed <- FALSE failed_check <- competency_table_row_length_error } else { competency_table_list <- competency_table_list_creator(competency_table) } - if (!checks_passed & length(infected_file_list) != nrow(pest_host_table)) { + if (!checks_passed && length(infected_file_list) != nrow(pest_host_table)) { checks_passed <- FALSE failed_check <- pest_host_table_row_length_error } - if (!checks_passed & all(pest_host_table$susceptibility >= 0) & - all(pest_host_table$susceptibility <= 1) & all(pest_host_table$mortality_rate >= 0) & + if (!checks_passed && all(pest_host_table$susceptibility >= 0) && + all(pest_host_table$susceptibility <= 1) && all(pest_host_table$mortality_rate >= 0) && all(pest_host_table$mortality_rate <= 1)) { checks_passed <- FALSE failed_check <- pest_host_table_value_error } - if (!checks_passed & identical(names(pest_host_table), pest_host_table_list)) { + if (!checks_passed && identical(names(pest_host_table), pest_host_table_list)) { checks_passed <- FALSE failed_check <- pest_host_table_wrong_columns } else { host_names <- pest_host_table$host pest_host_table <- pest_host_table[, 2:4] - pest_host_table_list <- split(pest_host_table, seq(nrow(pest_host_table))) + pest_host_table_list <- split(pest_host_table, seq_len(nrow(pest_host_table))) } if (checks_passed) { diff --git a/R/error_messages.R b/R/error_messages.R index 732c80dc..dc1207d9 100644 --- a/R/error_messages.R +++ b/R/error_messages.R @@ -195,4 +195,4 @@ pest_host_table_wrong_columns <- mortality_time_lag" pest_host_table_value_error <- - "pest_host_table susceptiblity and mortality_rate must be between 0 and 1" \ No newline at end of file + "pest_host_table susceptiblity and mortality_rate must be between 0 and 1" diff --git a/R/helpers.R b/R/helpers.R index 7feafced..a18d34af 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -274,7 +274,8 @@ combined_sd <- function(v1, v2, m1, m2, n1, n2) { competency_table_list_creator <- function(competency_table) { competency_table2 <- competency_table[, 1:(ncol(competency_table) - 1)] competencies <- - rnorm(n = nrow(competency_table), mean = competency_table$competency_mean, sd = competency_table$compentency_sd) + rnorm(n = nrow(competency_table), mean = competency_table$competency_mean, + sd = competency_table$compentency_sd) names(competency_table2)[ncol(competency_table2)] <- "competency" if (any(competencies > 1) || any(competencies < 0)) { competencies <- @@ -283,6 +284,6 @@ competency_table_list_creator <- function(competency_table) { } competency_table2$competency <- competencies competency_table2 <- competency_table2 - competency_table_list <- split(competency_table2, seq(nrow(competency_table2))) + competency_table_list <- split(competency_table2, seq_len(nrow(competency_table2))) return(competency_table_list) -} \ No newline at end of file +} From 1b4efed0dfc20dbbadfd09b6f500f71df865c5cf Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 10 Jan 2024 12:59:28 -0500 Subject: [PATCH 23/68] update config and helpers to correctly create host pools --- R/configuration.R | 207 +++++++++++++++++++++++++--------------------- R/helpers.R | 46 +++++++++++ 2 files changed, 160 insertions(+), 93 deletions(-) diff --git a/R/configuration.R b/R/configuration.R index ac64654b..3368cb61 100644 --- a/R/configuration.R +++ b/R/configuration.R @@ -163,11 +163,11 @@ configuration <- function(config) { return(config) } - zero_rast <- infected[[1]] + zero_rast <- total_populations[[1]] terra::values(zero_rast) <- 0 zero_matrix <- terra::as.matrix(zero_rast, wide = TRUE) - one_matrix <- infected[[1]] + one_matrix <- total_populations[[1]] terra::values(one_matrix) <- 0 one_matrix <- terra::as.matrix(one_matrix, wide = TRUE) @@ -182,9 +182,9 @@ configuration <- function(config) { if (config$function_name %in% aws_bucket_list) { soils_check <- secondary_raster_checks( - config$soil_starting_pest_file, infected, config$use_s3, config$bucket) + config$soil_starting_pest_file, total_populations, config$use_s3, config$bucket) } else { - soils_check <- secondary_raster_checks(config$soil_starting_pest_file, infected) + soils_check <- secondary_raster_checks(config$soil_starting_pest_file, total_populations) } if (soils_check$checks_passed) { soil_pests <- soils_check$raster @@ -206,9 +206,10 @@ configuration <- function(config) { if (config$use_survival_rates == TRUE) { if (config$function_name %in% aws_bucket_list) { survival_rate_check <- - secondary_raster_checks(config$survival_rates_file, infected, config$use_s3, config$bucket) + secondary_raster_checks(config$survival_rates_file, total_populations, config$use_s3, + config$bucket) } else { - survival_rate_check <- secondary_raster_checks(config$survival_rates_file, infected) + survival_rate_check <- secondary_raster_checks(config$survival_rates_file, total_populations) } if (survival_rate_check$checks_passed) { survival_rates_stack <- survival_rate_check$raster @@ -235,9 +236,10 @@ configuration <- function(config) { if (config$use_lethal_temperature == TRUE) { if (config$function_name %in% aws_bucket_list) { temperature_check <- - secondary_raster_checks(config$temperature_file, infected, config$use_s3, config$bucket) + secondary_raster_checks(config$temperature_file, total_populations, config$use_s3, + config$bucket) } else { - temperature_check <- secondary_raster_checks(config$temperature_file, infected) + temperature_check <- secondary_raster_checks(config$temperature_file, total_populations) } if (temperature_check$checks_passed) { temperature_stack <- temperature_check$raster @@ -266,19 +268,19 @@ configuration <- function(config) { if (config$temp == TRUE) { if (config$function_name %in% aws_bucket_list) { temperature_coefficient_check <- - secondary_raster_checks(config$temperature_coefficient_file, infected, + secondary_raster_checks(config$temperature_coefficient_file, total_populations, config$use_s3, config$bucket) if (config$weather_type == "probabilistic") { temperature_coefficient_sd_check <- - secondary_raster_checks(config$temperature_coefficient_sd_file, infected, + secondary_raster_checks(config$temperature_coefficient_sd_file, total_populations, config$use_s3, config$bucket) } } else { temperature_coefficient_check <- - secondary_raster_checks(config$temperature_coefficient_file, infected) + secondary_raster_checks(config$temperature_coefficient_file, total_populations) if (config$weather_type == "probabilistic") { temperature_coefficient_sd_check <- - secondary_raster_checks(config$temperature_coefficient_sd_file, infected) + secondary_raster_checks(config$temperature_coefficient_sd_file, total_populations) } } @@ -313,20 +315,20 @@ configuration <- function(config) { if (config$precip == TRUE) { if (config$function_name %in% aws_bucket_list) { precipitation_coefficient_check <- - secondary_raster_checks(config$precipitation_coefficient_file, infected, + secondary_raster_checks(config$precipitation_coefficient_file, total_populations, config$use_s3, config$bucket) if (config$weather_type == "probabilistic") { precipitation_coefficient_sd_check <- - secondary_raster_checks(config$precipitation_coefficient_sd_file, infected, + secondary_raster_checks(config$precipitation_coefficient_sd_file, total_populations, config$use_s3, config$bucket) } } else { precipitation_coefficient_check <- - secondary_raster_checks(config$precipitation_coefficient_file, infected) + secondary_raster_checks(config$precipitation_coefficient_file, total_populations) if (config$weather_type == "probabilistic") { precipitation_coefficient_sd_check <- - secondary_raster_checks(config$precipitation_coefficient_sd_file, infected) + secondary_raster_checks(config$precipitation_coefficient_sd_file, total_populations) } } @@ -363,19 +365,19 @@ configuration <- function(config) { } else if (config$precip == TRUE) { if (config$function_name %in% aws_bucket_list) { precipitation_coefficient_check <- - secondary_raster_checks(config$precipitation_coefficient_file, infected, + secondary_raster_checks(config$precipitation_coefficient_file, total_populations, config$use_s3, config$bucket) if (config$weather_type == "probabilistic") { precipitation_coefficient_sd_check <- - secondary_raster_checks(config$precipitation_coefficient_sd_file, infected, + secondary_raster_checks(config$precipitation_coefficient_sd_file, total_populations, config$use_s3, config$bucket) } } else { precipitation_coefficient_check <- - secondary_raster_checks(config$precipitation_coefficient_file, infected) + secondary_raster_checks(config$precipitation_coefficient_file, total_populations) if (config$weather_type == "probabilistic") { precipitation_coefficient_sd_check <- - secondary_raster_checks(config$precipitation_coefficient_sd_file, infected) + secondary_raster_checks(config$precipitation_coefficient_sd_file, total_populations) } } @@ -457,9 +459,10 @@ configuration <- function(config) { if (config$management == TRUE) { if (config$function_name %in% aws_bucket_list) { treatments_check <- - secondary_raster_checks(config$treatments_file, infected, config$use_s3, config$bucket) + secondary_raster_checks(config$treatments_file, total_populations, config$use_s3, + config$bucket) } else { - treatments_check <- secondary_raster_checks(config$treatments_file, infected) + treatments_check <- secondary_raster_checks(config$treatments_file, total_populations) } if (treatments_check$checks_passed) { @@ -492,7 +495,7 @@ configuration <- function(config) { # setup up movements to be used in the model converts from lat/long to i/j if (config$use_movements) { movements_check <- - movement_checks(config$movements_file, infected, config$start_date, config$end_date) + movement_checks(config$movements_file, total_populations, config$start_date, config$end_date) if (movements_check$checks_passed) { config$movements <- movements_check$movements config$movements_dates <- movements_check$movements_dates @@ -510,11 +513,20 @@ configuration <- function(config) { # loop over infected and host files to create multi-host setup host_pools <- c() - for (i in 1:length(infected_file_list)) { + host_pool_infected_means <- c() + host_pool_infected_sds <- c() + host_pool_exposed_means <- c() + host_pool_exposed_sds <- c() + host_pool_host_means <- c() + host_pool_host_sds <- c() + suitable <- zero_rast + for (i in seq_along(config$infected_file_list)) { + host_pool <- c() # check that infection rasters have the same crs, resolution, and extent if (config$function_name %in% aws_bucket_list) { infected_check <- - secondary_raster_checks(config$infected_file_list[i], total_populations, config$use_s3, config$bucket) + secondary_raster_checks(config$infected_file_list[i], total_populations, config$use_s3, + config$bucket) } else { infected_check <- secondary_raster_checks(config$infected_file_list[i], total_populations) } @@ -541,44 +553,12 @@ configuration <- function(config) { infected_mean <- terra::as.matrix(infected[[1]], wide = TRUE) infected_sd <- zero_matrix } - - config$infected_mean <- infected_mean - config$infected_sd <- infected_sd - # check that host raster has the same crs, resolution, and extent - if (config$function_name %in% aws_bucket_list) { - host_check <- secondary_raster_checks(config$host_file_list[i], infected, config$use_s3, config$bucket) - } else { - host_check <- secondary_raster_checks(config$host_file_list[i], infected) - } - if (host_check$checks_passed) { - host <- host_check$raster - config$host <- host - } else { - config$failure <- host_check$failed_check - if (config$failure == file_exists_error) { - config$failure <- detailed_file_exists_error(config$host_file) - } - return(config) - } - - if (config$use_host_uncertainty) { - if (terra::nlyr(host) == 2) { - host_mean <- terra::as.matrix(host[[1]], wide = TRUE) - host_sd <- terra::as.matrix(host[[2]], wide = TRUE) - } else { - config$failure <- host_uncert_error - return(config) - } - } else { - host_mean <- terra::as.matrix(host[[1]], wide = TRUE) - host_sd <- zero_matrix - } - config$host_mean <- host_mean - config$host_sd <- host_sd - + host_pool$name <- config$host_names[i] + host_pool$infected <- infected_mean + host_pool_infected_means[i] <- infected_mean + host_pool_infected_sds[i] <- infected_sd + # prepare exposed exposed <- list(zero_matrix) - config$total_exposed <- zero_matrix - if (config$model_type == "SEI" && config$latency_period > 1) { for (ex in 2:(config$latency_period + 1)) { exposed[[ex]] <- zero_matrix @@ -588,9 +568,10 @@ configuration <- function(config) { if (config$model_type == "SEI" && config$start_exposed) { if (config$function_name %in% aws_bucket_list) { exposed_check <- - secondary_raster_checks(config$exposed_file, infected, config$use_s3, config$bucket) + secondary_raster_checks(config$exposed_file, total_populations, config$use_s3, + config$bucket) } else { - exposed_check <- secondary_raster_checks(config$exposed_file, infected) + exposed_check <- secondary_raster_checks(config$exposed_file, total_populations) } if (exposed_check$checks_passed) { exposed2 <- exposed_check$raster @@ -606,6 +587,7 @@ configuration <- function(config) { exposed_mean <- terra::as.matrix(exposed2[[1]], wide = TRUE) exposed_sd <- zero_matrix } + total_exposed <- exposed_mean } else { config$failure <- exposed_check$failed_check if (config$failure == file_exists_error) { @@ -614,24 +596,58 @@ configuration <- function(config) { return(config) } } else { + total_exposed <- zero_matrix exposed_mean <- zero_matrix exposed_sd <- zero_matrix } - config$exposed_mean <- exposed_mean - config$exposed_sd <- exposed_sd + host_pool_exposed_means[i] <- exposed_mean + host_pool_exposed_sds[i] <- exposed_sd exposed[[config$latency_period + 1]] <- exposed_mean - config$total_exposed <- exposed_mean - config$exposed <- exposed + host_pool$total_exposed <- total_exposed + host_pool$exposed <- exposed + + # check that host raster has the same crs, resolution, and extent + if (config$function_name %in% aws_bucket_list) { + host_check <- secondary_raster_checks(config$host_file_list[i], total_populations, + config$use_s3, config$bucket) + } else { + host_check <- secondary_raster_checks(config$host_file_list[i], total_populations) + } + if (host_check$checks_passed) { + host <- host_check$raster + config$host <- host + } else { + config$failure <- host_check$failed_check + if (config$failure == file_exists_error) { + config$failure <- detailed_file_exists_error(config$host_file) + } + return(config) + } - susceptible_mean <- host_mean - infected_mean - exposed_mean - susceptible_mean[susceptible_mean < 0] <- 0 - config$susceptible_mean <- terra::as.matrix(susceptible_mean, wide = TRUE) + if (config$use_host_uncertainty) { + if (terra::nlyr(host) == 2) { + host_mean <- terra::as.matrix(host[[1]], wide = TRUE) + host_sd <- terra::as.matrix(host[[2]], wide = TRUE) + } else { + config$failure <- host_uncert_error + return(config) + } + } else { + host_mean <- terra::as.matrix(host[[1]], wide = TRUE) + host_sd <- zero_matrix + } + host_pool_host_means[i] <- host_mean + host_pool_host_sds[i] <- host_sd + host_pool$total_host <- host_mean + + susceptible <- host_mean - infected_mean - exposed_mean + susceptible[susceptible < 0] <- 0 + host_pool$susceptible <- terra::as.matrix(susceptible, wide = TRUE) - config$total_populations <- terra::as.matrix(total_populations, wide = TRUE) - config$mortality <- zero_matrix - config$resistant <- zero_matrix + host_pool$mortality <- zero_matrix + host_pool$resistant <- zero_matrix mortality_tracker <- list(zero_matrix) if (config$mortality_on) { @@ -646,30 +662,35 @@ configuration <- function(config) { mortality_tracker[[length(mortality_tracker)]] <- infected_mean } + host_pool$mortality_tracker <- mortality_tracker - config$mortality_tracker <- mortality_tracker - + # create suitable cells from all host pools + suitable <- suitable + host[[1]] + infected[[1]] + if (config$use_host_uncertainty && terra::nlyr(host) > 1) { + suitable <- suitable + host[[2]] + } + if (config$use_initial_condition_uncertainty && terra::nlyr(infected) > 1) { + suitable <- suitable + infected[[2]] + } + if (config$model_type == "SEI" && config$start_exposed) { + suitable <- suitable + exposed2[[1]] + if (config$use_initial_condition_uncertainty && terra::nlyr(exposed2) > 1) { + suitable <- suitable + exposed2[[2]] + } + } - host_pool <- - list(infected, susceptible, exposed, total_exposed, resistant, total_hosts, mortality, - mortality_tracker) host_pools[i] <- host_pool } + config$host_pools <- host_pools + config$host_pool_infected_means <- host_pool_infected_means + config$host_pool_infected_sds <- host_pool_infected_sds + config$host_pool_exposed_means <- host_pool_exposed_means + config$host_pool_exposed_sds <- host_pool_exposed_sds + config$host_pool_host_means <- host_pool_host_means + config$host_pool_host_sds <- host_pool_host_sds + # create spatial indices for computational speed up. - suitable <- host[[1]] + infected[[1]] - if (config$use_host_uncertainty && terra::nlyr(host) > 1) { - suitable <- suitable + host[[2]] - } - if (config$use_initial_condition_uncertainty && terra::nlyr(infected) > 1) { - suitable <- suitable + infected[[2]] - } - if (config$model_type == "SEI" && config$start_exposed) { - suitable <- suitable + exposed2[[1]] - if (config$use_initial_condition_uncertainty && terra::nlyr(exposed2) > 1) { - suitable <- suitable + exposed2[[2]] - } - } suitable_points <- terra::as.points(suitable) names(suitable_points) <- "data" suitable_points <- suitable_points[suitable_points$data > 0] @@ -699,7 +720,7 @@ configuration <- function(config) { rows_cols$num_cols <- terra::ncol(infected) config$rows_cols <- rows_cols - + config$total_populations <- terra::as.matrix(total_populations, wide = TRUE) if (!is.null(config$mask)) { if (config$function_name %in% aws_bucket_list) { diff --git a/R/helpers.R b/R/helpers.R index a18d34af..72f23193 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -287,3 +287,49 @@ competency_table_list_creator <- function(competency_table) { competency_table_list <- split(competency_table2, seq_len(nrow(competency_table2))) return(competency_table_list) } + +# Update host pools when uncertainties are used +host_pool_setup <- function(config) { + for (i in seq_along(config$host_file_list)) { + host_pool <- config$host_pools[i] + if (config$use_initial_condition_uncertainty) { + infected <- + matrix_norm_distribution(config$host_pool_infected_means[i], + config$host_pool_infected_sds[i]) + while (any(infected < 0)) { + infected <- + matrix_norm_distribution(config$host_pool_infected_means[i], + config$host_pool_infected_sds[i]) + } + exposed2 <- matrix_norm_distribution(config$host_pool_exposed_means[i], + config$host_pool_exposed_sds[i]) + while (any(exposed2 < 0)) { + exposed2 <- matrix_norm_distribution(config$host_pool_exposed_means[i], + config$host_pool_exposed_sds[i]) + } + exposed <- config$host_pools[i]$exposed + exposed[[config$latency_period + 1]] <- exposed2 + host_pool$infected <- infected + host_pool$exposed <- exposed + host_pool$total_exposed <- exposed2 + } + + if (config$use_host_uncertainty) { + host <- matrix_norm_distribution(config$host_pool_host_means[i], + config$host_pool_host_sds[i]) + while (any(host > config$total_populations)) { + host <- matrix_norm_distribution(config$host_pool_host_means[i], + config$host_pool_host_sds[i]) + } + host_pool$total_host <- host + } + + susceptible <- host_pool$total_host - host_pool$infected - host_pool$total_exposed + susceptible[susceptible < 0] <- 0 + + if (config$mortality_on) { + mortality_tracker <- config$host_pool[i]$mortality_tracker + mortality_tracker[[length(mortality_tracker)]] <- host_pool$infected + host_pool$mortality_tracker <- mortality_tracker + } + } \ No newline at end of file From 9d10d0d4cdbf28f1ad6f49794c4ae3469258caad Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 10 Jan 2024 13:01:49 -0500 Subject: [PATCH 24/68] fix helpers function --- R/helpers.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/helpers.R b/R/helpers.R index 72f23193..867e5dff 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -332,4 +332,6 @@ host_pool_setup <- function(config) { mortality_tracker[[length(mortality_tracker)]] <- host_pool$infected host_pool$mortality_tracker <- mortality_tracker } - } \ No newline at end of file + config$host_pools[i] <- host_pool + } +} \ No newline at end of file From d413f39fb0d90bd5afa31643da25b4ed7dd0d57e Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 10 Jan 2024 14:49:11 -0500 Subject: [PATCH 25/68] make expose_file exposed_file_list --- R/calibrate.R | 4 ++-- R/helpers.R | 2 +- R/pops.r | 10 +++++++--- R/pops_multirun.R | 4 ++-- R/validate.R | 4 ++-- man/calibrate.Rd | 8 ++++++-- man/pops.Rd | 8 ++++++-- man/pops_multirun.Rd | 8 ++++++-- man/validate.Rd | 8 ++++++-- 9 files changed, 38 insertions(+), 18 deletions(-) diff --git a/R/calibrate.R b/R/calibrate.R index d61180f2..e6f0b479 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -182,7 +182,7 @@ calibrate <- function(infected_years_file, leaving_scale_coefficient = 1, calibration_method = "ABC", number_of_iterations = 100000, - exposed_file = "", + exposed_file_list = "", verbose = TRUE, write_outputs = "None", output_folder_path = "", @@ -268,7 +268,7 @@ calibrate <- function(infected_years_file, config$leaving_scale_coefficient <- leaving_scale_coefficient config$calibration_method <- calibration_method config$number_of_iterations <- number_of_iterations - config$exposed_file <- exposed_file + config$exposed_file_list <- exposed_file_list # add function name for use in configuration function to skip # function specific specific configurations namely for validation and # calibration. diff --git a/R/helpers.R b/R/helpers.R index 867e5dff..248a3383 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -334,4 +334,4 @@ host_pool_setup <- function(config) { } config$host_pools[i] <- host_pool } -} \ No newline at end of file +} diff --git a/R/pops.r b/R/pops.r index ac970b66..3b2661db 100644 --- a/R/pops.r +++ b/R/pops.r @@ -130,7 +130,11 @@ #' @param leaving_percentage Percentage of pests leaving an overpopulated cell #' @param leaving_scale_coefficient Coefficient to multiply scale parameter of the natural kernel #' (if applicable) -#' @param exposed_file A file with the exposed for the current +#' @param exposed_file_list paths to raster files with initial exposeds and standard deviation +#' for each host can be based in 2 formats (a single file with number of hosts or a single file with +#' 2 layers number of hosts and standard deviation).. Units for infections are based on data +#' availability and the way the units used for your host file is created (e.g. percent area, # of +#' hosts per cell, etc.). #' @param mask Raster file used to provide a mask to remove 0's that are not true negatives from #' comparisons (e.g. mask out lakes and oceans from statics if modeling terrestrial species). This #' can also be used to mask out areas that can't be managed in the auto_manage function. @@ -261,7 +265,7 @@ pops <- function(infected_file_list, overpopulation_percentage = 0, leaving_percentage = 0, leaving_scale_coefficient = 1, - exposed_file = "", + exposed_file_list = "", mask = NULL, network_filename = "", network_movement = "walk", @@ -342,7 +346,7 @@ pops <- function(infected_file_list, # calibration. config$function_name <- "pops" config$failure <- NULL - config$exposed_file <- exposed_file + config$exposed_file_list <- exposed_file_list config$write_outputs <- "None" config$output_folder_path <- "" config$mortality_frequency <- mortality_frequency diff --git a/R/pops_multirun.R b/R/pops_multirun.R index 975b43e1..ca1a3f67 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -92,7 +92,7 @@ pops_multirun <- function(infected_file_list, overpopulation_percentage = 0, leaving_percentage = 0, leaving_scale_coefficient = 1, - exposed_file = "", + exposed_file_list = "", mask = NULL, write_outputs = "None", output_folder_path = "", @@ -172,7 +172,7 @@ pops_multirun <- function(infected_file_list, # calibration. config$function_name <- "multirun" config$failure <- NULL - config$exposed_file <- exposed_file + config$exposed_file_list <- exposed_file_list config$mask <- mask config$write_outputs <- write_outputs config$output_folder_path <- output_folder_path diff --git a/R/validate.R b/R/validate.R index 11f3a8ba..08d3523c 100644 --- a/R/validate.R +++ b/R/validate.R @@ -106,7 +106,7 @@ validate <- function(infected_years_file, overpopulation_percentage = 0, leaving_percentage = 0, leaving_scale_coefficient = 1, - exposed_file = "", + exposed_file_list = "", write_outputs = "None", output_folder_path = "", point_file = "", @@ -189,7 +189,7 @@ validate <- function(infected_years_file, # calibration. config$function_name <- "validate" config$failure <- NULL - config$exposed_file <- exposed_file + config$exposed_file_list <- exposed_file_list config$write_outputs <- write_outputs config$output_folder_path <- output_folder_path config$mortality_frequency <- mortality_frequency diff --git a/man/calibrate.Rd b/man/calibrate.Rd index f5405180..75cbbfe7 100644 --- a/man/calibrate.Rd +++ b/man/calibrate.Rd @@ -72,7 +72,7 @@ calibrate( leaving_scale_coefficient = 1, calibration_method = "ABC", number_of_iterations = 1e+05, - exposed_file = "", + exposed_file_list = "", verbose = TRUE, write_outputs = "None", output_folder_path = "", @@ -353,7 +353,11 @@ Approximation)} the calibration to converge (recommend a minimum of at least 100,000 but preferably 1 million).} -\item{exposed_file}{A file with the exposed for the current} +\item{exposed_file_list}{paths to raster files with initial exposeds and standard deviation +for each host can be based in 2 formats (a single file with number of hosts or a single file with +2 layers number of hosts and standard deviation).. Units for infections are based on data +availability and the way the units used for your host file is created (e.g. percent area, # of +hosts per cell, etc.).} \item{verbose}{Boolean with true printing current status of calibration, (e.g. the current generation, current particle, and the acceptance rate). diff --git a/man/pops.Rd b/man/pops.Rd index a5d0ce11..8c8c6b05 100644 --- a/man/pops.Rd +++ b/man/pops.Rd @@ -62,7 +62,7 @@ pops( overpopulation_percentage = 0, leaving_percentage = 0, leaving_scale_coefficient = 1, - exposed_file = "", + exposed_file_list = "", mask = NULL, network_filename = "", network_movement = "walk", @@ -273,7 +273,11 @@ overpopulated} \item{leaving_scale_coefficient}{Coefficient to multiply scale parameter of the natural kernel (if applicable)} -\item{exposed_file}{A file with the exposed for the current} +\item{exposed_file_list}{paths to raster files with initial exposeds and standard deviation +for each host can be based in 2 formats (a single file with number of hosts or a single file with +2 layers number of hosts and standard deviation).. Units for infections are based on data +availability and the way the units used for your host file is created (e.g. percent area, # of +hosts per cell, etc.).} \item{mask}{Raster file used to provide a mask to remove 0's that are not true negatives from comparisons (e.g. mask out lakes and oceans from statics if modeling terrestrial species). This diff --git a/man/pops_multirun.Rd b/man/pops_multirun.Rd index 81b933db..b89455b9 100644 --- a/man/pops_multirun.Rd +++ b/man/pops_multirun.Rd @@ -64,7 +64,7 @@ pops_multirun( overpopulation_percentage = 0, leaving_percentage = 0, leaving_scale_coefficient = 1, - exposed_file = "", + exposed_file_list = "", mask = NULL, write_outputs = "None", output_folder_path = "", @@ -283,7 +283,11 @@ overpopulated} \item{leaving_scale_coefficient}{Coefficient to multiply scale parameter of the natural kernel (if applicable)} -\item{exposed_file}{A file with the exposed for the current} +\item{exposed_file_list}{paths to raster files with initial exposeds and standard deviation +for each host can be based in 2 formats (a single file with number of hosts or a single file with +2 layers number of hosts and standard deviation).. Units for infections are based on data +availability and the way the units used for your host file is created (e.g. percent area, # of +hosts per cell, etc.).} \item{mask}{Raster file used to provide a mask to remove 0's that are not true negatives from comparisons (e.g. mask out lakes and oceans from statics if modeling terrestrial species). This diff --git a/man/validate.Rd b/man/validate.Rd index 2e679d6c..d2792d91 100644 --- a/man/validate.Rd +++ b/man/validate.Rd @@ -66,7 +66,7 @@ validate( overpopulation_percentage = 0, leaving_percentage = 0, leaving_scale_coefficient = 1, - exposed_file = "", + exposed_file_list = "", write_outputs = "None", output_folder_path = "", point_file = "", @@ -289,7 +289,11 @@ overpopulated} \item{leaving_scale_coefficient}{Coefficient to multiply scale parameter of the natural kernel (if applicable)} -\item{exposed_file}{A file with the exposed for the current} +\item{exposed_file_list}{paths to raster files with initial exposeds and standard deviation +for each host can be based in 2 formats (a single file with number of hosts or a single file with +2 layers number of hosts and standard deviation).. Units for infections are based on data +availability and the way the units used for your host file is created (e.g. percent area, # of +hosts per cell, etc.).} \item{write_outputs}{Either c("summary_outputs", "all_simulations", or "None"). If not "None" output folder path must be provided.} From 0880911d9fbea4f2b1b23928e76ef1db44f8f83c Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 10 Jan 2024 14:50:01 -0500 Subject: [PATCH 26/68] update mortality_on --- R/checks.R | 13 +++++++++++-- R/configuration.R | 15 ++++++++------- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/R/checks.R b/R/checks.R index a63c67f7..8d5544d1 100644 --- a/R/checks.R +++ b/R/checks.R @@ -360,9 +360,18 @@ multihost_checks <- pest_host_table_list <- split(pest_host_table, seq_len(nrow(pest_host_table))) } + if (any(pest_host_table$mortality_rate > 0)) { + mortality_on <- TRUE + } else { + mortality_on <- FALSE + } + if (checks_passed) { - outs <- list(checks_passed, host_names, pest_host_table_list, competency_table_list) - names(outs) <- c("checks_passed", "host_names", "pest_host_table_list", "competency_table_list") + outs <- + list(checks_passed, host_names, pest_host_table_list, competency_table_list, mortality_on) + names(outs) <- + c("checks_passed", "host_names", "pest_host_table_list", "competency_table_list", + "mortality_on") return(outs) } else { outs <- list(checks_passed, failed_check) diff --git a/R/configuration.R b/R/configuration.R index 3368cb61..35472091 100644 --- a/R/configuration.R +++ b/R/configuration.R @@ -75,8 +75,8 @@ configuration <- function(config) { return(config) } - config$pest_host_table <- read.csv(config$pest_host_table) - config$competency_table <- read.csv(config$competency_table) + config$pest_host_table <- suppressWarnings(read.csv(config$pest_host_table)) + config$competency_table <- suppressWarnings(read.csv(config$competency_table)) # check that multi-host dimensions are ensured multihost_check <- @@ -86,6 +86,7 @@ configuration <- function(config) { config$host_names <- multihost_check$host_names config$pest_host_table_list <- multihost_check$pest_host_table_list config$competency_table_list <- multihost_check$competency_table_list + config$mortality_on <- multihost_check$mortality_on } else { config$failure <- multihost_check$failed_check } @@ -536,7 +537,7 @@ configuration <- function(config) { } else { config$failure <- infected_check$failed_check if (config$failure == file_exists_error) { - config$failure <- detailed_file_exists_error(config$infected_file) + config$failure <- detailed_file_exists_error(config$infected_file_list[i]) } return(config) } @@ -568,10 +569,10 @@ configuration <- function(config) { if (config$model_type == "SEI" && config$start_exposed) { if (config$function_name %in% aws_bucket_list) { exposed_check <- - secondary_raster_checks(config$exposed_file, total_populations, config$use_s3, + secondary_raster_checks(config$exposed_file_list[i], total_populations, config$use_s3, config$bucket) } else { - exposed_check <- secondary_raster_checks(config$exposed_file, total_populations) + exposed_check <- secondary_raster_checks(config$exposed_file_list[i], total_populations) } if (exposed_check$checks_passed) { exposed2 <- exposed_check$raster @@ -591,7 +592,7 @@ configuration <- function(config) { } else { config$failure <- exposed_check$failed_check if (config$failure == file_exists_error) { - config$failure <- detailed_file_exists_error(config$exposed_file) + config$failure <- detailed_file_exists_error(config$exposed_file_list[i]) } return(config) } @@ -621,7 +622,7 @@ configuration <- function(config) { } else { config$failure <- host_check$failed_check if (config$failure == file_exists_error) { - config$failure <- detailed_file_exists_error(config$host_file) + config$failure <- detailed_file_exists_error(config$host_file_list[i]) } return(config) } From acb4582ee8369e36878d31066eba17beb7891eb6 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 10 Jan 2024 21:24:13 -0500 Subject: [PATCH 27/68] update checks, config, and helpers to fix input to cpp issues. --- R/checks.R | 9 +++++++-- R/configuration.R | 38 ++++++++++++++++++++------------------ R/helpers.R | 37 +++++++++++++++++++++---------------- R/pops_model.R | 2 +- 4 files changed, 49 insertions(+), 37 deletions(-) diff --git a/R/checks.R b/R/checks.R index 8d5544d1..a6a4573b 100644 --- a/R/checks.R +++ b/R/checks.R @@ -358,6 +358,10 @@ multihost_checks <- host_names <- pest_host_table$host pest_host_table <- pest_host_table[, 2:4] pest_host_table_list <- split(pest_host_table, seq_len(nrow(pest_host_table))) + for (i in seq_along(pest_host_table_list)) { + pest_host_table_list[[i]] <- unname(pest_host_table_list[[i]]) + pest_host_table_list[[i]] <- as.vector(t(pest_host_table_list[[i]])) + } } if (any(pest_host_table$mortality_rate > 0)) { @@ -368,10 +372,11 @@ multihost_checks <- if (checks_passed) { outs <- - list(checks_passed, host_names, pest_host_table_list, competency_table_list, mortality_on) + list(checks_passed, host_names, pest_host_table_list, competency_table_list, mortality_on, + pest_host_table) names(outs) <- c("checks_passed", "host_names", "pest_host_table_list", "competency_table_list", - "mortality_on") + "mortality_on", "pest_host_table2") return(outs) } else { outs <- list(checks_passed, failed_check) diff --git a/R/configuration.R b/R/configuration.R index 35472091..8b882192 100644 --- a/R/configuration.R +++ b/R/configuration.R @@ -513,16 +513,16 @@ configuration <- function(config) { } # loop over infected and host files to create multi-host setup - host_pools <- c() - host_pool_infected_means <- c() - host_pool_infected_sds <- c() - host_pool_exposed_means <- c() - host_pool_exposed_sds <- c() - host_pool_host_means <- c() - host_pool_host_sds <- c() + host_pools <- list() + host_pool_infected_means <- list() + host_pool_infected_sds <- list() + host_pool_exposed_means <- list() + host_pool_exposed_sds <- list() + host_pool_host_means <- list() + host_pool_host_sds <- list() suitable <- zero_rast for (i in seq_along(config$infected_file_list)) { - host_pool <- c() + host_pool <- list() # check that infection rasters have the same crs, resolution, and extent if (config$function_name %in% aws_bucket_list) { infected_check <- @@ -556,8 +556,8 @@ configuration <- function(config) { } host_pool$name <- config$host_names[i] host_pool$infected <- infected_mean - host_pool_infected_means[i] <- infected_mean - host_pool_infected_sds[i] <- infected_sd + host_pool_infected_means[[i]] <- infected_mean + host_pool_infected_sds[[i]] <- infected_sd # prepare exposed exposed <- list(zero_matrix) if (config$model_type == "SEI" && config$latency_period > 1) { @@ -602,8 +602,8 @@ configuration <- function(config) { exposed_sd <- zero_matrix } - host_pool_exposed_means[i] <- exposed_mean - host_pool_exposed_sds[i] <- exposed_sd + host_pool_exposed_means[[i]] <- exposed_mean + host_pool_exposed_sds[[i]] <- exposed_sd exposed[[config$latency_period + 1]] <- exposed_mean host_pool$total_exposed <- total_exposed @@ -639,9 +639,9 @@ configuration <- function(config) { host_mean <- terra::as.matrix(host[[1]], wide = TRUE) host_sd <- zero_matrix } - host_pool_host_means[i] <- host_mean - host_pool_host_sds[i] <- host_sd - host_pool$total_host <- host_mean + host_pool_host_means[[i]] <- host_mean + host_pool_host_sds[[i]] <- host_sd + host_pool$total_hosts <- host_mean susceptible <- host_mean - infected_mean - exposed_mean susceptible[susceptible < 0] <- 0 @@ -652,9 +652,11 @@ configuration <- function(config) { mortality_tracker <- list(zero_matrix) if (config$mortality_on) { - mortality_length <- 1 / config$mortality_rate + config$mortality_time_lag + mortality_length <- + 1 / config$pest_host_table$mortality_rate[i] + + config$pest_host_table$mortality_time_lag[i] for (mt in 2:(mortality_length)) { - mortality_tracker[[mt]] <- mortality_tracker + mortality_tracker[[mt]] <- zero_matrix } } # add currently infected cells to last element of the mortality tracker so @@ -680,7 +682,7 @@ configuration <- function(config) { } } - host_pools[i] <- host_pool + host_pools[[i]] <- host_pool } config$host_pools <- host_pools diff --git a/R/helpers.R b/R/helpers.R index 248a3383..c1779182 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -285,29 +285,33 @@ competency_table_list_creator <- function(competency_table) { competency_table2$competency <- competencies competency_table2 <- competency_table2 competency_table_list <- split(competency_table2, seq_len(nrow(competency_table2))) + for (i in seq_along(competency_table_list)) { + competency_table_list[[i]] <- unname(competency_table_list[[i]]) + competency_table_list[[i]] <- as.vector(t(competency_table_list[[i]])) + } return(competency_table_list) } # Update host pools when uncertainties are used host_pool_setup <- function(config) { for (i in seq_along(config$host_file_list)) { - host_pool <- config$host_pools[i] + host_pool <- config$host_pools[[i]] if (config$use_initial_condition_uncertainty) { infected <- - matrix_norm_distribution(config$host_pool_infected_means[i], - config$host_pool_infected_sds[i]) + matrix_norm_distribution(config$host_pool_infected_means[[i]], + config$host_pool_infected_sds[[i]]) while (any(infected < 0)) { infected <- - matrix_norm_distribution(config$host_pool_infected_means[i], - config$host_pool_infected_sds[i]) + matrix_norm_distribution(config$host_pool_infected_means[[i]], + config$host_pool_infected_sds[[i]]) } - exposed2 <- matrix_norm_distribution(config$host_pool_exposed_means[i], - config$host_pool_exposed_sds[i]) + exposed2 <- matrix_norm_distribution(config$host_pool_exposed_means[[i]], + config$host_pool_exposed_sds[[i]]) while (any(exposed2 < 0)) { - exposed2 <- matrix_norm_distribution(config$host_pool_exposed_means[i], - config$host_pool_exposed_sds[i]) + exposed2 <- matrix_norm_distribution(config$host_pool_exposed_means[[i]], + config$host_pool_exposed_sds[[i]]) } - exposed <- config$host_pools[i]$exposed + exposed <- host_pool[[i]]$exposed exposed[[config$latency_period + 1]] <- exposed2 host_pool$infected <- infected host_pool$exposed <- exposed @@ -315,11 +319,11 @@ host_pool_setup <- function(config) { } if (config$use_host_uncertainty) { - host <- matrix_norm_distribution(config$host_pool_host_means[i], - config$host_pool_host_sds[i]) + host <- matrix_norm_distribution(config$host_pool_host_means[[i]], + config$host_pool_host_sds[[i]]) while (any(host > config$total_populations)) { - host <- matrix_norm_distribution(config$host_pool_host_means[i], - config$host_pool_host_sds[i]) + host <- matrix_norm_distribution(config$host_pool_host_means[[i]], + config$host_pool_host_sds[[i]]) } host_pool$total_host <- host } @@ -328,10 +332,11 @@ host_pool_setup <- function(config) { susceptible[susceptible < 0] <- 0 if (config$mortality_on) { - mortality_tracker <- config$host_pool[i]$mortality_tracker + mortality_tracker <- host_pool$mortality_tracker mortality_tracker[[length(mortality_tracker)]] <- host_pool$infected host_pool$mortality_tracker <- mortality_tracker } - config$host_pools[i] <- host_pool + config$host_pools[[i]] <- host_pool } + return(config) } diff --git a/R/pops_model.R b/R/pops_model.R index fd57e828..53319722 100644 --- a/R/pops_model.R +++ b/R/pops_model.R @@ -261,10 +261,10 @@ pops_model <- frequencies_n_config = frequencies_n_config, model_type_ = model_type_, latency_period = latency_period, + establishment_probability = establishment_probability, dispersal_percentage = dispersal_percentage, survival_rate_month = survival_rate_month, survival_rate_day = survival_rate_day, - establishment_probability = establishment_probability, overpopulation_config = overpopulation_config, network_config = network_config, network_data_config = network_data_config, From 79927744d3329f6f103f089f302e95e404e13e96 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 10 Jan 2024 21:27:41 -0500 Subject: [PATCH 28/68] use create host pool function in cal, val, pops, and pops_multi --- R/calibrate.R | 43 +------------------------------------------ R/pops.r | 46 ++-------------------------------------------- R/pops_multirun.R | 43 +------------------------------------------ R/validate.R | 46 ++-------------------------------------------- 4 files changed, 6 insertions(+), 172 deletions(-) diff --git a/R/calibrate.R b/R/calibrate.R index e6f0b479..e4ef63be 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -323,48 +323,7 @@ calibrate <- function(infected_years_file, config$random_seed <- sample(1:999999999999, 1, replace = FALSE) random_seeds <- create_random_seeds(1) - if (config$use_initial_condition_uncertainty) { - config$infected <- matrix_norm_distribution(config$infected_mean, config$infected_sd) - while (any(config$infected < 0)) { - config$infected <- matrix_norm_distribution(config$infected_mean, config$infected_sd) - } - exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) - while (any(exposed2 < 0)) { - exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) - } - exposed <- config$exposed - exposed[[config$latency_period + 1]] <- exposed2 - config$exposed <- exposed - } else { - config$infected <- config$infected_mean - exposed2 <- config$exposed_mean - exposed <- config$exposed - exposed[[config$latency_period + 1]] <- exposed2 - config$exposed <- exposed - } - - if (config$use_host_uncertainty) { - config$host <- matrix_norm_distribution(config$host_mean, config$host_sd) - while (any(config$host > config$total_populations)) { - config$host <- matrix_norm_distribution(config$host_mean, config$host_sd) - } - } else { - config$host <- config$host_mean - } - - susceptible <- config$host - config$infected - exposed2 - susceptible[susceptible < 0] <- 0 - - config$susceptible <- susceptible - config$total_hosts <- config$host - config$total_exposed <- exposed2 - - if (config$mortality_on) { - mortality_tracker2 <- config$mortality_tracker - mortality_tracker2[[length(mortality_tracker2)]] <- config$infected - config$mortality_tracker <- mortality_tracker2 - } - + config <- host_pool_setup(config) config$competency_table_list <- competency_table_list_creator(competency_table) data <- pops_model( diff --git a/R/pops.r b/R/pops.r index 3b2661db..599bc542 100644 --- a/R/pops.r +++ b/R/pops.r @@ -375,50 +375,8 @@ pops <- function(infected_file_list, } config <- draw_parameters(config) # draws parameter set for the run - - if (config$use_initial_condition_uncertainty) { - config$infected <- matrix_norm_distribution(config$infected_mean, config$infected_sd) - while (any(config$infected < 0)) { - config$infected <- matrix_norm_distribution(config$infected_mean, config$infected_sd) - } - exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) - while (any(exposed2 < 0)) { - exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) - } - exposed <- config$exposed - exposed[[config$latency_period + 1]] <- exposed2 - config$exposed <- exposed - } else { - config$infected <- config$infected_mean - exposed2 <- config$exposed_mean - exposed <- config$exposed - exposed[[config$latency_period + 1]] <- exposed2 - config$exposed <- exposed - } - - if (config$use_host_uncertainty) { - config$host <- matrix_norm_distribution(config$host_mean, config$host_sd) - while (any(config$host > config$total_populations)) { - config$host <- matrix_norm_distribution(config$host_mean, config$host_sd) - } - } else { - config$host <- config$host_mean - } - - susceptible <- config$host - config$infected - exposed2 - susceptible[susceptible < 0] <- 0 - - config$susceptible <- susceptible - config$total_hosts <- config$host - config$total_exposed <- exposed2 - - if (config$mortality_on) { - mortality_tracker2 <- config$mortality_tracker - mortality_tracker2[[length(mortality_tracker2)]] <- config$infected - config$mortality_tracker <- mortality_tracker2 - } - - config$competency_table_list <- competency_table_list_creator(competency_table) + config <- host_pool_setup(config) + config$competency_table_list <- competency_table_list_creator(config$competency_table) data <- pops_model(random_seed = config$random_seed[1], multiple_random_seeds = config$multiple_random_seeds, diff --git a/R/pops_multirun.R b/R/pops_multirun.R index ca1a3f67..5580a562 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -220,48 +220,7 @@ pops_multirun <- function(infected_file_list, ) %dopar% { config <- draw_parameters(config) # draws parameter set for the run - - if (config$use_initial_condition_uncertainty) { - config$infected <- matrix_norm_distribution(config$infected_mean, config$infected_sd) - while (any(config$infected < 0)) { - config$infected <- matrix_norm_distribution(config$infected_mean, config$infected_sd) - } - exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) - while (any(exposed2 < 0)) { - exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) - } - exposed <- config$exposed - exposed[[config$latency_period + 1]] <- exposed2 - config$exposed <- exposed - } else { - config$infected <- config$infected_mean - exposed2 <- config$exposed_mean - exposed <- config$exposed - exposed[[config$latency_period + 1]] <- exposed2 - config$exposed <- exposed - } - - if (config$use_host_uncertainty) { - config$host <- matrix_norm_distribution(config$host_mean, config$host_sd) - while (any(config$host > config$total_populations)) { - config$host <- matrix_norm_distribution(config$host_mean, config$host_sd) - } - } else { - config$host <- config$host_mean - } - - susceptible <- config$host - config$infected - exposed2 - susceptible[susceptible < 0] <- 0 - - config$susceptible <- susceptible - config$total_hosts <- config$host - config$total_exposed <- exposed2 - - if (config$mortality_on) { - mortality_tracker2 <- config$mortality_tracker - mortality_tracker2[[length(mortality_tracker2)]] <- config$infected - config$mortality_tracker <- mortality_tracker2 - } + config <- host_pool_setup(config) config$competency_table_list <- competency_table_list_creator(competency_table) data <- PoPS::pops_model( diff --git a/R/validate.R b/R/validate.R index 08d3523c..1df9ecc9 100644 --- a/R/validate.R +++ b/R/validate.R @@ -239,50 +239,8 @@ validate <- function(infected_years_file, ) %dopar% { config <- draw_parameters(config) # draws parameter set for the run - - if (config$use_initial_condition_uncertainty) { - config$infected <- matrix_norm_distribution(config$infected_mean, config$infected_sd) - while (any(config$infected < 0)) { - config$infected <- matrix_norm_distribution(config$infected_mean, config$infected_sd) - } - exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) - while (any(exposed2 < 0)) { - exposed2 <- matrix_norm_distribution(config$exposed_mean, config$exposed_sd) - } - exposed <- config$exposed - exposed[[config$latency_period + 1]] <- exposed2 - config$exposed <- exposed - } else { - config$infected <- config$infected_mean - exposed2 <- config$exposed_mean - exposed <- config$exposed - exposed[[config$latency_period + 1]] <- exposed2 - config$exposed <- exposed - } - - if (config$use_host_uncertainty) { - config$host <- matrix_norm_distribution(config$host_mean, config$host_sd) - while (any(config$host > config$total_populations)) { - config$host <- matrix_norm_distribution(config$host_mean, config$host_sd) - } - } else { - config$host <- config$host_mean - } - - susceptible <- config$host - config$infected - exposed2 - susceptible[susceptible < 0] <- 0 - - config$susceptible <- susceptible - config$total_hosts <- config$host - config$total_exposed <- exposed2 - - if (config$mortality_on) { - mortality_tracker2 <- config$mortality_tracker - mortality_tracker2[[length(mortality_tracker2)]] <- config$infected - config$mortality_tracker <- mortality_tracker2 - } - - config$competency_table_list <- competency_table_list_creator(competency_table) + config <- host_pool_setup(config) + config$competency_table_list <- competency_table_list_creator(config$competency_table) data <- pops_model( random_seed = config$random_seed[i], From 48ad7858e2820976d61a9907c623da5eb2310d81 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Thu, 11 Jan 2024 10:07:43 -0500 Subject: [PATCH 29/68] update testthat for pops --- tests/testthat/test-pops.r | 1716 ++++++++++++++++++++---------------- 1 file changed, 952 insertions(+), 764 deletions(-) diff --git a/tests/testthat/test-pops.r b/tests/testthat/test-pops.r index 589ea3bb..a4a48cae 100644 --- a/tests/testthat/test-pops.r +++ b/tests/testthat/test-pops.r @@ -1,8 +1,10 @@ context("test-pops") test_that("Model stops if files don't exist or aren't the correct extension", { - infected_file <- "" - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- c("") + host_file_list <- c(system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS")) + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -11,191 +13,230 @@ test_that("Model stops if files don't exist or aren't the correct extension", { end_date <- "2010-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), - detailed_file_exists_error(infected_file)) + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)) - infected_file <- system.file("extdata", "simple2x2", "infected.csv", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.csv", package = "PoPS") expect_error(pops( - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), raster_type_error, fixed = TRUE) - host_file <- "" - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - expect_error(pops(infected_file = infected_file, - host_file = "", - total_populations_file = host_file, + host_file_list <- "" + infected_file_list <- c(system.file("extdata", "simple2x2", "infected.tif", package = "PoPS")) + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), - detailed_file_exists_error(host_file)) + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)) - host_file <- system.file("extdata", "simple2x2", "infected.csv", package = "PoPS") - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + host_file_list <- c(system.file("extdata", "simple2x2", "infected.csv", package = "PoPS")) + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), raster_type_error, fixed = TRUE) - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") total_populations_file <- "" - expect_error(pops(infected_file = infected_file, - host_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), detailed_file_exists_error(total_populations_file)) - expect_error(pops(infected_file = infected_file, - host_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = system.file("extdata", "simple2x2", "infected.csv", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), raster_type_error, fixed = TRUE) temperature_file <- "" - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, use_lethal_temperature = TRUE, temperature_file = temperature_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), detailed_file_exists_error(temperature_file)) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, use_lethal_temperature = TRUE, temperature_file = system.file("extdata", "simple2x2", "infected.csv", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), raster_type_error, fixed = TRUE) temperature_file <- system.file("extdata", "simple2x2", "critical_temp_all_below_threshold.tif", package = "PoPS") temperature_coefficient_file <- "" - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, temp = TRUE, temperature_coefficient_file = temperature_coefficient_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), detailed_file_exists_error(temperature_coefficient_file)) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", "infected.csv", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), raster_type_error, fixed = TRUE) precipitation_coefficient_file <- "" - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, precip = TRUE, precipitation_coefficient_file = "", parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), detailed_file_exists_error(precipitation_coefficient_file)) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, precip = TRUE, precipitation_coefficient_file = system.file("extdata", "simple2x2", "infected.csv", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), raster_type_error, fixed = TRUE) treatments_file <- "" - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, management = TRUE, treatments_file = treatments_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), detailed_file_exists_error(treatments_file)) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, management = TRUE, treatments_file = system.file("extdata", "simple2x2", "infected.csv", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), raster_type_error, fixed = TRUE) - exposed_file <- "" - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + exposed_file_list <- "" + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, model_type = "SEI", - exposed_file = exposed_file, + exposed_file_list = exposed_file_list, latency_period = 2, start_exposed = TRUE, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), - detailed_file_exists_error(exposed_file)) + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)) quarantine_areas_file <- "" - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, quarantine_areas_file = quarantine_areas_file, use_quarantine = TRUE, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), detailed_file_exists_error(quarantine_areas_file)) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, parameter_means = c(0, 0, 0, 0), - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), paramter_means_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, parameter_means = parameter_means, - parameter_cov_matrix = matrix(0, nrow = 5, ncol = 6)), + parameter_cov_matrix = matrix(0, nrow = 5, ncol = 6), + pest_host_table = pest_host_table, + competency_table = competency_table), covariance_mat_error, fixed = TRUE) }) test_that("Model stops if treatments don't have correct dimenisions", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2010-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) treatments_file <- system.file("extdata", "simple2x2", "treatments.tif", package = "PoPS") treatment_dates <- c("2008-01-01", "2008-05-01") + pest_host_table <- system.file("extdata", "pest_host_table_singlehost.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, management = TRUE, treatments_file = treatments_file, treatment_dates = treatment_dates), @@ -203,8 +244,10 @@ test_that("Model stops if treatments don't have correct dimenisions", { }) test_that("Model stops if time and date parameters are of the wrong type and/or dimension", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -213,78 +256,98 @@ test_that("Model stops if time and date parameters are of the wrong type and/or end_date <- "2010-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, time_step = "two", parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), time_step_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, end_date = "two", parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), date_format_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, end_date = 156, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), date_format_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, start_date = "five", parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), date_format_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, start_date = 19, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), date_format_error, fixed = TRUE) }) test_that("Model stops if kernel is of the wrong type and/or dimension", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- system.file("extdata", "simple2x2", - "critical_temp_all_below_threshold.tif", - package = "PoPS") + "critical_temp_all_below_threshold.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2010-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") expect_error( - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, natural_kernel_type = "none", - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), natural_kernel_error, fixed = TRUE) expect_error( - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, anthropogenic_kernel_type = "none", - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), anthropogenic_kernel_error, fixed = TRUE) }) test_that("Input raster resolutions, extents, and crs all match", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -293,61 +356,75 @@ test_that("Input raster resolutions, extents, and crs all match", { end_date <- "2010-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") - expect_error(pops(infected_file = infected_file, - host_file = + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = system.file("extdata", "simple5x5", "total_plants.tif", package = "PoPS"), - total_populations_file = host_file, + total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), extent_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = system.file("extdata", "simple5x5", "total_plants.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), extent_error, fixed = TRUE) - expect_error(pops(infected_file = + expect_error(pops(infected_file_list = system.file("extdata", "simple5x5", "total_plants.tif", package = "PoPS"), - host_file = host_file, - total_populations_file = host_file, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), extent_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_lethal_temperature = TRUE, temperature_file = system.file("extdata", "simple2x2", "critical_temp_diff_extent.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), extent_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", "critical_temp_diff_extent.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), extent_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, precip = TRUE, precipitation_coefficient_file = system.file("extdata", "simple2x2", "critical_temp_diff_extent.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), extent_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", "critical_temp.tif", package = "PoPS"), @@ -356,184 +433,224 @@ test_that("Input raster resolutions, extents, and crs all match", { system.file("extdata", "simple2x2", "critical_temp_diff_extent.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), extent_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, management = TRUE, treatments_file = system.file("extdata", "simple2x2", "critical_temp_diff_extent.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), extent_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = system.file("extdata", "simple2x2", "total_plants_diff_res.tif", package = "PoPS"), - total_populations_file = host_file, + total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = system.file("extdata", "simple2x2", "total_plants_diff_xres.tif", package = "PoPS"), - total_populations_file = host_file, + total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = system.file("extdata", "simple2x2", "total_plants_diff_yres.tif", package = "PoPS"), - total_populations_file = host_file, + total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = system.file("extdata", "simple2x2", "total_plants_diff_res.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = system.file("extdata", "simple2x2", "total_plants_diff_xres.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = system.file("extdata", "simple2x2", "total_plants_diff_yres.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = + expect_error(pops(infected_file_list = system.file("extdata", "simple2x2", "total_plants_diff_res.tif", package = "PoPS"), - host_file = host_file, - total_populations_file = host_file, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = + expect_error(pops(infected_file_list = system.file("extdata", "simple2x2", "total_plants_diff_xres.tif", package = "PoPS"), - host_file = host_file, - total_populations_file = host_file, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = + expect_error(pops(infected_file_list = system.file("extdata", "simple2x2", "total_plants_diff_yres.tif", package = "PoPS"), - host_file = host_file, - total_populations_file = host_file, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_lethal_temperature = TRUE, temperature_file = system.file("extdata", "simple2x2", "critical_temp_diff_res.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_lethal_temperature = TRUE, temperature_file = system.file("extdata", "simple2x2", "critical_temp_diff_xres.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_lethal_temperature = TRUE, temperature_file = system.file("extdata", "simple2x2", "critical_temp_diff_yres.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", "critical_temp_diff_res.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", "critical_temp_diff_xres.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", "critical_temp_diff_yres.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, precip = TRUE, precipitation_coefficient_file = system.file("extdata", "simple2x2", "critical_temp_diff_res.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, precip = TRUE, precipitation_coefficient_file = system.file("extdata", "simple2x2", "critical_temp_diff_xres.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, precip = TRUE, precipitation_coefficient_file = system.file("extdata", "simple2x2", "critical_temp_diff_yres.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", "critical_temp.tif", package = "PoPS"), @@ -542,11 +659,13 @@ test_that("Input raster resolutions, extents, and crs all match", { system.file("extdata", "simple2x2", "critical_temp_diff_res.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", "critical_temp.tif", package = "PoPS"), @@ -555,11 +674,13 @@ test_that("Input raster resolutions, extents, and crs all match", { system.file("extdata", "simple2x2", "critical_temp_diff_xres.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", "critical_temp.tif", package = "PoPS"), @@ -568,96 +689,116 @@ test_that("Input raster resolutions, extents, and crs all match", { system.file("extdata", "simple2x2", "critical_temp_diff_yres.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, management = TRUE, treatments_file = system.file("extdata", "simple2x2", "critical_temp_diff_res.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, management = TRUE, treatments_file = system.file("extdata", "simple2x2", "critical_temp_diff_xres.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, management = TRUE, treatments_file = system.file("extdata", "simple2x2", "critical_temp_diff_yres.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), resolution_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = system.file("extdata", "simple2x2", "critical_temp_diff_crs.tif", package = "PoPS"), - total_populations_file = host_file, + total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), crs_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = system.file("extdata", "simple2x2", "critical_temp_diff_crs.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), crs_error, fixed = TRUE) - expect_error(pops(infected_file = + expect_error(pops(infected_file_list = system.file("extdata", "simple2x2", "critical_temp_diff_crs.tif", package = "PoPS"), - host_file = host_file, - total_populations_file = host_file, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), crs_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_lethal_temperature = TRUE, temperature_file = system.file("extdata", "simple2x2", "critical_temp_diff_crs.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), crs_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", "critical_temp_diff_crs.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), crs_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, precip = TRUE, precipitation_coefficient_file = system.file("extdata", "simple2x2", "critical_temp_diff_crs.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), crs_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", "critical_temp.tif", @@ -668,25 +809,30 @@ test_that("Input raster resolutions, extents, and crs all match", { "critical_temp_diff_crs.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), crs_error, fixed = TRUE) - expect_error(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, management = TRUE, treatments_file = system.file("extdata", "simple2x2", "critical_temp_diff_crs.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), crs_error, fixed = TRUE) }) test_that("Infected results return initial infected if reproductive rate is set to 0", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -695,55 +841,69 @@ test_that("Infected results return initial infected if reproductive rate is set end_date <- "2010-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)$infected[[1]], + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_lethal_temperature = TRUE, lethal_temperature = -16, lethal_temperature_month = 1, temperature_file = system.file("extdata", "simple2x2", "critical_temp.tif", package = "PoPS"), parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)$infected[[1]], + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp = TRUE, temperature_coefficient_file = coefficient_file)$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, precip = TRUE, precipitation_coefficient_file = coefficient_file)$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp = TRUE, temperature_coefficient_file = coefficient_file, precip = TRUE, precipitation_coefficient_file = coefficient_file)$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, use_lethal_temperature = TRUE, lethal_temperature = -16, lethal_temperature_month = 1, @@ -753,38 +913,44 @@ test_that("Infected results return initial infected if reproductive rate is set temperature_coefficient_file = coefficient_file, precip = TRUE, precipitation_coefficient_file = coefficient_file)$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", "temperature_coefficient_weeks.tif", package = "PoPS"), time_step = "week")$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, precip = TRUE, precipitation_coefficient_file = system.file("extdata", "simple2x2", "temperature_coefficient_weeks.tif", package = "PoPS"), time_step = "week")$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", @@ -794,13 +960,15 @@ test_that("Infected results return initial infected if reproductive rate is set system.file("extdata", "simple2x2", "temperature_coefficient_weeks.tif", package = "PoPS"), time_step = "week")$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, use_lethal_temperature = TRUE, lethal_temperature = -16, lethal_temperature_month = 1, @@ -816,38 +984,44 @@ test_that("Infected results return initial infected if reproductive rate is set system.file("extdata", "simple2x2", "temperature_coefficient_weeks.tif", package = "PoPS"), time_step = "week")$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp = TRUE, time_step = "day", temperature_coefficient_file = system.file("extdata", "simple2x2", "temperature_coefficient_days.tif", package = "PoPS"))$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, precip = TRUE, precipitation_coefficient_file = system.file("extdata", "simple2x2", "temperature_coefficient_days.tif", package = "PoPS"), time_step = "day")$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp = TRUE, temperature_coefficient_file = system.file("extdata", "simple2x2", @@ -857,13 +1031,15 @@ test_that("Infected results return initial infected if reproductive rate is set system.file("extdata", "simple2x2", "temperature_coefficient_days.tif", package = "PoPS"), time_step = "day")$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, use_lethal_temperature = TRUE, lethal_temperature = -16, lethal_temperature_month = 1, @@ -878,13 +1054,14 @@ test_that("Infected results return initial infected if reproductive rate is set system.file("extdata", "simple2x2", "temperature_coefficient_days.tif", package = "PoPS"), time_step = "day")$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) }) test_that( "Infected results returns all 0's if minimum temp drops below lethal temperature", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -894,17 +1071,19 @@ test_that( parameter_means <- c(1, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_lethal_temperature = TRUE, temperature_file = temperature_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)$infected[[1]], matrix(0, ncol = 2, nrow = 2)) - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_lethal_temperature = TRUE, temperature_file = temperature_file, precip = TRUE, @@ -912,9 +1091,9 @@ test_that( parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], matrix(0, ncol = 2, nrow = 2)) - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_lethal_temperature = TRUE, temperature_file = temperature_file, temp = TRUE, @@ -922,9 +1101,9 @@ test_that( parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], matrix(0, ncol = 2, nrow = 2)) - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_lethal_temperature = TRUE, temperature_file = temperature_file, temp = TRUE, @@ -939,8 +1118,8 @@ test_that( test_that( "Infected results returns less infection after survival rates than before", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") survival_rates_file <- @@ -953,17 +1132,17 @@ test_that( reduced_inf <- matrix(0, ncol = 2, nrow = 2) reduced_inf[1, 1] <- 3 - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_survival_rates = TRUE, survival_rates_file = survival_rates_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], reduced_inf) - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_survival_rates = TRUE, survival_rates_file = survival_rates_file, precip = TRUE, @@ -971,9 +1150,9 @@ test_that( parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], reduced_inf) - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_survival_rates = TRUE, survival_rates_file = survival_rates_file, temp = TRUE, @@ -981,9 +1160,9 @@ test_that( parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], reduced_inf) - expect_equal(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_equal(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, use_survival_rates = TRUE, survival_rates_file = survival_rates_file, temp = TRUE, @@ -998,8 +1177,10 @@ test_that( test_that("Infected and Susceptible results return all 0's if treatments file is all 1's but leaves a proportion of susceptibles if treatment method is ratio", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- + system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1013,9 +1194,9 @@ test_that("Infected and Susceptible results return all 0's if treatments file is parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) data <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, management = TRUE, treatment_dates = c("2008-12-01"), treatments_file = treatments_file, @@ -1028,10 +1209,10 @@ test_that("Infected and Susceptible results return all 0's if treatments file is expect_equal(data$susceptible[[1]], matrix(0, ncol = 2, nrow = 2)) data <- - pops(infected_file = infected_file, - host_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, treatment_method = "all infected", - total_populations_file = host_file, + total_populations_file = total_populations_file, management = TRUE, treatment_dates = c("2008-12-01"), treatments_file = treatments_file, @@ -1047,10 +1228,10 @@ test_that("Infected and Susceptible results return all 0's if treatments file is system.file("extdata", "simple2x2", "treatmentshalf.tif", package = "PoPS") data <- - pops(infected_file = infected_file, - host_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, treatment_method = "ratio", - total_populations_file = host_file, + total_populations_file = total_populations_file, management = TRUE, treatment_dates = c("2008-12-01"), treatments_file = treatments_file, @@ -1063,10 +1244,10 @@ test_that("Infected and Susceptible results return all 0's if treatments file is expect_equal(data$susceptible[[1]], matrix(c(5, 3, 7, 7), ncol = 2, nrow = 2)) data <- - pops(infected_file = infected_file, - host_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, treatment_method = "all infected", - total_populations_file = host_file, + total_populations_file = total_populations_file, management = TRUE, treatment_dates = c("2008-12-01"), treatments_file = treatments_file, @@ -1081,8 +1262,8 @@ test_that("Infected and Susceptible results return all 0's if treatments file is }) test_that("Infected results are greater than initial infected", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1092,28 +1273,28 @@ test_that("Infected results are greater than initial infected", { parameter_means <- c(1, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - expect_equal(all(pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_equal(all(pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix )$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_equal(all( - pops(infected_file = infected_file, - host_file = system.file("extdata", "simple2x2", + pops(infected_file_list = infected_file_list, + host_file_list = system.file("extdata", "simple2x2", "total_plants_host_greater_than_infected.tif", package = "PoPS"), - total_populations_file = host_file, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix)$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) }) test_that("All kernel types lead to spread", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1124,9 +1305,9 @@ test_that("All kernel types lead to spread", { parameter_means <- c(0.4, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, time_step = time_step, @@ -1134,87 +1315,87 @@ test_that("All kernel types lead to spread", { infecteds <- data$infected[[1]] expect_equal(all(infecteds >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "cauchy") infecteds <- data$infected[[1]] expect_equal(all(infecteds >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "uniform") infecteds <- data$infected[[1]] expect_equal(all(infecteds >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "hyperbolic secant") infecteds <- data$infected[[1]] expect_equal(all(infecteds >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "weibull") infecteds <- data$infected[[1]] expect_equal(all(infecteds >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "logistic") infecteds <- data$infected[[1]] expect_equal(all(infecteds >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "gamma") infecteds <- data$infected[[1]] expect_equal(all(infecteds >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) parameter_means <- c(0.4, 2, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "power law") infecteds <- data$infected[[1]] expect_equal(all(infecteds >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gte(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) ## currently not working @@ -1222,134 +1403,134 @@ test_that("All kernel types lead to spread", { # parameter_means <- c(0.4, 1000, 1, 500, 0, 0, 0, 0) # parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - # data <- pops(infected_file = infected_file, - # host_file = host_file, - # total_populations_file = host_file, + # data <- pops(infected_file_list = infected_file_list, + # host_file_list = host_file_list, + # total_populations_file = total_populations_file, # parameter_means = parameter_means, # parameter_cov_matrix = parameter_cov_matrix, # natural_kernel_type = "exponential-power") # infecteds <- data$infected[[1]] # expect_equal(all(infecteds >= - # terra::as.matrix(terra::rast(infected_file), wide = TRUE)), + # terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), # TRUE) # expect_gt(infecteds[1,2] + infecteds[2,1] + infecteds[2,2], 0) # # # bad array when icdf is available - # data <- pops(infected_file = infected_file, - # host_file = host_file, - # total_populations_file = host_file, + # data <- pops(infected_file_list = infected_file_list, + # host_file_list = host_file_list, + # total_populations_file = total_populations_file, # parameter_means = parameter_means, # parameter_cov_matrix = parameter_cov_matrix, # natural_kernel_type = "log normal") # infecteds <- data$infected[[1]] # expect_equal(all(infecteds >= - # terra::as.matrix(terra::rast(infected_file), wide = TRUE)), + # terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), # TRUE) # expect_gt(infecteds[1,2] + infecteds[2,1] + infecteds[2,2], 0) # checks for anthropogenic kernel type - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "exponential") expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "cauchy") expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "uniform") expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "hyperbolic secant") expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "logistic") expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "weibull") expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "power law") expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "gamma") expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) # - # data <- pops(infected_file = infected_file, - # host_file = host_file, - # total_populations_file = host_file, + # data <- pops(infected_file_list = infected_file_list, + # host_file_list = host_file_list, + # total_populations_file = total_populations_file, # parameter_means = parameter_means, # parameter_cov_matrix = parameter_cov_matrix, # anthropogenic_kernel_type = "exponential-power") # expect_equal(all(data$infected[[1]] >= - # terra::as.matrix(terra::rast(infected_file), wide = TRUE)), + # terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), # TRUE) ## currently not working # # - # data <- pops(infected_file = infected_file, - # host_file = host_file, - # total_populations_file = host_file, + # data <- pops(infected_file_list = infected_file_list, + # host_file_list = host_file_list, + # total_populations_file = total_populations_file, # parameter_means = parameter_means, # parameter_cov_matrix = parameter_cov_matrix, # anthropogenic_kernel_type = "log normal") # expect_equal(all(data$infected[[1]] >= - # terra::as.matrix(terra::rast(infected_file), wide = TRUE)), + # terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), # TRUE) }) test_that("Susceptibles are never negative", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1359,9 +1540,9 @@ test_that("Susceptibles are never negative", { parameter_means <- c(0.4, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - data <- pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + data <- pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, random_seed = 42, @@ -1375,10 +1556,10 @@ test_that("Susceptibles are never negative", { parameter_means <- c(0.5, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) data <- - pops(infected_file = infected_file, - host_file = system.file("extdata", "simple2x2", + pops(infected_file_list = infected_file_list, + host_file_list = system.file("extdata", "simple2x2", "total_plants_host_greater_than_infected.tif", package = "PoPS"), - total_populations_file = host_file, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, random_seed = 42, @@ -1392,8 +1573,8 @@ test_that("Susceptibles are never negative", { }) test_that("SEI model works as intended", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1409,9 +1590,9 @@ test_that("SEI model works as intended", { parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) data <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, random_seed = 42, @@ -1424,9 +1605,9 @@ test_that("SEI model works as intended", { treatment_dates = treatment_dates) model_type <- "SEI" data2 <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, random_seed = 42, @@ -1484,12 +1665,12 @@ test_that("SEI model works as intended", { expect_equal(all(data$infected[[3]] >= data2$infected[[1]]), TRUE) start_exposed <- TRUE - exposed_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + exposed_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") model_type <- "SEI" data3 <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, random_seed = 42, @@ -1501,7 +1682,7 @@ test_that("SEI model works as intended", { time_step = time_step, treatment_dates = treatment_dates, start_exposed = start_exposed, - exposed_file = exposed_file) + exposed_file_list = exposed_file_list) expect_equal(all(data3$susceptible[[1]] <= data2$susceptible[[1]]), TRUE) expect_equal(all(data3$susceptible[[2]] <= data2$susceptible[[1]]), TRUE) @@ -1514,8 +1695,8 @@ test_that("SEI model works as intended", { }) test_that("Infected results with weather are less than those without weather", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1527,9 +1708,9 @@ test_that("Infected results with weather are less than those without weather", { coefficient_sd_file <- system.file("extdata", "simple2x2", "coefficient_sd.tif", package = "PoPS") data <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, random_seed = 42, @@ -1537,9 +1718,9 @@ test_that("Infected results with weather are less than those without weather", { end_date = end_date) data_temp <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = coefficient_file, parameter_means = parameter_means, @@ -1549,9 +1730,9 @@ test_that("Infected results with weather are less than those without weather", { end_date = end_date) data_precip <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, precip = TRUE, precipitation_coefficient_file = coefficient_file, parameter_means = parameter_means, @@ -1561,9 +1742,9 @@ test_that("Infected results with weather are less than those without weather", { end_date = end_date) data_weather <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = coefficient_file, precip = TRUE, @@ -1575,9 +1756,9 @@ test_that("Infected results with weather are less than those without weather", { end_date = end_date) data_temp_wsd <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = coefficient_file, parameter_means = parameter_means, @@ -1590,9 +1771,9 @@ test_that("Infected results with weather are less than those without weather", { data_precip_wsd <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, precip = TRUE, precipitation_coefficient_file = coefficient_file, parameter_means = parameter_means, @@ -1604,9 +1785,9 @@ test_that("Infected results with weather are less than those without weather", { precipitation_coefficient_sd_file = coefficient_sd_file) data_weather_wsd <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, temp = TRUE, temperature_coefficient_file = coefficient_file, precip = TRUE, @@ -1647,8 +1828,8 @@ test_that("Infected results with weather are less than those without weather", { test_that( "Infected results are greater with same parameters for weekly spread vs. monthly", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1659,9 +1840,9 @@ test_that( parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) data_week <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, time_step = "week", @@ -1669,9 +1850,9 @@ test_that( start_date = start_date, end_date = end_date) data_month <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, time_step = "month", @@ -1686,8 +1867,10 @@ test_that( test_that("Infected results are greater with same parameters for daily spread vs. monthly and weekly", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- + system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1699,17 +1882,17 @@ test_that("Infected results are greater with same parameters for daily spread vs parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) data_day <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, time_step = "day", random_seed = 42) data_week <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, time_step = "week", @@ -1717,9 +1900,9 @@ test_that("Infected results are greater with same parameters for daily spread vs start_date = start_date, end_date = end_date) data_month <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, time_step = "month", @@ -1734,8 +1917,8 @@ test_that("Infected results are greater with same parameters for daily spread vs test_that( "Infected results are greater without treatment than with treatment", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") treatments_file <- system.file("extdata", "simple2x2", "treatments_1_1.tif", package = "PoPS") treatment_dates <- c("2008-03-05") start_date <- "2008-01-01" @@ -1744,18 +1927,18 @@ test_that( parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) data <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, random_seed = 44, start_date = start_date, end_date = end_date) data_treat <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, management = TRUE, treatment_dates = treatment_dates, treatments_file = treatments_file, @@ -1770,17 +1953,17 @@ test_that( }) test_that("Infected results are greater with higher reproductive rate", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2010-12-31" parameter_means <- c(1.0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) data_1 <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, time_step = "month", @@ -1789,9 +1972,9 @@ test_that("Infected results are greater with higher reproductive rate", { end_date = end_date) parameter_means <- c(0.75, 21, 1, 500, 0, 0, 0, 0) data_075 <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, time_step = "month", @@ -1800,9 +1983,9 @@ test_that("Infected results are greater with higher reproductive rate", { end_date = end_date) parameter_means <- c(0.5, 21, 1, 500, 0, 0, 0, 0) data_050 <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, time_step = "month", @@ -1811,9 +1994,9 @@ test_that("Infected results are greater with higher reproductive rate", { end_date = end_date) parameter_means <- c(0.25, 21, 1, 500, 0, 0, 0, 0) data_025 <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, time_step = "month", @@ -1822,9 +2005,9 @@ test_that("Infected results are greater with higher reproductive rate", { end_date = end_date) parameter_means <- c(0.1, 21, 1, 500, 0, 0, 0, 0) data_010 <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, time_step = "month", @@ -1852,8 +2035,8 @@ test_that("Infected results are greater with higher reproductive rate", { }) test_that("Treatments apply no matter what time step", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1866,9 +2049,9 @@ test_that("Treatments apply no matter what time step", { dates <- seq.Date(as.Date(start_date), as.Date(end_date), by = "days") for (i in seq_len(length(dates))) { data <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, management = TRUE, treatment_dates = c(as.character(dates[i])), treatments_file = treatments_file, @@ -1882,8 +2065,8 @@ test_that("Treatments apply no matter what time step", { }) test_that("Pesticide treatments apply no matter what time step", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1899,9 +2082,9 @@ test_that("Pesticide treatments apply no matter what time step", { for (i in seq_len(length(dates))) { data <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, management = TRUE, treatment_dates = c(as.character(dates[i])), treatments_file = treatments_file, @@ -1913,7 +2096,7 @@ test_that("Pesticide treatments apply no matter what time step", { pesticide_efficacy = pesticide_efficacy) expect_equal(data$infected[[1]], matrix(0, ncol = 2, nrow = 2)) expect_equal(data$susceptible[[1]], - terra::as.matrix(terra::rast(host_file), wide = TRUE)) + terra::as.matrix(terra::rast(host_file_list), wide = TRUE)) } pesticide_duration <- c(120) @@ -1921,9 +2104,9 @@ test_that("Pesticide treatments apply no matter what time step", { for (i in seq_len(length(dates))) { data <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, management = TRUE, treatment_dates = c(as.character(dates[i])), treatments_file = treatments_file, @@ -1941,8 +2124,10 @@ test_that("Pesticide treatments apply no matter what time step", { test_that("Changing the output frequency returns the correct number of outputs and output statistics", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- + system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2009-01-01" end_date <- "2009-12-31" treatment_dates <- c(start_date) @@ -1953,9 +2138,9 @@ test_that("Changing the output frequency returns the correct number of outputs a pops(output_frequency = "year", time_step = "month", treatment_dates = treatment_dates, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -1966,9 +2151,9 @@ test_that("Changing the output frequency returns the correct number of outputs a pops(output_frequency = "year", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -1979,9 +2164,9 @@ test_that("Changing the output frequency returns the correct number of outputs a pops(output_frequency = "year", time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -1992,9 +2177,9 @@ test_that("Changing the output frequency returns the correct number of outputs a pops(output_frequency = "month", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2005,9 +2190,9 @@ test_that("Changing the output frequency returns the correct number of outputs a pops(output_frequency = "month", time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2018,9 +2203,9 @@ test_that("Changing the output frequency returns the correct number of outputs a pops(output_frequency = "week", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2031,9 +2216,9 @@ test_that("Changing the output frequency returns the correct number of outputs a pops(output_frequency = "week", time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2043,9 +2228,9 @@ test_that("Changing the output frequency returns the correct number of outputs a expect_error(pops(output_frequency = "day", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2054,9 +2239,9 @@ test_that("Changing the output frequency returns the correct number of outputs a expect_error(pops(output_frequency = "day", time_step = "month", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2065,9 +2250,9 @@ test_that("Changing the output frequency returns the correct number of outputs a expect_error(pops(output_frequency = "week", time_step = "month", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2076,9 +2261,9 @@ test_that("Changing the output frequency returns the correct number of outputs a data <- pops(output_frequency = "day", time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2089,9 +2274,9 @@ test_that("Changing the output frequency returns the correct number of outputs a output_frequency_n = 5, time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2101,8 +2286,8 @@ test_that("Changing the output frequency returns the correct number of outputs a test_that( "Outputs occur with non-full year date range for all time step output frequency combinations", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2009-05-01" end_date <- "2009-10-29" treatment_dates <- start_date @@ -2112,9 +2297,9 @@ test_that( data <- pops(output_frequency = "year", time_step = "month", treatment_dates = treatment_dates, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2124,9 +2309,9 @@ test_that( data <- pops(output_frequency = "year", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2136,9 +2321,9 @@ test_that( data <- pops(output_frequency = "year", time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2148,9 +2333,9 @@ test_that( data <- pops(output_frequency = "month", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2160,9 +2345,9 @@ test_that( data <- pops(output_frequency = "month", time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2172,9 +2357,9 @@ test_that( data <- pops(output_frequency = "week", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2184,9 +2369,9 @@ test_that( data <- pops(output_frequency = "week", time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2197,9 +2382,9 @@ test_that( pops(output_frequency = "day" , time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2210,9 +2395,9 @@ test_that( pops(output_frequency = "time_step", time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2221,8 +2406,9 @@ test_that( }) test_that("Quarantine and spread rates work at all timings", { - infected_file <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") + infected_file_list <- + system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2009-01-01" end_date <- "2009-12-31" treatment_dates <- start_date @@ -2234,9 +2420,9 @@ test_that("Quarantine and spread rates work at all timings", { data <- pops(output_frequency = "year", time_step = "month", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2253,9 +2439,9 @@ test_that("Quarantine and spread rates work at all timings", { data <- pops(output_frequency = "year", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2272,9 +2458,9 @@ test_that("Quarantine and spread rates work at all timings", { data <- pops(output_frequency = "year", time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2291,9 +2477,9 @@ test_that("Quarantine and spread rates work at all timings", { data <- pops(output_frequency = "month", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2310,9 +2496,9 @@ test_that("Quarantine and spread rates work at all timings", { data <- pops(output_frequency = "month", time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2329,9 +2515,9 @@ test_that("Quarantine and spread rates work at all timings", { data <- pops(output_frequency = "week", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2348,9 +2534,9 @@ test_that("Quarantine and spread rates work at all timings", { data <- pops(output_frequency = "week", time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2367,9 +2553,9 @@ test_that("Quarantine and spread rates work at all timings", { data <- pops(output_frequency = "day", time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2386,9 +2572,9 @@ test_that("Quarantine and spread rates work at all timings", { data <- pops(output_frequency = "time_step", time_step = "day", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2406,8 +2592,9 @@ test_that("Quarantine and spread rates work at all timings", { test_that("Mortality works as expected with multiple ", { - infected_file <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") + infected_file_list <- + system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2009-01-01" end_date <- "2009-12-31" treatment_dates <- start_date @@ -2417,9 +2604,9 @@ test_that("Mortality works as expected with multiple ", { data <- pops(output_frequency = "month", time_step = "month", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2434,14 +2621,14 @@ test_that("Mortality works as expected with multiple ", { expect_equal(data$mortality[[1]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$mortality[[3]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) data <- pops(output_frequency = "week", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2455,15 +2642,15 @@ test_that("Mortality works as expected with multiple ", { expect_equal(length(data$mortality), 12) expect_equal(data$mortality[[1]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[3]], terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + expect_equal(data$mortality[[3]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) data <- pops(output_frequency = "week", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2479,15 +2666,15 @@ test_that("Mortality works as expected with multiple ", { expect_equal(data$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$mortality[[3]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$mortality[[4]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[5]], terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + expect_equal(data$mortality[[5]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) data <- pops(output_frequency = "week", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2505,14 +2692,14 @@ test_that("Mortality works as expected with multiple ", { expect_equal(data$mortality[[4]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$mortality[[5]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$mortality[[6]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[7]], terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + expect_equal(data$mortality[[7]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) data <- pops(output_frequency = "week", time_step = "week", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2534,12 +2721,13 @@ test_that("Mortality works as expected with multiple ", { expect_equal(data$mortality[[8]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$mortality[[9]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$mortality[[10]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[11]], terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + expect_equal(data$mortality[[11]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) }) test_that("Movements works as expected", { - infected_file <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") + infected_file_list <- + system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2009-01-01" end_date <- "2009-12-31" treatment_dates <- start_date @@ -2550,9 +2738,9 @@ test_that("Movements works as expected", { expect_error(pops(output_frequency = "month", time_step = "month", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2566,9 +2754,9 @@ test_that("Movements works as expected", { data <- pops(output_frequency = "month", time_step = "month", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2579,17 +2767,17 @@ test_that("Movements works as expected", { expect_equal(length(data$infected), 12) expect_equal(data$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(data$infected[[2]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(data$infected[[3]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(data$infected[[4]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) infected_move <- matrix(0, ncol = 20, nrow = 20) infected_move[2, 1] <- 1 expect_equal(data$infected[[5]], infected_move) - sus <- terra::rast(host_file) - terra::rast(infected_file) + sus <- terra::rast(host_file_list) - terra::rast(infected_file_list) sus <- terra::as.matrix(sus, wide = TRUE) sus5 <- sus sus5[1, 1] <- sus5[1, 1] - 199 @@ -2607,9 +2795,9 @@ test_that("Movements works as expected", { data <- pops(output_frequency = "month", time_step = "month", treatment_dates = start_date, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2620,17 +2808,17 @@ test_that("Movements works as expected", { expect_equal(length(data$infected), 12) expect_equal(data$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(data$infected[[2]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(data$infected[[3]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(data$infected[[4]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) infected_move <- matrix(0, ncol = 20, nrow = 20) infected_move[2, 1] <- 1 expect_equal(data$infected[[5]], infected_move) - sus <- terra::rast(host_file) - terra::rast(infected_file) + sus <- terra::rast(host_file_list) - terra::rast(infected_file_list) sus <- terra::as.matrix(sus, wide = TRUE) sus5 <- sus sus5[1, 1] <- sus5[1, 1] - 199 @@ -2649,17 +2837,17 @@ test_that("Movements works as expected", { test_that( "Overpopulation dispersal works as expected with directionality to prevent dispersers from leaving the simulated area", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2008-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) data <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2669,7 +2857,7 @@ test_that( leaving_percentage = 0.5, leaving_scale_coefficient = 0.5, natural_dir = "SE") - test_mat <- terra::as.matrix(terra::rast(infected_file), wide = TRUE) + test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) expect_lte(data$infected[[1]][[1]], test_mat[[1]]) expect_gte(data$infected[[1]][[2]], test_mat[[2]]) expect_gte(data$infected[[1]][[3]], test_mat[[3]]) @@ -2677,17 +2865,17 @@ test_that( }) test_that("Deterministic dispersal works as expected", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2008-12-31" parameter_means <- c(2, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) data <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2696,7 +2884,7 @@ test_that("Deterministic dispersal works as expected", { establishment_stochasticity = FALSE, movement_stochasticity = FALSE, dispersal_stochasticity = TRUE) - test_mat <- terra::as.matrix(terra::rast(infected_file), wide = TRUE) + test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) expect_gte(data$infected[[1]][[1]], test_mat[[1]]) expect_gte(data$infected[[1]][[2]], test_mat[[2]]) expect_gte(data$infected[[1]][[3]], test_mat[[3]]) @@ -2704,9 +2892,9 @@ test_that("Deterministic dispersal works as expected", { }) test_that("Network dispersal works as expected", { - infected_file <- + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2008-03-31" parameter_means <- c(2, 21, 1, 500, 0, 0, 100, 1000) @@ -2715,9 +2903,9 @@ test_that("Network dispersal works as expected", { anthropogenic_kernel_type <- "network" data <- - pops(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, @@ -2725,7 +2913,7 @@ test_that("Network dispersal works as expected", { anthropogenic_kernel_type = anthropogenic_kernel_type, network_filename = network_filename) - test_mat <- terra::as.matrix(terra::rast(infected_file), wide = TRUE) + test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) expect_gte(data$infected[[1]][[1]], test_mat[[1]]) expect_gte(data$infected[[1]][[2]], test_mat[[2]]) expect_gte(data$infected[[1]][[3]], test_mat[[3]]) @@ -2733,8 +2921,8 @@ test_that("Network dispersal works as expected", { }) test_that("uncertainty propogation works as expected", { - infected_file <- system.file("extdata", "simple20x20", "infected_wsd.tif", package = "PoPS") - host_file <- system.file("extdata", "simple20x20", "host_w_sd2.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple20x20", "infected_wsd.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple20x20", "host_w_sd2.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2008-01-01" @@ -2746,8 +2934,8 @@ test_that("uncertainty propogation works as expected", { use_host_uncertainty <- TRUE data <- - pops(infected_file = infected_file, - host_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, @@ -2757,14 +2945,14 @@ test_that("uncertainty propogation works as expected", { use_initial_condition_uncertainty = use_initial_condition_uncertainty, use_host_uncertainty = use_host_uncertainty) - test_mat <- terra::as.matrix(terra::rast(infected_file), wide = TRUE) + test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) expect_gte(data$infected[[1]][[1]], test_mat[[1]]) expect_gte(data$infected[[1]][[2]], test_mat[[2]]) expect_gte(data$infected[[1]][[3]], test_mat[[3]]) expect_gte(data$infected[[1]][[4]], test_mat[[4]]) - infected_file <- system.file("extdata", "simple20x20", "infected_wsd.tif", package = "PoPS") - host_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple20x20", "infected_wsd.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2008-01-01" @@ -2776,8 +2964,8 @@ test_that("uncertainty propogation works as expected", { use_host_uncertainty <- FALSE data <- - pops(infected_file = infected_file, - host_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, @@ -2787,15 +2975,15 @@ test_that("uncertainty propogation works as expected", { use_initial_condition_uncertainty = use_initial_condition_uncertainty, use_host_uncertainty = use_host_uncertainty) - test_mat <- terra::as.matrix(terra::rast(infected_file), wide = TRUE) + test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) expect_gte(data$infected[[1]][[1]], test_mat[[1]]) expect_gte(data$infected[[1]][[2]], test_mat[[2]]) expect_gte(data$infected[[1]][[3]], test_mat[[3]]) expect_gte(data$infected[[1]][[4]], test_mat[[4]]) - infected_file <- + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- system.file("extdata", "simple20x20", "host_w_sd2.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple20x20", "host_w_sd2.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2008-01-01" @@ -2807,8 +2995,8 @@ test_that("uncertainty propogation works as expected", { use_host_uncertainty <- TRUE data <- - pops(infected_file = infected_file, - host_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, @@ -2818,7 +3006,7 @@ test_that("uncertainty propogation works as expected", { use_initial_condition_uncertainty = use_initial_condition_uncertainty, use_host_uncertainty = use_host_uncertainty) - test_mat <- terra::as.matrix(terra::rast(infected_file), wide = TRUE) + test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) expect_gte(data$infected[[1]][[1]], test_mat[[1]]) expect_gte(data$infected[[1]][[2]], test_mat[[2]]) expect_gte(data$infected[[1]][[3]], test_mat[[3]]) @@ -2826,9 +3014,9 @@ test_that("uncertainty propogation works as expected", { }) test_that("multiple_random seeds works and returns expected results", { - infected_file <- + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2008-01-01" @@ -2840,8 +3028,8 @@ test_that("multiple_random seeds works and returns expected results", { file_random_seeds <- NULL data <- - pops(infected_file = infected_file, - host_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, @@ -2851,7 +3039,7 @@ test_that("multiple_random seeds works and returns expected results", { multiple_random_seeds = multiple_random_seeds, file_random_seeds = file_random_seeds) - test_mat <- terra::as.matrix(terra::rast(infected_file), wide = TRUE) + test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) expect_gte(data$infected[[1]][[1]], test_mat[[1]]) expect_gte(data$infected[[1]][[2]], test_mat[[2]]) expect_gte(data$infected[[1]][[3]], test_mat[[3]]) @@ -2860,8 +3048,8 @@ test_that("multiple_random seeds works and returns expected results", { file_random_seeds <- system.file("extdata", "simple2x2", "randoms.csv", package = "PoPS") data <- - pops(infected_file = infected_file, - host_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, @@ -2871,7 +3059,7 @@ test_that("multiple_random seeds works and returns expected results", { multiple_random_seeds = multiple_random_seeds, file_random_seeds = file_random_seeds) - test_mat <- terra::as.matrix(terra::rast(infected_file), wide = TRUE) + test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) expect_gte(data$infected[[1]][[1]], test_mat[[1]]) expect_gte(data$infected[[1]][[2]], test_mat[[2]]) expect_gte(data$infected[[1]][[3]], test_mat[[3]]) @@ -2880,9 +3068,9 @@ test_that("multiple_random seeds works and returns expected results", { test_that("Using soils returns expected results", { - infected_file <- + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" @@ -2896,8 +3084,8 @@ test_that("Using soils returns expected results", { data <- - pops(infected_file = infected_file, - host_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, @@ -2908,7 +3096,7 @@ test_that("Using soils returns expected results", { use_soils = use_soils, dispersers_to_soils_percentage = dispersers_to_soils_percentage) - test_mat <- terra::as.matrix(terra::rast(infected_file), wide = TRUE) + test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) expect_gte(data$infected[[1]][[1]], test_mat[[1]]) expect_gte(data$infected[[1]][[2]], test_mat[[2]]) expect_gte(data$infected[[1]][[3]], test_mat[[3]]) @@ -2917,8 +3105,8 @@ test_that("Using soils returns expected results", { expect_equal(length(data$soil_reservoirs[[2]]), 20) data <- - pops(infected_file = infected_file, - host_file = host_file, + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, @@ -2928,10 +3116,10 @@ test_that("Using soils returns expected results", { temperature_coefficient_file = coefficient_file, use_soils = use_soils, dispersers_to_soils_percentage = dispersers_to_soils_percentage, - soil_starting_pest_file = infected_file, + soil_starting_pest_file = infected_file_list, start_with_soil_populations = TRUE) - test_mat <- terra::as.matrix(terra::rast(infected_file), wide = TRUE) + test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) expect_gte(data$infected[[1]][[1]], test_mat[[1]]) expect_gte(data$infected[[1]][[2]], test_mat[[2]]) expect_gte(data$infected[[1]][[3]], test_mat[[3]]) From 2f8d70e43d2fce744f1eb8c837484228b6758db2 Mon Sep 17 00:00:00 2001 From: Vaclav Petras Date: Fri, 12 Jan 2024 12:34:02 -0500 Subject: [PATCH 30/68] Store the casted matrix inputs in std::vector to preserve them --- src/pops.cpp | 43 +++++++++++++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 14 deletions(-) diff --git a/src/pops.cpp b/src/pops.cpp index 7fd928a7..d8708f83 100644 --- a/src/pops.cpp +++ b/src/pops.cpp @@ -32,6 +32,17 @@ using std::to_string; using namespace Rcpp; using namespace pops; +struct InputHostPool { + std::vector infected; + std::vector susceptible; + std::vector total_exposed; + std::vector resistant; + std::vector> exposed; + std::vector mortality; + std::vector> mortality_tracker; + std::vector total_hosts; +}; + struct OutputHostPool { std::vector infected; std::vector susceptible; @@ -261,28 +272,32 @@ List pops_model_cpp( std::vector> host_pool_vector; std::vector host_pool_vector_plain; + InputHostPool input_host_pool; host_pool_vector.reserve(host_pools.size()); host_pool_vector_plain.reserve(host_pools.size()); + input_host_pool.reserve(host_pools.size()); for (unsigned i = 0; i < host_pools.size(); i++) { - IntegerMatrix infected = host_pools[i]["infected"]; - IntegerMatrix susceptible = host_pools[i]["susceptible"]; + input_host_pool.infected.emplace_back(host_pools[i]["infected"]); + input_host_pool.susceptible.emplace_back(host_pools[i]["susceptible"]); std::vector exposed = host_pools[i]["exposed"]; - IntegerMatrix total_exposed = host_pools[i]["total_exposed"]; - IntegerMatrix resistant = host_pools[i]["resistant"]; - IntegerMatrix total_hosts = host_pools[i]["total_hosts"]; - IntegerMatrix mortality = host_pools[i]["mortality"]; + input_host_pool.exposed.push_back(exposed); + input_host_pool.total_exposed.emplace_back(host_pools[i]["total_exposed"]); + input_host_pool.resistant.emplace_back(host_pools[i]["resistant"]); + input_host_pool.total_hosts.emplace_back(host_pools[i]["total_hosts"]); + input_host_pool.mortality.emplace_back(host_pools[i]["mortality"]); std::vector mortality_tracker = host_pools[i]["mortality_tracker"]; + input_host_pool.mortality_tracker.push_back(mortality_tracker); host_pool_vector.emplace_back(new PoPSModel::StandardSingleHostPool( mt, - susceptible, - exposed, + input_host_pool.susceptible[i], + input_host_pool.exposed[i], config.latency_period_steps, - infected, - total_exposed, - resistant, - mortality_tracker, - mortality, - total_hosts, + input_host_pool.infected[i], + input_host_pool.total_exposed[i], + input_host_pool.resistant[i], + input_host_pool.mortality_tracker[i], + input_host_pool.mortality[i], + input_host_pool.total_hosts[i], model.environment(), config.generate_stochasticity, config.reproductive_rate, From 20d60ac206483a4cbeb394fd2e18e11911180471 Mon Sep 17 00:00:00 2001 From: Vaclav Petras Date: Fri, 12 Jan 2024 12:49:40 -0500 Subject: [PATCH 31/68] Remove extra reserve --- src/pops.cpp | 1 - 1 file changed, 1 deletion(-) diff --git a/src/pops.cpp b/src/pops.cpp index d8708f83..fc0025ce 100644 --- a/src/pops.cpp +++ b/src/pops.cpp @@ -275,7 +275,6 @@ List pops_model_cpp( InputHostPool input_host_pool; host_pool_vector.reserve(host_pools.size()); host_pool_vector_plain.reserve(host_pools.size()); - input_host_pool.reserve(host_pools.size()); for (unsigned i = 0; i < host_pools.size(); i++) { input_host_pool.infected.emplace_back(host_pools[i]["infected"]); input_host_pool.susceptible.emplace_back(host_pools[i]["susceptible"]); From 8568bc0350f1a6f15f54c323503b9e57a31c43f1 Mon Sep 17 00:00:00 2001 From: Vaclav Petras Date: Fri, 12 Jan 2024 16:12:51 -0500 Subject: [PATCH 32/68] Read pest-host table from parameters --- src/pops.cpp | 1 + 1 file changed, 1 insertion(+) diff --git a/src/pops.cpp b/src/pops.cpp index fc0025ce..27d13af7 100644 --- a/src/pops.cpp +++ b/src/pops.cpp @@ -267,6 +267,7 @@ List pops_model_cpp( network->load(network_stream); } config.read_competency_table(competency_table); + config.read_pest_host_table(pest_host_table); PoPSModel model(config); From d2dc511bd19ef68183410b27aef37d02a8d878cb Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Fri, 12 Jan 2024 16:34:16 -0500 Subject: [PATCH 33/68] add non-mortality version of pesthost table --- inst/extdata/pest_host_table_singlehost_nomort.csv | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 inst/extdata/pest_host_table_singlehost_nomort.csv diff --git a/inst/extdata/pest_host_table_singlehost_nomort.csv b/inst/extdata/pest_host_table_singlehost_nomort.csv new file mode 100644 index 00000000..94a94f9c --- /dev/null +++ b/inst/extdata/pest_host_table_singlehost_nomort.csv @@ -0,0 +1,2 @@ +host,susceptibility,mortality_rate,mortality_time_lag +oak,0.7,0,1 \ No newline at end of file From 1d694bd5601ffec7da4b53d78965ced20f8e8805 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Fri, 12 Jan 2024 16:34:33 -0500 Subject: [PATCH 34/68] update tests to include new tables --- tests/testthat/test-pops.r | 272 ++++++++++++++++++++----------------- 1 file changed, 150 insertions(+), 122 deletions(-) diff --git a/tests/testthat/test-pops.r b/tests/testthat/test-pops.r index a4a48cae..8d2a5814 100644 --- a/tests/testthat/test-pops.r +++ b/tests/testthat/test-pops.r @@ -841,7 +841,7 @@ test_that("Infected results return initial infected if reproductive rate is set end_date <- "2010-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost.csv", package = "PoPS") + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") expect_equal(pops(infected_file_list = infected_file_list, @@ -850,7 +850,7 @@ test_that("Infected results return initial infected if reproductive rate is set parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, pest_host_table = pest_host_table, - competency_table = competency_table)$infected[[1]], + competency_table = competency_table)$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -863,7 +863,7 @@ test_that("Infected results return initial infected if reproductive rate is set parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, pest_host_table = pest_host_table, - competency_table = competency_table)$infected[[1]], + competency_table = competency_table)$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -873,7 +873,7 @@ test_that("Infected results return initial infected if reproductive rate is set pest_host_table = pest_host_table, competency_table = competency_table, temp = TRUE, - temperature_coefficient_file = coefficient_file)$infected[[1]], + temperature_coefficient_file = coefficient_file)$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -883,7 +883,7 @@ test_that("Infected results return initial infected if reproductive rate is set pest_host_table = pest_host_table, competency_table = competency_table, precip = TRUE, - precipitation_coefficient_file = coefficient_file)$infected[[1]], + precipitation_coefficient_file = coefficient_file)$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -895,7 +895,7 @@ test_that("Infected results return initial infected if reproductive rate is set temp = TRUE, temperature_coefficient_file = coefficient_file, precip = TRUE, - precipitation_coefficient_file = coefficient_file)$infected[[1]], + precipitation_coefficient_file = coefficient_file)$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -912,7 +912,7 @@ test_that("Infected results return initial infected if reproductive rate is set temp = TRUE, temperature_coefficient_file = coefficient_file, precip = TRUE, - precipitation_coefficient_file = coefficient_file)$infected[[1]], + precipitation_coefficient_file = coefficient_file)$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( @@ -927,7 +927,7 @@ test_that("Infected results return initial infected if reproductive rate is set temperature_coefficient_file = system.file("extdata", "simple2x2", "temperature_coefficient_weeks.tif", package = "PoPS"), - time_step = "week")$infected[[1]], + time_step = "week")$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( pops(infected_file_list = infected_file_list, @@ -941,7 +941,7 @@ test_that("Infected results return initial infected if reproductive rate is set precipitation_coefficient_file = system.file("extdata", "simple2x2", "temperature_coefficient_weeks.tif", package = "PoPS"), - time_step = "week")$infected[[1]], + time_step = "week")$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( pops(infected_file_list = infected_file_list, @@ -959,7 +959,7 @@ test_that("Infected results return initial infected if reproductive rate is set precipitation_coefficient_file = system.file("extdata", "simple2x2", "temperature_coefficient_weeks.tif", package = "PoPS"), - time_step = "week")$infected[[1]], + time_step = "week")$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( pops(infected_file_list = infected_file_list, @@ -983,7 +983,7 @@ test_that("Infected results return initial infected if reproductive rate is set precipitation_coefficient_file = system.file("extdata", "simple2x2", "temperature_coefficient_weeks.tif", package = "PoPS"), - time_step = "week")$infected[[1]], + time_step = "week")$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( @@ -998,7 +998,7 @@ test_that("Infected results return initial infected if reproductive rate is set time_step = "day", temperature_coefficient_file = system.file("extdata", "simple2x2", - "temperature_coefficient_days.tif", package = "PoPS"))$infected[[1]], + "temperature_coefficient_days.tif", package = "PoPS"))$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( pops(infected_file_list = infected_file_list, @@ -1012,7 +1012,7 @@ test_that("Infected results return initial infected if reproductive rate is set precipitation_coefficient_file = system.file("extdata", "simple2x2", "temperature_coefficient_days.tif", package = "PoPS"), - time_step = "day")$infected[[1]], + time_step = "day")$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( pops(infected_file_list = infected_file_list, @@ -1030,7 +1030,7 @@ test_that("Infected results return initial infected if reproductive rate is set precipitation_coefficient_file = system.file("extdata", "simple2x2", "temperature_coefficient_days.tif", package = "PoPS"), - time_step = "day")$infected[[1]], + time_step = "day")$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( pops(infected_file_list = infected_file_list, @@ -1053,7 +1053,7 @@ test_that("Infected results return initial infected if reproductive rate is set precipitation_coefficient_file = system.file("extdata", "simple2x2", "temperature_coefficient_days.tif", package = "PoPS"), - time_step = "day")$infected[[1]], + time_step = "day")$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) }) @@ -1070,6 +1070,8 @@ test_that( end_date <- "2010-12-31" parameter_means <- c(1, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -1079,7 +1081,7 @@ test_that( parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, pest_host_table = pest_host_table, - competency_table = competency_table)$infected[[1]], + competency_table = competency_table)$host_pools[[1]]$infected[[1]], matrix(0, ncol = 2, nrow = 2)) expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -1089,7 +1091,9 @@ test_that( precip = TRUE, precipitation_coefficient_file = coefficient_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)$host_pools[[1]]$infected[[1]], matrix(0, ncol = 2, nrow = 2)) expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -1099,7 +1103,9 @@ test_that( temp = TRUE, temperature_coefficient_file = coefficient_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)$host_pools[[1]]$infected[[1]], matrix(0, ncol = 2, nrow = 2)) expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -1111,7 +1117,9 @@ test_that( precip = TRUE, precipitation_coefficient_file = coefficient_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)$host_pools[[1]]$infected[[1]], matrix(0, ncol = 2, nrow = 2)) }) @@ -1128,6 +1136,8 @@ test_that( end_date <- "2010-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") reduced_inf <- matrix(0, ncol = 2, nrow = 2) reduced_inf[1, 1] <- 3 @@ -1138,7 +1148,9 @@ test_that( use_survival_rates = TRUE, survival_rates_file = survival_rates_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)$host_pools[[1]]$infected[[1]], reduced_inf) expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -1148,7 +1160,9 @@ test_that( precip = TRUE, precipitation_coefficient_file = coefficient_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)$host_pools[[1]]$infected[[1]], reduced_inf) expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -1158,7 +1172,9 @@ test_that( temp = TRUE, temperature_coefficient_file = coefficient_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)$host_pools[[1]]$infected[[1]], reduced_inf) expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -1170,7 +1186,9 @@ test_that( precip = TRUE, precipitation_coefficient_file = coefficient_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix)$infected[[1]], + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)$host_pools[[1]]$infected[[1]], reduced_inf) }) @@ -1192,6 +1210,8 @@ test_that("Infected and Susceptible results return all 0's if treatments file is package = "PoPS") parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -1202,11 +1222,13 @@ test_that("Infected and Susceptible results return all 0's if treatments file is treatments_file = treatments_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(data$infected[[1]], matrix(0, ncol = 2, nrow = 2)) - expect_equal(data$susceptible[[1]], matrix(0, ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$infected[[1]], matrix(0, ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$susceptible[[1]], matrix(0, ncol = 2, nrow = 2)) data <- pops(infected_file_list = infected_file_list, @@ -1218,10 +1240,12 @@ test_that("Infected and Susceptible results return all 0's if treatments file is treatments_file = treatments_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(data$infected[[1]], matrix(0, ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$infected[[1]], matrix(0, ncol = 2, nrow = 2)) expect_equal(data$susceptible[[1]], matrix(0, ncol = 2, nrow = 2)) treatments_file <- @@ -1237,10 +1261,12 @@ test_that("Infected and Susceptible results return all 0's if treatments file is treatments_file = treatments_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(data$infected[[1]], matrix(c(2, 0, 0, 0), ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$infected[[1]], matrix(c(2, 0, 0, 0), ncol = 2, nrow = 2)) expect_equal(data$susceptible[[1]], matrix(c(5, 3, 7, 7), ncol = 2, nrow = 2)) data <- @@ -1253,10 +1279,12 @@ test_that("Infected and Susceptible results return all 0's if treatments file is treatments_file = treatments_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(data$infected[[1]], matrix(c(0, 0, 0, 0), ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$infected[[1]], matrix(c(0, 0, 0, 0), ncol = 2, nrow = 2)) expect_equal(data$susceptible[[1]], matrix(c(5, 3, 7, 7), ncol = 2, nrow = 2)) }) @@ -1278,7 +1306,7 @@ test_that("Infected results are greater than initial infected", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix - )$infected[[1]] >= + )$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_equal(all( pops(infected_file_list = infected_file_list, @@ -1286,7 +1314,7 @@ test_that("Infected results are greater than initial infected", { "total_plants_host_greater_than_infected.tif", package = "PoPS"), total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix)$infected[[1]] >= + parameter_cov_matrix = parameter_cov_matrix)$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) }) @@ -1313,7 +1341,7 @@ test_that("All kernel types lead to spread", { time_step = time_step, natural_kernel_type = "exponential") - infecteds <- data$infected[[1]] + infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) @@ -1324,7 +1352,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "cauchy") - infecteds <- data$infected[[1]] + infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) @@ -1335,7 +1363,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "uniform") - infecteds <- data$infected[[1]] + infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) @@ -1346,7 +1374,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "hyperbolic secant") - infecteds <- data$infected[[1]] + infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) @@ -1357,7 +1385,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "weibull") - infecteds <- data$infected[[1]] + infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) @@ -1368,7 +1396,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "logistic") - infecteds <- data$infected[[1]] + infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) @@ -1379,7 +1407,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "gamma") - infecteds <- data$infected[[1]] + infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gt(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) @@ -1393,7 +1421,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, natural_kernel_type = "power law") - infecteds <- data$infected[[1]] + infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_gte(infecteds[1, 2] + infecteds[2, 1] + infecteds[2, 2], 0) @@ -1409,7 +1437,7 @@ test_that("All kernel types lead to spread", { # parameter_means = parameter_means, # parameter_cov_matrix = parameter_cov_matrix, # natural_kernel_type = "exponential-power") - # infecteds <- data$infected[[1]] + # infecteds <- data$host_pools[[1]]$infected[[1]] # expect_equal(all(infecteds >= # terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), # TRUE) @@ -1422,7 +1450,7 @@ test_that("All kernel types lead to spread", { # parameter_means = parameter_means, # parameter_cov_matrix = parameter_cov_matrix, # natural_kernel_type = "log normal") - # infecteds <- data$infected[[1]] + # infecteds <- data$host_pools[[1]]$infected[[1]] # expect_equal(all(infecteds >= # terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), # TRUE) @@ -1436,7 +1464,7 @@ test_that("All kernel types lead to spread", { parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "exponential") - expect_equal(all(data$infected[[1]] >= + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) data <- pops(infected_file_list = infected_file_list, @@ -1445,7 +1473,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "cauchy") - expect_equal(all(data$infected[[1]] >= + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) data <- pops(infected_file_list = infected_file_list, @@ -1454,7 +1482,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "uniform") - expect_equal(all(data$infected[[1]] >= + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) data <- pops(infected_file_list = infected_file_list, @@ -1463,7 +1491,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "hyperbolic secant") - expect_equal(all(data$infected[[1]] >= + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) data <- pops(infected_file_list = infected_file_list, @@ -1472,7 +1500,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "logistic") - expect_equal(all(data$infected[[1]] >= + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) data <- pops(infected_file_list = infected_file_list, @@ -1481,7 +1509,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "weibull") - expect_equal(all(data$infected[[1]] >= + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) data <- pops(infected_file_list = infected_file_list, @@ -1490,7 +1518,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "power law") - expect_equal(all(data$infected[[1]] >= + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) data <- pops(infected_file_list = infected_file_list, @@ -1499,7 +1527,7 @@ test_that("All kernel types lead to spread", { parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, anthropogenic_kernel_type = "gamma") - expect_equal(all(data$infected[[1]] >= + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) # @@ -1509,7 +1537,7 @@ test_that("All kernel types lead to spread", { # parameter_means = parameter_means, # parameter_cov_matrix = parameter_cov_matrix, # anthropogenic_kernel_type = "exponential-power") - # expect_equal(all(data$infected[[1]] >= + # expect_equal(all(data$host_pools[[1]]$infected[[1]] >= # terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), # TRUE) @@ -1522,7 +1550,7 @@ test_that("All kernel types lead to spread", { # parameter_means = parameter_means, # parameter_cov_matrix = parameter_cov_matrix, # anthropogenic_kernel_type = "log normal") - # expect_equal(all(data$infected[[1]] >= + # expect_equal(all(data$host_pools[[1]]$infected[[1]] >= # terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), # TRUE) @@ -1660,9 +1688,9 @@ test_that("SEI model works as intended", { expect_equal(all(data$susceptible[[2]] <= data2$susceptible[[1]]), TRUE) expect_equal(all(data$susceptible[[3]] <= data2$susceptible[[1]]), TRUE) - expect_equal(all(data$infected[[1]] >= data2$infected[[1]]), TRUE) - expect_equal(all(data$infected[[2]] >= data2$infected[[1]]), TRUE) - expect_equal(all(data$infected[[3]] >= data2$infected[[1]]), TRUE) + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) + expect_equal(all(data$infected[[2]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) + expect_equal(all(data$infected[[3]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) start_exposed <- TRUE exposed_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") @@ -1688,9 +1716,9 @@ test_that("SEI model works as intended", { expect_equal(all(data3$susceptible[[2]] <= data2$susceptible[[1]]), TRUE) expect_equal(all(data3$susceptible[[3]] <= data2$susceptible[[1]]), TRUE) - expect_equal(all(data3$infected[[1]] >= data2$infected[[1]]), TRUE) - expect_equal(all(data3$infected[[2]] >= data2$infected[[1]]), TRUE) - expect_equal(all(data3$infected[[3]] >= data2$infected[[1]]), TRUE) + expect_equal(all(data3$host_pools[[1]]$infected[[1]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) + expect_equal(all(data3$infected[[2]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) + expect_equal(all(data3$infected[[3]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) }) @@ -1801,27 +1829,27 @@ test_that("Infected results with weather are less than those without weather", { temperature_coefficient_sd_file = coefficient_sd_file, precipitation_coefficient_sd_file = coefficient_sd_file) - expect_gte(sum(data$infected[[1]]), sum(data_temp$infected[[1]])) + expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_temp$host_pools[[1]]$infected[[1]])) expect_gte(sum(data$infected[[2]]), sum(data_temp$infected[[2]])) expect_gte(sum(data$infected[[3]]), sum(data_temp$infected[[3]])) - expect_gte(sum(data$infected[[1]]), sum(data_precip$infected[[1]])) + expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_precip$host_pools[[1]]$infected[[1]])) expect_gte(sum(data$infected[[2]]), sum(data_precip$infected[[2]])) expect_gte(sum(data$infected[[3]]), sum(data_precip$infected[[3]])) - expect_gte(sum(data$infected[[1]]), sum(data_weather$infected[[1]])) + expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_weather$host_pools[[1]]$infected[[1]])) expect_gte(sum(data$infected[[2]]), sum(data_weather$infected[[2]])) expect_gte(sum(data$infected[[3]]), sum(data_weather$infected[[3]])) expect_gte(sum(data$infected[[2]]), sum(data_temp_wsd$infected[[2]])) expect_gte(sum(data$infected[[3]]), sum(data_temp_wsd$infected[[3]])) - expect_gte(sum(data$infected[[1]]), sum(data_temp_wsd$infected[[1]])) + expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_temp_wsd$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data$infected[[1]]), sum(data_precip_wsd$infected[[1]])) + expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_precip_wsd$host_pools[[1]]$infected[[1]])) expect_gte(sum(data$infected[[2]]), sum(data_precip_wsd$infected[[2]])) expect_gte(sum(data$infected[[3]]), sum(data_precip_wsd$infected[[3]])) - expect_gte(sum(data$infected[[1]]), sum(data_weather_wsd$infected[[1]])) + expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_weather_wsd$host_pools[[1]]$infected[[1]])) expect_gte(sum(data$infected[[2]]), sum(data_weather_wsd$infected[[2]])) expect_gte(sum(data$infected[[3]]), sum(data_weather_wsd$infected[[3]])) }) @@ -1860,7 +1888,7 @@ test_that( start_date = start_date, end_date = end_date) - expect_equal(all(data_week$infected[[1]] >= data_month$infected[[1]]), TRUE) + expect_equal(all(data_week$host_pools[[1]]$infected[[1]] >= data_month$host_pools[[1]]$infected[[1]]), TRUE) expect_equal(all(data_week$infected[[2]] >= data_month$infected[[2]]), TRUE) }) @@ -1910,9 +1938,9 @@ test_that("Infected results are greater with same parameters for daily spread vs start_date = start_date, end_date = end_date) - expect_equal(all(data_day$infected[[1]] >= data_month$infected[[1]]), TRUE) - expect_equal(all(data_day$infected[[1]] >= data_week$infected[[1]]), TRUE) - expect_equal(all(data_week$infected[[1]] >= data_month$infected[[1]]), TRUE) + expect_equal(all(data_day$host_pools[[1]]$infected[[1]] >= data_month$host_pools[[1]]$infected[[1]]), TRUE) + expect_equal(all(data_day$host_pools[[1]]$infected[[1]] >= data_week$host_pools[[1]]$infected[[1]]), TRUE) + expect_equal(all(data_week$host_pools[[1]]$infected[[1]] >= data_month$host_pools[[1]]$infected[[1]]), TRUE) }) test_that( @@ -1948,7 +1976,7 @@ test_that( start_date = start_date, end_date = end_date) - expect_equal(all(data$infected[[1]] >= data_treat$infected[[1]]), TRUE) + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= data_treat$host_pools[[1]]$infected[[1]]), TRUE) expect_equal(all(data$infected[[2]] >= data_treat$infected[[2]]), TRUE) }) @@ -2015,21 +2043,21 @@ test_that("Infected results are greater with higher reproductive rate", { start_date = start_date, end_date = end_date) - expect_gte(sum(data_1$infected[[1]]), sum(data_075$infected[[1]])) - expect_gte(sum(data_1$infected[[1]]), sum(data_050$infected[[1]])) - expect_gte(sum(data_1$infected[[1]]), sum(data_025$infected[[1]])) - expect_gte(sum(data_1$infected[[1]]), sum(data_010$infected[[1]])) + expect_gte(sum(data_1$host_pools[[1]]$infected[[1]]), sum(data_075$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data_1$host_pools[[1]]$infected[[1]]), sum(data_050$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data_1$host_pools[[1]]$infected[[1]]), sum(data_025$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data_1$host_pools[[1]]$infected[[1]]), sum(data_010$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data_075$infected[[1]]), sum(data_050$infected[[1]])) - expect_gte(sum(data_075$infected[[1]]), sum(data_025$infected[[1]])) - expect_gte(sum(data_075$infected[[1]]), sum(data_010$infected[[1]])) + expect_gte(sum(data_075$host_pools[[1]]$infected[[1]]), sum(data_050$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data_075$host_pools[[1]]$infected[[1]]), sum(data_025$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data_075$host_pools[[1]]$infected[[1]]), sum(data_010$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data_050$infected[[1]]), sum(data_025$infected[[1]])) + expect_gte(sum(data_050$host_pools[[1]]$infected[[1]]), sum(data_025$host_pools[[1]]$infected[[1]])) expect_gte(sum(data_050$infected[[2]]), sum(data_025$infected[[2]])) - expect_gte(sum(data_050$infected[[1]]), sum(data_010$infected[[1]])) + expect_gte(sum(data_050$host_pools[[1]]$infected[[1]]), sum(data_010$host_pools[[1]]$infected[[1]])) expect_gte(sum(data_050$infected[[2]]), sum(data_010$infected[[2]])) - expect_gte(sum(data_025$infected[[1]]), sum(data_010$infected[[1]])) + expect_gte(sum(data_025$host_pools[[1]]$infected[[1]]), sum(data_010$host_pools[[1]]$infected[[1]])) expect_gte(sum(data_025$infected[[2]]), sum(data_010$infected[[2]])) }) @@ -2059,7 +2087,7 @@ test_that("Treatments apply no matter what time step", { parameter_cov_matrix = parameter_cov_matrix, start_date = start_date, end_date = end_date) - expect_equal(data$infected[[1]], matrix(0, ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$infected[[1]], matrix(0, ncol = 2, nrow = 2)) expect_equal(data$susceptible[[1]], matrix(0, ncol = 2, nrow = 2)) } }) @@ -2094,7 +2122,7 @@ test_that("Pesticide treatments apply no matter what time step", { end_date = end_date, pesticide_duration = pesticide_duration, pesticide_efficacy = pesticide_efficacy) - expect_equal(data$infected[[1]], matrix(0, ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$infected[[1]], matrix(0, ncol = 2, nrow = 2)) expect_equal(data$susceptible[[1]], terra::as.matrix(terra::rast(host_file_list), wide = TRUE)) } @@ -2116,7 +2144,7 @@ test_that("Pesticide treatments apply no matter what time step", { end_date = end_date, pesticide_duration = pesticide_duration, pesticide_efficacy = pesticide_efficacy) - expect_equal(data$infected[[1]], matrix(c(3, 0, 0, 0), ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$infected[[1]], matrix(c(3, 0, 0, 0), ncol = 2, nrow = 2)) expect_equal(data$susceptible[[1]], matrix(c(12, 6, 14, 15), ncol = 2, nrow = 2)) } @@ -2766,7 +2794,7 @@ test_that("Movements works as expected", { random_seed = 42) expect_equal(length(data$infected), 12) - expect_equal(data$infected[[1]], + expect_equal(data$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(data$infected[[2]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) @@ -2807,7 +2835,7 @@ test_that("Movements works as expected", { random_seed = 45) expect_equal(length(data$infected), 12) - expect_equal(data$infected[[1]], + expect_equal(data$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(data$infected[[2]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) @@ -2858,10 +2886,10 @@ test_that( leaving_scale_coefficient = 0.5, natural_dir = "SE") test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) - expect_lte(data$infected[[1]][[1]], test_mat[[1]]) - expect_gte(data$infected[[1]][[2]], test_mat[[2]]) - expect_gte(data$infected[[1]][[3]], test_mat[[3]]) - expect_gte(data$infected[[1]][[4]], test_mat[[4]]) + expect_lte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) }) test_that("Deterministic dispersal works as expected", { @@ -2885,10 +2913,10 @@ test_that("Deterministic dispersal works as expected", { movement_stochasticity = FALSE, dispersal_stochasticity = TRUE) test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) - expect_gte(data$infected[[1]][[1]], test_mat[[1]]) - expect_gte(data$infected[[1]][[2]], test_mat[[2]]) - expect_gte(data$infected[[1]][[3]], test_mat[[3]]) - expect_gte(data$infected[[1]][[4]], test_mat[[4]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) }) test_that("Network dispersal works as expected", { @@ -2914,10 +2942,10 @@ test_that("Network dispersal works as expected", { network_filename = network_filename) test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) - expect_gte(data$infected[[1]][[1]], test_mat[[1]]) - expect_gte(data$infected[[1]][[2]], test_mat[[2]]) - expect_gte(data$infected[[1]][[3]], test_mat[[3]]) - expect_gte(data$infected[[1]][[4]], test_mat[[4]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) }) test_that("uncertainty propogation works as expected", { @@ -2946,10 +2974,10 @@ test_that("uncertainty propogation works as expected", { use_host_uncertainty = use_host_uncertainty) test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) - expect_gte(data$infected[[1]][[1]], test_mat[[1]]) - expect_gte(data$infected[[1]][[2]], test_mat[[2]]) - expect_gte(data$infected[[1]][[3]], test_mat[[3]]) - expect_gte(data$infected[[1]][[4]], test_mat[[4]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) infected_file_list <- system.file("extdata", "simple20x20", "infected_wsd.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -2976,10 +3004,10 @@ test_that("uncertainty propogation works as expected", { use_host_uncertainty = use_host_uncertainty) test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) - expect_gte(data$infected[[1]][[1]], test_mat[[1]]) - expect_gte(data$infected[[1]][[2]], test_mat[[2]]) - expect_gte(data$infected[[1]][[3]], test_mat[[3]]) - expect_gte(data$infected[[1]][[4]], test_mat[[4]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") @@ -3007,10 +3035,10 @@ test_that("uncertainty propogation works as expected", { use_host_uncertainty = use_host_uncertainty) test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) - expect_gte(data$infected[[1]][[1]], test_mat[[1]]) - expect_gte(data$infected[[1]][[2]], test_mat[[2]]) - expect_gte(data$infected[[1]][[3]], test_mat[[3]]) - expect_gte(data$infected[[1]][[4]], test_mat[[4]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) }) test_that("multiple_random seeds works and returns expected results", { @@ -3040,10 +3068,10 @@ test_that("multiple_random seeds works and returns expected results", { file_random_seeds = file_random_seeds) test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) - expect_gte(data$infected[[1]][[1]], test_mat[[1]]) - expect_gte(data$infected[[1]][[2]], test_mat[[2]]) - expect_gte(data$infected[[1]][[3]], test_mat[[3]]) - expect_gte(data$infected[[1]][[4]], test_mat[[4]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) file_random_seeds <- system.file("extdata", "simple2x2", "randoms.csv", package = "PoPS") @@ -3060,10 +3088,10 @@ test_that("multiple_random seeds works and returns expected results", { file_random_seeds = file_random_seeds) test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) - expect_gte(data$infected[[1]][[1]], test_mat[[1]]) - expect_gte(data$infected[[1]][[2]], test_mat[[2]]) - expect_gte(data$infected[[1]][[3]], test_mat[[3]]) - expect_gte(data$infected[[1]][[4]], test_mat[[4]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) }) @@ -3097,10 +3125,10 @@ test_that("Using soils returns expected results", { dispersers_to_soils_percentage = dispersers_to_soils_percentage) test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) - expect_gte(data$infected[[1]][[1]], test_mat[[1]]) - expect_gte(data$infected[[1]][[2]], test_mat[[2]]) - expect_gte(data$infected[[1]][[3]], test_mat[[3]]) - expect_gte(data$infected[[1]][[4]], test_mat[[4]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) expect_equal(length(data$soil_reservoirs[[1]]), 20) expect_equal(length(data$soil_reservoirs[[2]]), 20) @@ -3120,10 +3148,10 @@ test_that("Using soils returns expected results", { start_with_soil_populations = TRUE) test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) - expect_gte(data$infected[[1]][[1]], test_mat[[1]]) - expect_gte(data$infected[[1]][[2]], test_mat[[2]]) - expect_gte(data$infected[[1]][[3]], test_mat[[3]]) - expect_gte(data$infected[[1]][[4]], test_mat[[4]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) expect_equal(length(data$soil_reservoirs[[1]]), 20) expect_equal(length(data$soil_reservoirs[[2]]), 20) }) From e9ffe5f9521744807965f9d021a846dc95cd386d Mon Sep 17 00:00:00 2001 From: Vaclav Petras Date: Fri, 12 Jan 2024 17:11:48 -0500 Subject: [PATCH 35/68] Use the existing matrices used in HostPool for cloning instead of getting them from inputs --- src/pops.cpp | 23 +++++++++-------------- 1 file changed, 9 insertions(+), 14 deletions(-) diff --git a/src/pops.cpp b/src/pops.cpp index 27d13af7..cd6e55b7 100644 --- a/src/pops.cpp +++ b/src/pops.cpp @@ -410,27 +410,22 @@ List pops_model_cpp( int num_infected = 0; IntegerMatrix all_infected(config.rows, config.cols); for (unsigned i = 0; i < host_pools.size(); i++) { - IntegerMatrix infected = host_pools[i]["infected"]; - IntegerMatrix susceptible = host_pools[i]["susceptible"]; - IntegerMatrix resistant = host_pools[i]["resistant"]; - IntegerMatrix total_exposed = host_pools[i]["total_exposed"]; - output_host_pool_vector[i].infected.push_back(Rcpp::clone(infected)); - output_host_pool_vector[i].susceptible.push_back(Rcpp::clone(susceptible)); - output_host_pool_vector[i].resistant.push_back(Rcpp::clone(resistant)); - output_host_pool_vector[i].total_exposed.push_back(Rcpp::clone(total_exposed)); + output_host_pool_vector[i].infected.push_back(Rcpp::clone(input_host_pool.infected[i])); + output_host_pool_vector[i].susceptible.push_back(Rcpp::clone(input_host_pool.susceptible[i])); + output_host_pool_vector[i].resistant.push_back(Rcpp::clone(input_host_pool.resistant[i])); + output_host_pool_vector[i].total_exposed.push_back(Rcpp::clone(input_host_pool.total_exposed[i])); std::vector exposed_v; - std::vector tmp_exposed = host_pools[i]["exposed"]; if (config.model_type == "SEI") { - for (unsigned e = 0; e < tmp_exposed.size(); e++) { - exposed_v.push_back(Rcpp::clone(tmp_exposed[e])); + for (unsigned e = 0; e < input_host_pool.exposed[i].size(); e++) { + exposed_v.push_back(Rcpp::clone(input_host_pool.exposed[i][e])); } } else { - exposed_v = tmp_exposed; + exposed_v = input_host_pool.exposed[i]; } output_host_pool_vector[i].exposed.push_back(exposed_v); - num_infected += sum_of_infected(infected, spatial_indices); - all_infected += infected; + num_infected += sum_of_infected(input_host_pool.infected[i], spatial_indices); + all_infected += input_host_pool.infected[i]; } total_populations_vector.push_back(Rcpp::clone(total_populations)); dispersers_vector.push_back(Rcpp::clone(total_dispersers)); From b3575e908f0ea8be543eb4d5d2903e998745163b Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 16 Jan 2024 10:49:01 -0500 Subject: [PATCH 36/68] add more test data for mortality tests --- inst/extdata/pest_host_table_singlehost.csv | 2 +- inst/extdata/pest_host_table_singlehost010tl1.csv | 2 ++ inst/extdata/pest_host_table_singlehost025.csv | 2 ++ inst/extdata/pest_host_table_singlehost025tl3.csv | 2 ++ 4 files changed, 7 insertions(+), 1 deletion(-) create mode 100644 inst/extdata/pest_host_table_singlehost010tl1.csv create mode 100644 inst/extdata/pest_host_table_singlehost025.csv create mode 100644 inst/extdata/pest_host_table_singlehost025tl3.csv diff --git a/inst/extdata/pest_host_table_singlehost.csv b/inst/extdata/pest_host_table_singlehost.csv index bbf4ef49..c121dc6e 100644 --- a/inst/extdata/pest_host_table_singlehost.csv +++ b/inst/extdata/pest_host_table_singlehost.csv @@ -1,2 +1,2 @@ host,susceptibility,mortality_rate,mortality_time_lag -oak,0.7,0.1,1 \ No newline at end of file +oak,0.7,0.5,1 \ No newline at end of file diff --git a/inst/extdata/pest_host_table_singlehost010tl1.csv b/inst/extdata/pest_host_table_singlehost010tl1.csv new file mode 100644 index 00000000..bbf4ef49 --- /dev/null +++ b/inst/extdata/pest_host_table_singlehost010tl1.csv @@ -0,0 +1,2 @@ +host,susceptibility,mortality_rate,mortality_time_lag +oak,0.7,0.1,1 \ No newline at end of file diff --git a/inst/extdata/pest_host_table_singlehost025.csv b/inst/extdata/pest_host_table_singlehost025.csv new file mode 100644 index 00000000..f76d0695 --- /dev/null +++ b/inst/extdata/pest_host_table_singlehost025.csv @@ -0,0 +1,2 @@ +host,susceptibility,mortality_rate,mortality_time_lag +oak,0.7,0.25,1 \ No newline at end of file diff --git a/inst/extdata/pest_host_table_singlehost025tl3.csv b/inst/extdata/pest_host_table_singlehost025tl3.csv new file mode 100644 index 00000000..1361dfa8 --- /dev/null +++ b/inst/extdata/pest_host_table_singlehost025tl3.csv @@ -0,0 +1,2 @@ +host,susceptibility,mortality_rate,mortality_time_lag +oak,0.7,0.25,3 \ No newline at end of file From 211f2fdae2c76aac25803d470b5ff8d7553ed5b5 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 16 Jan 2024 10:49:29 -0500 Subject: [PATCH 37/68] fix exposed issue --- R/helpers.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/helpers.R b/R/helpers.R index c1779182..55425d40 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -311,7 +311,7 @@ host_pool_setup <- function(config) { exposed2 <- matrix_norm_distribution(config$host_pool_exposed_means[[i]], config$host_pool_exposed_sds[[i]]) } - exposed <- host_pool[[i]]$exposed + exposed <- host_pool$exposed exposed[[config$latency_period + 1]] <- exposed2 host_pool$infected <- infected host_pool$exposed <- exposed @@ -330,6 +330,7 @@ host_pool_setup <- function(config) { susceptible <- host_pool$total_host - host_pool$infected - host_pool$total_exposed susceptible[susceptible < 0] <- 0 + host_pool$susceptible <- susceptible if (config$mortality_on) { mortality_tracker <- host_pool$mortality_tracker From 04cb998db7afaa8ea5b7a93686e841cf37b0c9ba Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 16 Jan 2024 10:49:39 -0500 Subject: [PATCH 38/68] update tests --- tests/testthat/test-pops.r | 558 ++++++++++++++++++++++++++----------- 1 file changed, 401 insertions(+), 157 deletions(-) diff --git a/tests/testthat/test-pops.r b/tests/testthat/test-pops.r index 8d2a5814..f4ffb59b 100644 --- a/tests/testthat/test-pops.r +++ b/tests/testthat/test-pops.r @@ -1128,6 +1128,7 @@ test_that( "Infected results returns less infection after survival rates than before", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") survival_rates_file <- @@ -1199,6 +1200,7 @@ test_that("Infected and Susceptible results return all 0's if treatments file is system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1246,7 +1248,7 @@ test_that("Infected and Susceptible results return all 0's if treatments file is end_date = end_date) expect_equal(data$host_pools[[1]]$infected[[1]], matrix(0, ncol = 2, nrow = 2)) - expect_equal(data$susceptible[[1]], matrix(0, ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$susceptible[[1]], matrix(0, ncol = 2, nrow = 2)) treatments_file <- system.file("extdata", "simple2x2", "treatmentshalf.tif", package = "PoPS") @@ -1267,7 +1269,7 @@ test_that("Infected and Susceptible results return all 0's if treatments file is end_date = end_date) expect_equal(data$host_pools[[1]]$infected[[1]], matrix(c(2, 0, 0, 0), ncol = 2, nrow = 2)) - expect_equal(data$susceptible[[1]], matrix(c(5, 3, 7, 7), ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$susceptible[[1]], matrix(c(5, 3, 7, 7), ncol = 2, nrow = 2)) data <- pops(infected_file_list = infected_file_list, @@ -1285,13 +1287,14 @@ test_that("Infected and Susceptible results return all 0's if treatments file is end_date = end_date) expect_equal(data$host_pools[[1]]$infected[[1]], matrix(c(0, 0, 0, 0), ncol = 2, nrow = 2)) - expect_equal(data$susceptible[[1]], matrix(c(5, 3, 7, 7), ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$susceptible[[1]], matrix(c(5, 3, 7, 7), ncol = 2, nrow = 2)) }) test_that("Infected results are greater than initial infected", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1300,12 +1303,16 @@ test_that("Infected results are greater than initial infected", { end_date <- "2010-12-31" parameter_means <- c(1, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") expect_equal(all(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table )$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_equal(all( @@ -1314,15 +1321,17 @@ test_that("Infected results are greater than initial infected", { "total_plants_host_greater_than_infected.tif", package = "PoPS"), total_populations_file = total_populations_file, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix)$host_pools[[1]]$infected[[1]] >= + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table)$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) }) - test_that("All kernel types lead to spread", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1332,12 +1341,16 @@ test_that("All kernel types lead to spread", { time_step <- "month" parameter_means <- c(0.4, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, host_file_list = host_file_list, total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, time_step = time_step, natural_kernel_type = "exponential") @@ -1351,6 +1364,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, natural_kernel_type = "cauchy") infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= @@ -1362,6 +1377,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, natural_kernel_type = "uniform") infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= @@ -1373,6 +1390,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, natural_kernel_type = "hyperbolic secant") infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= @@ -1384,6 +1403,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, natural_kernel_type = "weibull") infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= @@ -1395,6 +1416,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, natural_kernel_type = "logistic") infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= @@ -1406,6 +1429,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, natural_kernel_type = "gamma") infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= @@ -1420,6 +1445,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, natural_kernel_type = "power law") infecteds <- data$host_pools[[1]]$infected[[1]] expect_equal(all(infecteds >= @@ -1436,6 +1463,8 @@ test_that("All kernel types lead to spread", { # total_populations_file = total_populations_file, # parameter_means = parameter_means, # parameter_cov_matrix = parameter_cov_matrix, + # pest_host_table = pest_host_table, + # competency_table = competency_table, # natural_kernel_type = "exponential-power") # infecteds <- data$host_pools[[1]]$infected[[1]] # expect_equal(all(infecteds >= @@ -1449,6 +1478,8 @@ test_that("All kernel types lead to spread", { # total_populations_file = total_populations_file, # parameter_means = parameter_means, # parameter_cov_matrix = parameter_cov_matrix, + # pest_host_table = pest_host_table, + # competency_table = competency_table, # natural_kernel_type = "log normal") # infecteds <- data$host_pools[[1]]$infected[[1]] # expect_equal(all(infecteds >= @@ -1462,6 +1493,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "exponential") expect_equal(all(data$host_pools[[1]]$infected[[1]] >= @@ -1472,6 +1505,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "cauchy") expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) @@ -1481,6 +1516,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "uniform") expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) @@ -1490,6 +1527,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "hyperbolic secant") expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) @@ -1499,6 +1538,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "logistic") expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) @@ -1508,6 +1549,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "weibull") expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) @@ -1517,6 +1560,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "power law") expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) @@ -1526,6 +1571,8 @@ test_that("All kernel types lead to spread", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "gamma") expect_equal(all(data$host_pools[[1]]$infected[[1]] >= terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) @@ -1536,6 +1583,8 @@ test_that("All kernel types lead to spread", { # total_populations_file = total_populations_file, # parameter_means = parameter_means, # parameter_cov_matrix = parameter_cov_matrix, + # pest_host_table = pest_host_table, + # competency_table = competency_table, # anthropogenic_kernel_type = "exponential-power") # expect_equal(all(data$host_pools[[1]]$infected[[1]] >= # terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), @@ -1549,6 +1598,8 @@ test_that("All kernel types lead to spread", { # total_populations_file = total_populations_file, # parameter_means = parameter_means, # parameter_cov_matrix = parameter_cov_matrix, + # pest_host_table = pest_host_table, + # competency_table = competency_table, # anthropogenic_kernel_type = "log normal") # expect_equal(all(data$host_pools[[1]]$infected[[1]] >= # terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), @@ -1559,6 +1610,7 @@ test_that("All kernel types lead to spread", { test_that("Susceptibles are never negative", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1567,19 +1619,23 @@ test_that("Susceptibles are never negative", { end_date <- "2010-12-31" parameter_means <- c(0.4, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, host_file_list = host_file_list, total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, random_seed = 42, start_date = start_date, end_date = end_date) - expect_equal(all(data$susceptible[[1]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) - expect_equal(all(data$susceptible[[2]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) - expect_equal(all(data$susceptible[[3]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) + expect_equal(all(data$host_pools[[1]]$susceptible[[1]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) + expect_equal(all(data$host_pools[[1]]$susceptible[[2]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) + expect_equal(all(data$host_pools[[1]]$susceptible[[3]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) parameter_means <- c(0.5, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) @@ -1590,19 +1646,22 @@ test_that("Susceptibles are never negative", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, random_seed = 42, start_date = start_date, end_date = end_date) - expect_equal(all(data$susceptible[[1]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) - expect_equal(all(data$susceptible[[2]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) - expect_equal(all(data$susceptible[[3]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) + expect_equal(all(data$host_pools[[1]]$susceptible[[1]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) + expect_equal(all(data$host_pools[[1]]$susceptible[[2]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) + expect_equal(all(data$host_pools[[1]]$susceptible[[3]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) }) test_that("SEI model works as intended", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1616,6 +1675,8 @@ test_that("SEI model works as intended", { treatment_dates <- "2008-02-25" parameter_means <- c(0.4, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -1623,6 +1684,8 @@ test_that("SEI model works as intended", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, random_seed = 42, start_date = start_date, end_date = end_date, @@ -1638,6 +1701,8 @@ test_that("SEI model works as intended", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, random_seed = 42, start_date = start_date, end_date = end_date, @@ -1684,9 +1749,9 @@ test_that("SEI model works as intended", { expect_equal(all(data2$exposed[[12]][[2]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) expect_equal(all(data2$exposed[[12]][[3]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) - expect_equal(all(data$susceptible[[1]] <= data2$susceptible[[1]]), TRUE) - expect_equal(all(data$susceptible[[2]] <= data2$susceptible[[1]]), TRUE) - expect_equal(all(data$susceptible[[3]] <= data2$susceptible[[1]]), TRUE) + expect_equal(all(data$host_pools[[1]]$susceptible[[1]] <= data2$host_pools[[1]]$susceptible[[1]]), TRUE) + expect_equal(all(data$host_pools[[1]]$susceptible[[2]] <= data2$host_pools[[1]]$susceptible[[1]]), TRUE) + expect_equal(all(data$host_pools[[1]]$susceptible[[3]] <= data2$host_pools[[1]]$susceptible[[1]]), TRUE) expect_equal(all(data$host_pools[[1]]$infected[[1]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) expect_equal(all(data$infected[[2]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) @@ -1701,6 +1766,8 @@ test_that("SEI model works as intended", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, random_seed = 42, start_date = start_date, end_date = end_date, @@ -1712,9 +1779,9 @@ test_that("SEI model works as intended", { start_exposed = start_exposed, exposed_file_list = exposed_file_list) - expect_equal(all(data3$susceptible[[1]] <= data2$susceptible[[1]]), TRUE) - expect_equal(all(data3$susceptible[[2]] <= data2$susceptible[[1]]), TRUE) - expect_equal(all(data3$susceptible[[3]] <= data2$susceptible[[1]]), TRUE) + expect_equal(all(data3$host_pools[[1]]$susceptible[[1]] <= data2$host_pools[[1]]$susceptible[[1]]), TRUE) + expect_equal(all(data3$host_pools[[1]]$susceptible[[2]] <= data2$host_pools[[1]]$susceptible[[1]]), TRUE) + expect_equal(all(data3$host_pools[[1]]$susceptible[[3]] <= data2$host_pools[[1]]$susceptible[[1]]), TRUE) expect_equal(all(data3$host_pools[[1]]$infected[[1]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) expect_equal(all(data3$infected[[2]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) @@ -1725,6 +1792,7 @@ test_that("SEI model works as intended", { test_that("Infected results with weather are less than those without weather", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1734,6 +1802,8 @@ test_that("Infected results with weather are less than those without weather", { parameter_means <- c(0.4, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) coefficient_sd_file <- system.file("extdata", "simple2x2", "coefficient_sd.tif", package = "PoPS") + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -1741,7 +1811,9 @@ test_that("Infected results with weather are less than those without weather", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, - random_seed = 42, + pest_host_table = pest_host_table, + competency_table = competency_table, + random_seed = 44, start_date = start_date, end_date = end_date) @@ -1753,7 +1825,9 @@ test_that("Infected results with weather are less than those without weather", { temperature_coefficient_file = coefficient_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, - random_seed = 42, + pest_host_table = pest_host_table, + competency_table = competency_table, + random_seed = 44, start_date = start_date, end_date = end_date) @@ -1765,7 +1839,9 @@ test_that("Infected results with weather are less than those without weather", { precipitation_coefficient_file = coefficient_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, - random_seed = 42, + pest_host_table = pest_host_table, + competency_table = competency_table, + random_seed = 44, start_date = start_date, end_date = end_date) @@ -1779,7 +1855,9 @@ test_that("Infected results with weather are less than those without weather", { precipitation_coefficient_file = coefficient_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, - random_seed = 42, + pest_host_table = pest_host_table, + competency_table = competency_table, + random_seed = 44, start_date = start_date, end_date = end_date) @@ -1791,13 +1869,14 @@ test_that("Infected results with weather are less than those without weather", { temperature_coefficient_file = coefficient_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, - random_seed = 42, + pest_host_table = pest_host_table, + competency_table = competency_table, + random_seed = 44, start_date = start_date, end_date = end_date, weather_type = "probabilistic", temperature_coefficient_sd_file = coefficient_sd_file) - data_precip_wsd <- pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -1806,7 +1885,9 @@ test_that("Infected results with weather are less than those without weather", { precipitation_coefficient_file = coefficient_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, - random_seed = 42, + pest_host_table = pest_host_table, + competency_table = competency_table, + random_seed = 44, start_date = start_date, end_date = end_date, weather_type = "probabilistic", @@ -1822,7 +1903,9 @@ test_that("Infected results with weather are less than those without weather", { precipitation_coefficient_file = coefficient_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, - random_seed = 42, + pest_host_table = pest_host_table, + competency_table = competency_table, + random_seed = 44, start_date = start_date, end_date = end_date, weather_type = "probabilistic", @@ -1830,34 +1913,35 @@ test_that("Infected results with weather are less than those without weather", { precipitation_coefficient_sd_file = coefficient_sd_file) expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_temp$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data$infected[[2]]), sum(data_temp$infected[[2]])) - expect_gte(sum(data$infected[[3]]), sum(data_temp$infected[[3]])) + expect_gte(sum(data$host_pools[[1]]$infected[[2]]), sum(data_temp$host_pools[[1]]$infected[[2]])) + expect_gte(sum(data$host_pools[[1]]$infected[[3]]), sum(data_temp$host_pools[[1]]$infected[[3]])) expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_precip$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data$infected[[2]]), sum(data_precip$infected[[2]])) - expect_gte(sum(data$infected[[3]]), sum(data_precip$infected[[3]])) + expect_gte(sum(data$host_pools[[1]]$infected[[2]]), sum(data_precip$host_pools[[1]]$infected[[2]])) + expect_gte(sum(data$host_pools[[1]]$infected[[3]]), sum(data_precip$host_pools[[1]]$infected[[3]])) expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_weather$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data$infected[[2]]), sum(data_weather$infected[[2]])) - expect_gte(sum(data$infected[[3]]), sum(data_weather$infected[[3]])) + expect_gte(sum(data$host_pools[[1]]$infected[[2]]), sum(data_weather$host_pools[[1]]$infected[[2]])) + expect_gte(sum(data$host_pools[[1]]$infected[[3]]), sum(data_weather$host_pools[[1]]$infected[[3]])) - expect_gte(sum(data$infected[[2]]), sum(data_temp_wsd$infected[[2]])) - expect_gte(sum(data$infected[[3]]), sum(data_temp_wsd$infected[[3]])) + expect_gte(sum(data$host_pools[[1]]$infected[[2]]), sum(data_temp_wsd$host_pools[[1]]$infected[[2]])) + expect_gte(sum(data$host_pools[[1]]$infected[[3]]), sum(data_temp_wsd$host_pools[[1]]$infected[[3]])) expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_temp_wsd$host_pools[[1]]$infected[[1]])) expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_precip_wsd$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data$infected[[2]]), sum(data_precip_wsd$infected[[2]])) - expect_gte(sum(data$infected[[3]]), sum(data_precip_wsd$infected[[3]])) + expect_gte(sum(data$host_pools[[1]]$infected[[2]]), sum(data_precip_wsd$host_pools[[1]]$infected[[2]])) + expect_gte(sum(data$host_pools[[1]]$infected[[3]]), sum(data_precip_wsd$host_pools[[1]]$infected[[3]])) expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_weather_wsd$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data$infected[[2]]), sum(data_weather_wsd$infected[[2]])) - expect_gte(sum(data$infected[[3]]), sum(data_weather_wsd$infected[[3]])) + expect_gte(sum(data$host_pools[[1]]$infected[[2]]), sum(data_weather_wsd$host_pools[[1]]$infected[[2]])) + expect_gte(sum(data$host_pools[[1]]$infected[[3]]), sum(data_weather_wsd$host_pools[[1]]$infected[[3]])) }) test_that( "Infected results are greater with same parameters for weekly spread vs. monthly", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1866,6 +1950,8 @@ test_that( end_date <- "2010-12-31" parameter_means <- c(0.2, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data_week <- pops(infected_file_list = infected_file_list, @@ -1873,6 +1959,8 @@ test_that( total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, time_step = "week", random_seed = 42, start_date = start_date, @@ -1883,13 +1971,15 @@ test_that( total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, time_step = "month", random_seed = 42, start_date = start_date, end_date = end_date) expect_equal(all(data_week$host_pools[[1]]$infected[[1]] >= data_month$host_pools[[1]]$infected[[1]]), TRUE) - expect_equal(all(data_week$infected[[2]] >= data_month$infected[[2]]), TRUE) + expect_equal(all(data_week$host_pools[[1]]$infected[[2]] >= data_month$host_pools[[1]]$infected[[2]]), TRUE) }) @@ -1899,6 +1989,7 @@ test_that("Infected results are greater with same parameters for daily spread vs system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1908,6 +1999,8 @@ test_that("Infected results are greater with same parameters for daily spread vs end_date <- "2010-12-31" parameter_means <- c(0.1, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data_day <- pops(infected_file_list = infected_file_list, @@ -1915,6 +2008,8 @@ test_that("Infected results are greater with same parameters for daily spread vs total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, time_step = "day", random_seed = 42) data_week <- @@ -1923,6 +2018,8 @@ test_that("Infected results are greater with same parameters for daily spread vs total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, time_step = "week", random_seed = 42, start_date = start_date, @@ -1933,6 +2030,8 @@ test_that("Infected results are greater with same parameters for daily spread vs total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, time_step = "month", random_seed = 42, start_date = start_date, @@ -1947,12 +2046,15 @@ test_that( "Infected results are greater without treatment than with treatment", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") treatments_file <- system.file("extdata", "simple2x2", "treatments_1_1.tif", package = "PoPS") treatment_dates <- c("2008-03-05") start_date <- "2008-01-01" end_date <- "2009-12-31" parameter_means <- c(0.8, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -1960,6 +2062,8 @@ test_that( total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, random_seed = 44, start_date = start_date, end_date = end_date) @@ -1972,21 +2076,26 @@ test_that( treatments_file = treatments_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, random_seed = 44, start_date = start_date, end_date = end_date) expect_equal(all(data$host_pools[[1]]$infected[[1]] >= data_treat$host_pools[[1]]$infected[[1]]), TRUE) - expect_equal(all(data$infected[[2]] >= data_treat$infected[[2]]), TRUE) + expect_equal(all(data$host_pools[[1]]$infected[[2]] >= data_treat$host_pools[[1]]$infected[[2]]), TRUE) }) test_that("Infected results are greater with higher reproductive rate", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2010-12-31" parameter_means <- c(1.0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data_1 <- pops(infected_file_list = infected_file_list, @@ -1994,6 +2103,8 @@ test_that("Infected results are greater with higher reproductive rate", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, time_step = "month", random_seed = 42, start_date = start_date, @@ -2005,6 +2116,8 @@ test_that("Infected results are greater with higher reproductive rate", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, time_step = "month", random_seed = 42, start_date = start_date, @@ -2016,6 +2129,8 @@ test_that("Infected results are greater with higher reproductive rate", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, time_step = "month", random_seed = 42, start_date = start_date, @@ -2027,6 +2142,8 @@ test_that("Infected results are greater with higher reproductive rate", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, time_step = "month", random_seed = 42, start_date = start_date, @@ -2038,6 +2155,8 @@ test_that("Infected results are greater with higher reproductive rate", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, time_step = "month", random_seed = 42, start_date = start_date, @@ -2053,18 +2172,18 @@ test_that("Infected results are greater with higher reproductive rate", { expect_gte(sum(data_075$host_pools[[1]]$infected[[1]]), sum(data_010$host_pools[[1]]$infected[[1]])) expect_gte(sum(data_050$host_pools[[1]]$infected[[1]]), sum(data_025$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data_050$infected[[2]]), sum(data_025$infected[[2]])) + expect_gte(sum(data_050$host_pools[[1]]$infected[[2]]), sum(data_025$host_pools[[1]]$infected[[2]])) expect_gte(sum(data_050$host_pools[[1]]$infected[[1]]), sum(data_010$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data_050$infected[[2]]), sum(data_010$infected[[2]])) + expect_gte(sum(data_050$host_pools[[1]]$infected[[2]]), sum(data_010$host_pools[[1]]$infected[[2]])) expect_gte(sum(data_025$host_pools[[1]]$infected[[1]]), sum(data_010$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data_025$infected[[2]]), sum(data_010$infected[[2]])) - + expect_gte(sum(data_025$host_pools[[1]]$infected[[2]]), sum(data_010$host_pools[[1]]$infected[[2]])) }) test_that("Treatments apply no matter what time step", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -2075,6 +2194,8 @@ test_that("Treatments apply no matter what time step", { parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) dates <- seq.Date(as.Date(start_date), as.Date(end_date), by = "days") + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") for (i in seq_len(length(dates))) { data <- pops(infected_file_list = infected_file_list, @@ -2085,16 +2206,19 @@ test_that("Treatments apply no matter what time step", { treatments_file = treatments_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) expect_equal(data$host_pools[[1]]$infected[[1]], matrix(0, ncol = 2, nrow = 2)) - expect_equal(data$susceptible[[1]], matrix(0, ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$susceptible[[1]], matrix(0, ncol = 2, nrow = 2)) } }) test_that("Pesticide treatments apply no matter what time step", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -2107,6 +2231,8 @@ test_that("Pesticide treatments apply no matter what time step", { parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) dates <- seq.Date(as.Date(start_date), as.Date("2009-06-30"), by = "days") + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") for (i in seq_len(length(dates))) { data <- @@ -2118,12 +2244,14 @@ test_that("Pesticide treatments apply no matter what time step", { treatments_file = treatments_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, pesticide_duration = pesticide_duration, pesticide_efficacy = pesticide_efficacy) expect_equal(data$host_pools[[1]]$infected[[1]], matrix(0, ncol = 2, nrow = 2)) - expect_equal(data$susceptible[[1]], + expect_equal(data$host_pools[[1]]$susceptible[[1]], terra::as.matrix(terra::rast(host_file_list), wide = TRUE)) } @@ -2140,12 +2268,14 @@ test_that("Pesticide treatments apply no matter what time step", { treatments_file = treatments_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, pesticide_duration = pesticide_duration, pesticide_efficacy = pesticide_efficacy) expect_equal(data$host_pools[[1]]$infected[[1]], matrix(c(3, 0, 0, 0), ncol = 2, nrow = 2)) - expect_equal(data$susceptible[[1]], matrix(c(12, 6, 14, 15), ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$susceptible[[1]], matrix(c(12, 6, 14, 15), ncol = 2, nrow = 2)) } }) @@ -2156,11 +2286,14 @@ test_that("Changing the output frequency returns the correct number of outputs a system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2009-01-01" end_date <- "2009-12-31" treatment_dates <- c(start_date) parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(output_frequency = "year", @@ -2171,9 +2304,11 @@ test_that("Changing the output frequency returns the correct number of outputs a total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 1) + expect_equal(length(data$host_pools[[1]]$infected), 1) data <- pops(output_frequency = "year", @@ -2184,9 +2319,11 @@ test_that("Changing the output frequency returns the correct number of outputs a total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 1) + expect_equal(length(data$host_pools[[1]]$infected), 1) data <- pops(output_frequency = "year", @@ -2197,9 +2334,11 @@ test_that("Changing the output frequency returns the correct number of outputs a total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 1) + expect_equal(length(data$host_pools[[1]]$infected), 1) data <- pops(output_frequency = "month", @@ -2210,9 +2349,11 @@ test_that("Changing the output frequency returns the correct number of outputs a total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 12) + expect_equal(length(data$host_pools[[1]]$infected), 12) data <- pops(output_frequency = "month", @@ -2223,9 +2364,11 @@ test_that("Changing the output frequency returns the correct number of outputs a total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 12) + expect_equal(length(data$host_pools[[1]]$infected), 12) data <- pops(output_frequency = "week", @@ -2236,9 +2379,11 @@ test_that("Changing the output frequency returns the correct number of outputs a total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 52) + expect_equal(length(data$host_pools[[1]]$infected), 52) data <- pops(output_frequency = "week", @@ -2249,9 +2394,11 @@ test_that("Changing the output frequency returns the correct number of outputs a total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 52) + expect_equal(length(data$host_pools[[1]]$infected), 52) expect_error(pops(output_frequency = "day", time_step = "week", @@ -2261,6 +2408,8 @@ test_that("Changing the output frequency returns the correct number of outputs a total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date), output_frequency_error) @@ -2272,6 +2421,8 @@ test_that("Changing the output frequency returns the correct number of outputs a total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date), output_frequency_error) @@ -2283,6 +2434,8 @@ test_that("Changing the output frequency returns the correct number of outputs a total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date), output_frequency_error) @@ -2294,9 +2447,11 @@ test_that("Changing the output frequency returns the correct number of outputs a total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 364) + expect_equal(length(data$host_pools[[1]]$infected), 364) data <- pops(output_frequency = "every_n_steps", output_frequency_n = 5, @@ -2307,20 +2462,25 @@ test_that("Changing the output frequency returns the correct number of outputs a total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 72) + expect_equal(length(data$host_pools[[1]]$infected), 72) }) test_that( "Outputs occur with non-full year date range for all time step output frequency combinations", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2009-05-01" end_date <- "2009-10-29" treatment_dates <- start_date parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(output_frequency = "year", time_step = "month", @@ -2330,9 +2490,11 @@ test_that( total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 1) + expect_equal(length(data$host_pools[[1]]$infected), 1) data <- pops(output_frequency = "year", time_step = "week", @@ -2342,9 +2504,11 @@ test_that( total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 1) + expect_equal(length(data$host_pools[[1]]$infected), 1) data <- pops(output_frequency = "year", time_step = "day", @@ -2354,9 +2518,11 @@ test_that( total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 1) + expect_equal(length(data$host_pools[[1]]$infected), 1) data <- pops(output_frequency = "month", time_step = "week", @@ -2366,9 +2532,11 @@ test_that( total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 5) + expect_equal(length(data$host_pools[[1]]$infected), 5) data <- pops(output_frequency = "month", time_step = "day", @@ -2378,9 +2546,11 @@ test_that( total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 5) + expect_equal(length(data$host_pools[[1]]$infected), 5) data <- pops(output_frequency = "week", time_step = "week", @@ -2390,9 +2560,11 @@ test_that( total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 26) + expect_equal(length(data$host_pools[[1]]$infected), 26) data <- pops(output_frequency = "week", time_step = "day", @@ -2402,9 +2574,11 @@ test_that( total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 26) + expect_equal(length(data$host_pools[[1]]$infected), 26) data <- pops(output_frequency = "day" @@ -2415,9 +2589,11 @@ test_that( total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 182) + expect_equal(length(data$host_pools[[1]]$infected), 182) data <- pops(output_frequency = "time_step", @@ -2428,15 +2604,18 @@ test_that( total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date) - expect_equal(length(data$infected), 182) + expect_equal(length(data$host_pools[[1]]$infected), 182) }) test_that("Quarantine and spread rates work at all timings", { infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2009-01-01" end_date <- "2009-12-31" treatment_dates <- start_date @@ -2444,6 +2623,8 @@ test_that("Quarantine and spread rates work at all timings", { parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) quarantine_areas_file <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(output_frequency = "year", time_step = "month", @@ -2453,12 +2634,14 @@ test_that("Quarantine and spread rates work at all timings", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_quarantine = TRUE, use_spreadrates = TRUE, quarantine_areas_file = quarantine_areas_file) - expect_equal(length(data$infected), 1) + expect_equal(length(data$host_pools[[1]]$infected), 1) expect_equal(length(data$quarantine_escape), 1) expect_equal(length(data$quarantine_escape_distance), 1) expect_equal(length(data$quarantine_escape_directions), 1) @@ -2472,12 +2655,14 @@ test_that("Quarantine and spread rates work at all timings", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_quarantine = TRUE, use_spreadrates = TRUE, quarantine_areas_file = quarantine_areas_file) - expect_equal(length(data$infected), 1) + expect_equal(length(data$host_pools[[1]]$infected), 1) expect_equal(length(data$quarantine_escape), 1) expect_equal(length(data$quarantine_escape_distance), 1) expect_equal(length(data$quarantine_escape_directions), 1) @@ -2491,12 +2676,14 @@ test_that("Quarantine and spread rates work at all timings", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_quarantine = TRUE, use_spreadrates = TRUE, quarantine_areas_file = quarantine_areas_file) - expect_equal(length(data$infected), 1) + expect_equal(length(data$host_pools[[1]]$infected), 1) expect_equal(length(data$quarantine_escape), 1) expect_equal(length(data$quarantine_escape_distance), 1) expect_equal(length(data$quarantine_escape_directions), 1) @@ -2510,12 +2697,14 @@ test_that("Quarantine and spread rates work at all timings", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_quarantine = TRUE, use_spreadrates = TRUE, quarantine_areas_file = quarantine_areas_file) - expect_equal(length(data$infected), 12) + expect_equal(length(data$host_pools[[1]]$infected), 12) expect_equal(length(data$quarantine_escape), 12) expect_equal(length(data$quarantine_escape_distance), 12) expect_equal(length(data$quarantine_escape_directions), 12) @@ -2529,12 +2718,14 @@ test_that("Quarantine and spread rates work at all timings", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_quarantine = TRUE, use_spreadrates = TRUE, quarantine_areas_file = quarantine_areas_file) - expect_equal(length(data$infected), 12) + expect_equal(length(data$host_pools[[1]]$infected), 12) expect_equal(length(data$quarantine_escape), 12) expect_equal(length(data$quarantine_escape_distance), 12) expect_equal(length(data$quarantine_escape_directions), 12) @@ -2548,12 +2739,14 @@ test_that("Quarantine and spread rates work at all timings", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_quarantine = TRUE, use_spreadrates = TRUE, quarantine_areas_file = quarantine_areas_file) - expect_equal(length(data$infected), 52) + expect_equal(length(data$host_pools[[1]]$infected), 52) expect_equal(length(data$quarantine_escape), 52) expect_equal(length(data$quarantine_escape_distance), 52) expect_equal(length(data$quarantine_escape_directions), 52) @@ -2567,12 +2760,14 @@ test_that("Quarantine and spread rates work at all timings", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_quarantine = TRUE, use_spreadrates = TRUE, quarantine_areas_file = quarantine_areas_file) - expect_equal(length(data$infected), 52) + expect_equal(length(data$host_pools[[1]]$infected), 52) expect_equal(length(data$quarantine_escape), 52) expect_equal(length(data$quarantine_escape_distance), 52) expect_equal(length(data$quarantine_escape_directions), 52) @@ -2586,12 +2781,14 @@ test_that("Quarantine and spread rates work at all timings", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_quarantine = TRUE, use_spreadrates = TRUE, quarantine_areas_file = quarantine_areas_file, quarantine_directions = "N,E,S,W") - expect_equal(length(data$infected), 364) + expect_equal(length(data$host_pools[[1]]$infected), 364) expect_equal(length(data$quarantine_escape), 364) expect_equal(length(data$quarantine_escape_distance), 364) expect_equal(length(data$quarantine_escape_directions), 364) @@ -2605,29 +2802,33 @@ test_that("Quarantine and spread rates work at all timings", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_quarantine = TRUE, use_spreadrates = TRUE, quarantine_areas_file = quarantine_areas_file, quarantine_directions = "N") - expect_equal(length(data$infected), 364) + expect_equal(length(data$host_pools[[1]]$infected), 364) expect_equal(length(data$quarantine_escape), 364) expect_equal(length(data$quarantine_escape_distance), 364) expect_equal(length(data$quarantine_escape_directions), 364) expect_equal(length(data$rates), 364) }) - test_that("Mortality works as expected with multiple ", { infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2009-01-01" end_date <- "2009-12-31" treatment_dates <- start_date parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(output_frequency = "month", time_step = "month", @@ -2637,18 +2838,17 @@ test_that("Mortality works as expected with multiple ", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, mortality_frequency = "month", - mortality_frequency_n = 1, - mortality_rate = 0.50, - mortality_time_lag = 1, - mortality_on = TRUE) - - expect_equal(length(data$mortality), 12) - expect_equal(data$mortality[[1]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[3]], + mortality_frequency_n = 1) + + expect_equal(length(data$host_pools[[1]]$mortality), 12) + expect_equal(data$host_pools[[1]]$mortality[[1]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[3]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) data <- pops(output_frequency = "week", @@ -2659,20 +2859,19 @@ test_that("Mortality works as expected with multiple ", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, mortality_frequency = "month", - mortality_frequency_n = 1, - mortality_rate = 0.50, - mortality_time_lag = 1, - mortality_on = TRUE) - - expect_equal(length(data$mortality), 12) - expect_equal(data$mortality[[1]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[3]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + mortality_frequency_n = 1) + expect_equal(length(data$host_pools[[1]]$mortality), 12) + expect_equal(data$host_pools[[1]]$mortality[[1]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[3]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost025.csv", package = "PoPS") data <- pops(output_frequency = "week", time_step = "week", treatment_dates = start_date, @@ -2681,22 +2880,21 @@ test_that("Mortality works as expected with multiple ", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, mortality_frequency = "month", - mortality_frequency_n = 1, - mortality_rate = 0.250, - mortality_time_lag = 1, - mortality_on = TRUE) - - expect_equal(length(data$mortality), 12) - expect_equal(data$mortality[[1]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[3]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[4]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[5]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + mortality_frequency_n = 1) + expect_equal(length(data$host_pools[[1]]$mortality), 12) + expect_equal(data$host_pools[[1]]$mortality[[1]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[3]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[4]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[5]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost025tl3.csv", package = "PoPS") data <- pops(output_frequency = "week", time_step = "week", treatment_dates = start_date, @@ -2705,23 +2903,24 @@ test_that("Mortality works as expected with multiple ", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, mortality_frequency = "month", - mortality_frequency_n = 1, - mortality_rate = 0.250, - mortality_time_lag = 3, - mortality_on = TRUE) - - expect_equal(length(data$mortality), 12) - expect_equal(data$mortality[[1]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[3]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[4]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[5]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[6]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[7]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + mortality_frequency_n = 1) + expect_equal(length(data$host_pools[[1]]$mortality), 12) + expect_equal(data$host_pools[[1]]$mortality[[1]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[3]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[4]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[5]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[6]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[7]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + + + pest_host_table <- system.file("extdata", "pest_host_table_singlehost010tl1.csv", package = "PoPS") data <- pops(output_frequency = "week", time_step = "week", treatment_dates = start_date, @@ -2730,32 +2929,32 @@ test_that("Mortality works as expected with multiple ", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, mortality_frequency = "month", - mortality_frequency_n = 1, - mortality_rate = 0.10, - mortality_time_lag = 1, - mortality_on = TRUE) - - expect_equal(length(data$mortality), 12) - expect_equal(data$mortality[[1]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[3]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[4]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[5]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[6]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[7]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[8]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[9]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[10]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$mortality[[11]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + mortality_frequency_n = 1) + + expect_equal(length(data$host_pools[[1]]$mortality), 12) + expect_equal(data$host_pools[[1]]$mortality[[1]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[3]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[4]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[5]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[6]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[7]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[8]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[9]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[10]], matrix(0, ncol = 20, nrow = 20)) + expect_equal(data$host_pools[[1]]$mortality[[11]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) }) test_that("Movements works as expected", { infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2009-01-01" end_date <- "2009-12-31" treatment_dates <- start_date @@ -2763,6 +2962,9 @@ test_that("Movements works as expected", { parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) use_movements <- TRUE movements_file <- system.file("extdata", "simple20x20", "movements.tif", package = "PoPS") + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + expect_error(pops(output_frequency = "month", time_step = "month", treatment_dates = start_date, @@ -2771,6 +2973,8 @@ test_that("Movements works as expected", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_movements = use_movements, @@ -2787,24 +2991,26 @@ test_that("Movements works as expected", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_movements = use_movements, movements_file = movements_file, random_seed = 42) - expect_equal(length(data$infected), 12) + expect_equal(length(data$host_pools[[1]]$infected), 12) expect_equal(data$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) - expect_equal(data$infected[[2]], + expect_equal(data$host_pools[[1]]$infected[[2]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) - expect_equal(data$infected[[3]], + expect_equal(data$host_pools[[1]]$infected[[3]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) - expect_equal(data$infected[[4]], + expect_equal(data$host_pools[[1]]$infected[[4]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) infected_move <- matrix(0, ncol = 20, nrow = 20) infected_move[2, 1] <- 1 - expect_equal(data$infected[[5]], infected_move) + expect_equal(data$host_pools[[1]]$infected[[5]], infected_move) sus <- terra::rast(host_file_list) - terra::rast(infected_file_list) sus <- terra::as.matrix(sus, wide = TRUE) sus5 <- sus @@ -2813,12 +3019,12 @@ test_that("Movements works as expected", { sus6 <- sus5 sus6[1, 2] <- sus6[1, 2] - 50 sus6[2, 2] <- sus6[2, 2] + 50 - expect_equal(data$susceptible[[1]], sus) - expect_equal(data$susceptible[[2]], sus) - expect_equal(data$susceptible[[3]], sus) - expect_equal(data$susceptible[[4]], sus) - expect_equal(data$susceptible[[5]], sus5) - expect_equal(data$susceptible[[6]], sus6) + expect_equal(data$host_pools[[1]]$susceptible[[1]], sus) + expect_equal(data$host_pools[[1]]$susceptible[[2]], sus) + expect_equal(data$host_pools[[1]]$susceptible[[3]], sus) + expect_equal(data$host_pools[[1]]$susceptible[[4]], sus) + expect_equal(data$host_pools[[1]]$susceptible[[5]], sus5) + expect_equal(data$host_pools[[1]]$susceptible[[6]], sus6) data <- pops(output_frequency = "month", time_step = "month", @@ -2828,24 +3034,26 @@ test_that("Movements works as expected", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_movements = use_movements, movements_file = movements_file, random_seed = 45) - expect_equal(length(data$infected), 12) + expect_equal(length(data$host_pools[[1]]$infected), 12) expect_equal(data$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) - expect_equal(data$infected[[2]], + expect_equal(data$host_pools[[1]]$infected[[2]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) - expect_equal(data$infected[[3]], + expect_equal(data$host_pools[[1]]$infected[[3]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) - expect_equal(data$infected[[4]], + expect_equal(data$host_pools[[1]]$infected[[4]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) infected_move <- matrix(0, ncol = 20, nrow = 20) infected_move[2, 1] <- 1 - expect_equal(data$infected[[5]], infected_move) + expect_equal(data$host_pools[[1]]$infected[[5]], infected_move) sus <- terra::rast(host_file_list) - terra::rast(infected_file_list) sus <- terra::as.matrix(sus, wide = TRUE) sus5 <- sus @@ -2854,12 +3062,12 @@ test_that("Movements works as expected", { sus6 <- sus5 sus6[1, 2] <- sus6[1, 2] - 50 sus6[2, 2] <- sus6[2, 2] + 50 - expect_equal(data$susceptible[[1]], sus) - expect_equal(data$susceptible[[2]], sus) - expect_equal(data$susceptible[[3]], sus) - expect_equal(data$susceptible[[4]], sus) - expect_equal(data$susceptible[[5]], sus5) - expect_equal(data$susceptible[[6]], sus6) + expect_equal(data$host_pools[[1]]$susceptible[[1]], sus) + expect_equal(data$host_pools[[1]]$susceptible[[2]], sus) + expect_equal(data$host_pools[[1]]$susceptible[[3]], sus) + expect_equal(data$host_pools[[1]]$susceptible[[4]], sus) + expect_equal(data$host_pools[[1]]$susceptible[[5]], sus5) + expect_equal(data$host_pools[[1]]$susceptible[[6]], sus6) }) test_that( @@ -2867,10 +3075,13 @@ test_that( leaving the simulated area", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2008-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -2878,6 +3089,8 @@ test_that( total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_overpopulation_movements = TRUE, @@ -2895,10 +3108,13 @@ test_that( test_that("Deterministic dispersal works as expected", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2008-12-31" parameter_means <- c(2, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -2906,6 +3122,8 @@ test_that("Deterministic dispersal works as expected", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, generate_stochasticity = FALSE, @@ -2923,12 +3141,15 @@ test_that("Network dispersal works as expected", { infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") + total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2008-03-31" parameter_means <- c(2, 21, 1, 500, 0, 0, 100, 1000) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) network_filename <- system.file("extdata", "simple20x20", "segments.csv", package = "PoPS") anthropogenic_kernel_type <- "network" + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -2936,6 +3157,8 @@ test_that("Network dispersal works as expected", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, anthropogenic_kernel_type = anthropogenic_kernel_type, @@ -2960,6 +3183,8 @@ test_that("uncertainty propogation works as expected", { anthropogenic_kernel_type <- "cauchy" use_initial_condition_uncertainty <- TRUE use_host_uncertainty <- TRUE + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -2967,6 +3192,8 @@ test_that("uncertainty propogation works as expected", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, anthropogenic_kernel_type = anthropogenic_kernel_type, @@ -2997,6 +3224,8 @@ test_that("uncertainty propogation works as expected", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, anthropogenic_kernel_type = anthropogenic_kernel_type, @@ -3021,6 +3250,8 @@ test_that("uncertainty propogation works as expected", { anthropogenic_kernel_type <- "cauchy" use_initial_condition_uncertainty <- FALSE use_host_uncertainty <- TRUE + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -3028,6 +3259,8 @@ test_that("uncertainty propogation works as expected", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, anthropogenic_kernel_type = anthropogenic_kernel_type, @@ -3054,6 +3287,8 @@ test_that("multiple_random seeds works and returns expected results", { anthropogenic_kernel_type <- "cauchy" multiple_random_seeds <- TRUE file_random_seeds <- NULL + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -3061,6 +3296,8 @@ test_that("multiple_random seeds works and returns expected results", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, anthropogenic_kernel_type = anthropogenic_kernel_type, @@ -3081,6 +3318,8 @@ test_that("multiple_random seeds works and returns expected results", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, anthropogenic_kernel_type = anthropogenic_kernel_type, @@ -3109,7 +3348,8 @@ test_that("Using soils returns expected results", { dispersers_to_soils_percentage <- 0.05 coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") - + pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -3117,6 +3357,8 @@ test_that("Using soils returns expected results", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, temp = TRUE, @@ -3138,6 +3380,8 @@ test_that("Using soils returns expected results", { total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, temp = TRUE, From 630b839b50ed3a6ffca3ff32e6384dccb03d5e95 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 16 Jan 2024 10:50:50 -0500 Subject: [PATCH 39/68] fix mortality export in pops.cpp --- src/pops.cpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/pops.cpp b/src/pops.cpp index cd6e55b7..9a0f8432 100644 --- a/src/pops.cpp +++ b/src/pops.cpp @@ -401,7 +401,7 @@ List pops_model_cpp( if (config.use_mortality && config.mortality_schedule()[current_index]) { for (unsigned i = 0; i < host_pools.size(); i++) { - IntegerMatrix mortality = host_pools[i]["mortality"]; + IntegerMatrix mortality = input_host_pool.mortality[i]; output_host_pool_vector[i].mortality.push_back(Rcpp::clone(mortality)); } } From 02b2b405bd3e1aabc321933c8b46c3b762b24af1 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 16 Jan 2024 12:26:37 -0500 Subject: [PATCH 40/68] update validation to loop through and combine and compare infections for all hosts to infected locations. --- R/validate.R | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/R/validate.R b/R/validate.R index 1df9ecc9..674a15a3 100644 --- a/R/validate.R +++ b/R/validate.R @@ -223,7 +223,6 @@ validate <- function(infected_years_file, dir.exists(config$output_folder_path)) { write.csv(config$random_seeds, paste0(config$output_folder_path, "validation_random_seeds.csv"), row.names = FALSE) - } i <- NULL @@ -325,15 +324,20 @@ validate <- function(infected_years_file, all_disagreement <- foreach( - q = seq_len(length(data$infected)), .combine = rbind, + q = seq_len(length(data$host_pools[[1]]$infected)), .combine = rbind, .packages = c("terra", "PoPS") ) %do% { # need to assign reference, comparison, and mask in inner loop since - # terra objects are pointers and pointers using %dopar% + # terra objects are pointers comparison <- terra::rast(config$infected_file)[[1]] reference <- comparison mask <- comparison - terra::values(comparison) <- data$infected[[q]] + terra::values(comparison) <- 0 + infections <- comparison + for (p in seq_len(length(data$host_pools))) { + terra::values(infections) <- data$host_pools[[p]]$infected[[q]] + comparison <- comparison + infections + } terra::values(reference) <- config$infection_years2[[q]] terra::values(mask) <- config$mask_matrix ad <- From ef0672254446a7bd4ce520820d935b37d1418967 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 16 Jan 2024 12:26:51 -0500 Subject: [PATCH 41/68] update validation tests --- tests/testthat/test-validate.R | 119 ++++++++++++++++----------------- 1 file changed, 59 insertions(+), 60 deletions(-) diff --git a/tests/testthat/test-validate.R b/tests/testthat/test-validate.R index 4bb2e926..6c133012 100644 --- a/tests/testthat/test-validate.R +++ b/tests/testthat/test-validate.R @@ -1,30 +1,37 @@ context("test-validate") test_that("Model stops if files don't exist or aren't the correct extension", { - infected_file <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") infected_years_file <- system.file("extdata", "simple20x20", "infected_single.tif", package = "PoPS") - host_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") expect_error(validate(infected_years_file = infected_years_file, - infected_file = "", - host_file = host_file, - total_populations_file = host_file, + infected_file_list = "", + host_file_list = host_file_list, + total_populations_file = host_file_list, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), PoPS:::file_exists_error, fixed = TRUE) expect_error(validate(infected_years_file = infected_years_file, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, start_date = "2008-01-01", end_date = "2009-12-31", output_frequency = "year", parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), PoPS:::infection_years_length_error(1, 2), fixed = TRUE) }) @@ -35,9 +42,9 @@ test_that( system.file("extdata", "simple20x20", "infected_years.tif", package = "PoPS") parameter_means <- c(1.8, 16.4, 0.973, 7803, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - infected_file <- + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") temp <- FALSE @@ -55,9 +62,6 @@ test_that( temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -95,7 +99,7 @@ test_that( overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" write_outputs <- "all_simulations" output_folder_path <- tempdir() point_file <- "" @@ -126,8 +130,10 @@ test_that( number_of_cores, parameter_means, parameter_cov_matrix, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -148,9 +154,6 @@ test_that( temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -182,7 +185,7 @@ test_that( overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, write_outputs, output_folder_path, point_file, @@ -233,10 +236,13 @@ test_that( number_of_observations <- 68 parameter_means <- c(1.8, 16.4, 0.973, 7803, 0, 0, 0, 0) parameter_cov_matrix <- matrix(ncol = 8, nrow = 8, 0) + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") checks <- c(500, 60000, 900, 1000) - infected_file <- + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -255,9 +261,6 @@ test_that( temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -295,7 +298,7 @@ test_that( overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" write_outputs <- "None" output_folder_path <- "" point_file <- system.file("extdata", "simple20x20", "points.gpkg", package = "PoPS") @@ -326,8 +329,10 @@ test_that( number_of_cores, parameter_means, parameter_cov_matrix, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -348,9 +353,6 @@ test_that( temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -382,7 +384,7 @@ test_that( overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, write_outputs, output_folder_path, point_file, @@ -426,18 +428,20 @@ test_that( ) test_that( - "Validation has correctly formatted returns and runs with a - single output comparison with mask", { + "Validation has correctly formatted returns and runs with a single output comparison with mask", { skip_on_os("windows") infected_years_file <- system.file("extdata", "simple20x20", "infected_single.tif", package = "PoPS") number_of_observations <- 68 parameter_means <- c(1.8, 16.4, 0.973, 7803, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") checks <- c(500, 60000, 900, 1000) - infected_file <- + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -456,9 +460,6 @@ test_that( temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -496,7 +497,7 @@ test_that( overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" write_outputs <- "None" output_folder_path <- "" point_file <- "" @@ -527,8 +528,10 @@ test_that( number_of_cores, parameter_means, parameter_cov_matrix, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -549,9 +552,6 @@ test_that( temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -583,7 +583,7 @@ test_that( overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, write_outputs, output_folder_path, point_file, @@ -635,10 +635,13 @@ test_that( number_of_observations <- 68 parameter_means <- c(1.8, 16.4, 0.973, 7803, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") checks <- c(500, 60000, 900, 1000) - infected_file <- + infected_file_list <- system.file("extdata", "simple20x20", "infected_wsd.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host_w_sd2.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -657,9 +660,6 @@ test_that( temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -697,7 +697,7 @@ test_that( overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" write_outputs <- "None" output_folder_path <- "" point_file <- "" @@ -728,8 +728,10 @@ test_that( number_of_cores, parameter_means, parameter_cov_matrix, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -750,9 +752,6 @@ test_that( temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -784,7 +783,7 @@ test_that( overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, write_outputs, output_folder_path, point_file, From 91d8e71e348453df2ab763700c2926614b192e4a Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 17 Jan 2024 11:32:11 -0500 Subject: [PATCH 42/68] update validate and tests --- R/validate.R | 2 +- tests/testthat/test-validate.R | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/R/validate.R b/R/validate.R index 674a15a3..46bec0c5 100644 --- a/R/validate.R +++ b/R/validate.R @@ -329,7 +329,7 @@ validate <- function(infected_years_file, ) %do% { # need to assign reference, comparison, and mask in inner loop since # terra objects are pointers - comparison <- terra::rast(config$infected_file)[[1]] + comparison <- terra::rast(config$infected_file_list[[1]])[[1]] reference <- comparison mask <- comparison terra::values(comparison) <- 0 diff --git a/tests/testthat/test-validate.R b/tests/testthat/test-validate.R index 6c133012..51a55062 100644 --- a/tests/testthat/test-validate.R +++ b/tests/testthat/test-validate.R @@ -42,6 +42,9 @@ test_that( system.file("extdata", "simple20x20", "infected_years.tif", package = "PoPS") parameter_means <- c(1.8, 16.4, 0.973, 7803, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") From 7ffb604aed16e5cf37c877aa8db736396f0985b5 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Wed, 17 Jan 2024 12:17:15 -0500 Subject: [PATCH 43/68] update calibrate and tests --- R/calibrate.R | 50 +++-- tests/testthat/test-calibrate.R | 280 ++++++++++++++------------- tests/testthat/test-pops.r | 331 +++++++++++++++++++++----------- 3 files changed, 400 insertions(+), 261 deletions(-) diff --git a/R/calibrate.R b/R/calibrate.R index e4ef63be..9a543720 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -324,7 +324,7 @@ calibrate <- function(infected_years_file, config$random_seed <- sample(1:999999999999, 1, replace = FALSE) random_seeds <- create_random_seeds(1) config <- host_pool_setup(config) - config$competency_table_list <- competency_table_list_creator(competency_table) + config$competency_table_list <- competency_table_list_creator(config$competency_table) data <- pops_model( random_seed = config$random_seed, @@ -542,14 +542,20 @@ calibrate <- function(infected_years_file, # the simulation all_disagreement <- foreach::foreach( - q = seq_len(length(data$infected)), + q = seq_len(length(data$host_pools[[1]]$infected)), .combine = rbind, .packages = c("terra", "PoPS"), .final = colSums ) %do% { - comparison <- terra::rast(config$infected_file)[[1]] - reference <- terra::rast(config$infected_file)[[1]] - terra::values(comparison) <- data$infected[[q]] + comparison <- terra::rast(config$infected_file_list[[1]])[[1]] + reference <- comparison + mask <- comparison + terra::values(comparison) <- 0 + infections <- comparison + for (p in seq_len(length(data$host_pools))) { + terra::values(infections) <- data$host_pools[[p]]$infected[[q]] + comparison <- comparison + infections + } terra::values(reference) <- config$infection_years2[[q]] mask <- terra::rast(config$infected_file)[[1]] terra::values(mask) <- config$mask_matrix @@ -561,7 +567,7 @@ calibrate <- function(infected_years_file, } all_disagreement <- as.data.frame(t(all_disagreement)) - all_disagreement <- all_disagreement / length(data$infected) + all_disagreement <- all_disagreement / length(data$host_pools[[1]]$infected) config$quantity <- all_disagreement$quantity_disagreement config$allocation <- all_disagreement$allocation_disagreement config$configuration_dis <- all_disagreement$configuration_disagreement @@ -880,14 +886,20 @@ calibrate <- function(infected_years_file, all_disagreement <- foreach::foreach( - q = seq_len(length(data$infected)), + q = seq_len(length(data$host_pools[[1]]$infected)), .combine = rbind, .packages = c("terra", "PoPS"), .final = colSums ) %do% { - comparison <- terra::rast(config$infected_file)[[1]] - reference <- terra::rast(config$infected_file)[[1]] - terra::values(comparison) <- data$infected[[q]] + comparison <- terra::rast(config$infected_file_list[[1]])[[1]] + reference <- comparison + mask <- comparison + terra::values(comparison) <- 0 + infections <- comparison + for (p in seq_len(length(data$host_pools))) { + terra::values(infections) <- data$host_pools[[p]]$infected[[q]] + comparison <- comparison + infections + } terra::values(reference) <- config$infection_years2[[q]] mask <- terra::rast(config$infected_file)[[1]] terra::values(mask) <- config$mask_matrix @@ -899,7 +911,7 @@ calibrate <- function(infected_years_file, } all_disagreement <- as.data.frame(t(all_disagreement)) - all_disagreement <- all_disagreement / length(data$infected) + all_disagreement <- all_disagreement / length(data$host_pools[[1]]$infected) config$accuracy <- all_disagreement$accuracy config$precision <- all_disagreement$precision config$recall <- all_disagreement$recall @@ -1054,26 +1066,32 @@ calibrate <- function(infected_years_file, # set up comparison all_disagreement <- foreach::foreach( - q = seq_len(length(data$infected)), + q = seq_len(length(data$host_pools[[1]]$infected)), .combine = rbind, .packages = c("terra", "PoPS"), .final = colSums ) %do% { - comparison <- terra::rast(config$infected_file)[[1]] + comparison <- terra::rast(config$infected_file_list[[1]])[[1]] reference <- comparison mask <- comparison - terra::values(comparison) <- data$infected[[q]] + terra::values(comparison) <- 0 + infections <- comparison + for (p in seq_len(length(data$host_pools))) { + terra::values(infections) <- data$host_pools[[p]]$infected[[q]] + comparison <- comparison + infections + } terra::values(reference) <- config$infection_years2[[q]] + mask <- terra::rast(config$infected_file)[[1]] terra::values(mask) <- config$mask_matrix quantity_allocation_disagreement(reference, comparison, - use_configuration = FALSE, + use_configuration = config$use_configuration, mask = mask, use_distance = config$use_distance) } all_disagreement <- as.data.frame(t(all_disagreement)) - all_disagreement <- all_disagreement / length(data$infected) + all_disagreement <- all_disagreement / length(data$host_pools[[1]]$infected) proposed <- data.frame(all_disagreement[, c("quantity_disagreement", "allocation_disagreement", "configuration_disagreement", "accuracy", "precision", diff --git a/tests/testthat/test-calibrate.R b/tests/testthat/test-calibrate.R index a850c612..210bd06d 100644 --- a/tests/testthat/test-calibrate.R +++ b/tests/testthat/test-calibrate.R @@ -1,49 +1,59 @@ context("test-calibrate") test_that("Model stops if files don't exist or aren't the correct extension", { - infected_file <- + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") infected_years_file <- system.file("extdata", "simple20x20", "infected_years.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") prior_means <- c(0, 21, 1, 500, 0, 0) prior_cov_matrix <- matrix(0, nrow = 6, ncol = 6) number_of_observations <- 1 prior_number_of_observations <- 0 + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") expect_error(calibrate(infected_years_file = infected_years_file, number_of_observations = number_of_observations, prior_number_of_observations = prior_number_of_observations, prior_means = prior_means, prior_cov_matrix = prior_cov_matrix, - infected_file = "", - host_file = host_file, - total_populations_file = host_file), + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list = "", + host_file_list = host_file_list, + total_populations_file = host_file_list), file_exists_error) }) test_that("Model stops if success metric is incorrect", { - infected_file <- + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") infected_years_file <- system.file("extdata", "simple20x20", "infected_years.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") prior_means <- c(0, 21, 1, 500, 0, 0) prior_cov_matrix <- matrix(0, nrow = 6, ncol = 6) number_of_observations <- 1 prior_number_of_observations <- 0 success_metric <- "yeah" + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") expect_error(calibrate(infected_years_file = infected_years_file, number_of_observations = number_of_observations, prior_number_of_observations = prior_number_of_observations, prior_means = prior_means, prior_cov_matrix = prior_cov_matrix, - infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, success_metric = success_metric), success_metric_error) }) @@ -61,9 +71,13 @@ test_that("ABC calibration has correctly formatted returns with multiple output params_to_estimate <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) number_of_generations <- 2 generation_size <- 2 - infected_file <- + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -82,9 +96,6 @@ test_that("ABC calibration has correctly formatted returns with multiple output temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -123,7 +134,7 @@ test_that("ABC calibration has correctly formatted returns with multiple output overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" verbose <- TRUE write_outputs <- "summary_outputs" output_folder_path <- tempdir() @@ -142,7 +153,10 @@ test_that("ABC calibration has correctly formatted returns with multiple output dispersers_to_soils_percentage <- 0 quarantine_directions <- "" multiple_random_seeds <- FALSE - random_seeds <- NULL + file_random_seeds <- NULL + use_soils <- FALSE + soil_starting_pest_file <- "" + start_with_soil_populations <- FALSE data <- calibrate(infected_years_file, number_of_observations, @@ -152,8 +166,10 @@ test_that("ABC calibration has correctly formatted returns with multiple output params_to_estimate, number_of_generations, generation_size, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -174,9 +190,6 @@ test_that("ABC calibration has correctly formatted returns with multiple output temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -212,7 +225,7 @@ test_that("ABC calibration has correctly formatted returns with multiple output leaving_scale_coefficient, calibration_method, number_of_iterations, - exposed_file, + exposed_file_list, verbose, write_outputs, output_folder_path, @@ -227,7 +240,10 @@ test_that("ABC calibration has correctly formatted returns with multiple output dispersers_to_soils_percentage, quarantine_directions, multiple_random_seeds, - random_seeds) + file_random_seeds, + use_soils, + soil_starting_pest_file, + start_with_soil_populations) expect_length(data$posterior_means, 8) expect_vector(data$posterior_means, ptype = double(), size = 8) @@ -262,9 +278,13 @@ test_that("ABC calibration has correctly formatted returns and runs with a params_to_estimate <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) number_of_generations <- 2 generation_size <- 2 - infected_file <- + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -283,9 +303,6 @@ test_that("ABC calibration has correctly formatted returns and runs with a temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -326,7 +343,7 @@ test_that("ABC calibration has correctly formatted returns and runs with a overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" verbose <- TRUE write_outputs <- "None" output_folder_path <- "" @@ -347,8 +364,10 @@ test_that("ABC calibration has correctly formatted returns and runs with a params_to_estimate, number_of_generations, generation_size, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -369,9 +388,6 @@ test_that("ABC calibration has correctly formatted returns and runs with a temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -407,7 +423,7 @@ test_that("ABC calibration has correctly formatted returns and runs with a leaving_scale_coefficient, calibration_method, number_of_iterations, - exposed_file, + exposed_file_list, verbose, write_outputs, output_folder_path, @@ -448,9 +464,13 @@ test_that("ABC calibration has correctly formatted returns and runs with a params_to_estimate <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) number_of_generations <- 2 generation_size <- 2 - infected_file <- + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -469,9 +489,6 @@ test_that("ABC calibration has correctly formatted returns and runs with a temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -512,7 +529,7 @@ test_that("ABC calibration has correctly formatted returns and runs with a overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" verbose <- TRUE write_outputs <- "None" output_folder_path <- "" @@ -533,8 +550,10 @@ test_that("ABC calibration has correctly formatted returns and runs with a params_to_estimate, number_of_generations, generation_size, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -555,9 +574,6 @@ test_that("ABC calibration has correctly formatted returns and runs with a temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -593,7 +609,7 @@ test_that("ABC calibration has correctly formatted returns and runs with a leaving_scale_coefficient, calibration_method, number_of_iterations, - exposed_file, + exposed_file_list, verbose, write_outputs, output_folder_path, @@ -634,9 +650,13 @@ test_that("ABC calibration has correctly formatted returns and runs with a params_to_estimate <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) number_of_generations <- 2 generation_size <- 2 - infected_file <- + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -655,9 +675,6 @@ test_that("ABC calibration has correctly formatted returns and runs with a temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -698,7 +715,7 @@ test_that("ABC calibration has correctly formatted returns and runs with a overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" verbose <- TRUE write_outputs <- "None" output_folder_path <- "" @@ -719,8 +736,10 @@ test_that("ABC calibration has correctly formatted returns and runs with a params_to_estimate, number_of_generations, generation_size, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -741,9 +760,6 @@ test_that("ABC calibration has correctly formatted returns and runs with a temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -779,7 +795,7 @@ test_that("ABC calibration has correctly formatted returns and runs with a leaving_scale_coefficient, calibration_method, number_of_iterations, - exposed_file, + exposed_file_list, verbose, write_outputs, output_folder_path, @@ -821,9 +837,13 @@ test_that("ABC calibration has correctly formatted returns/runs with host and in params_to_estimate <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) number_of_generations <- 2 generation_size <- 2 - infected_file <- + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + infected_file_list <- system.file("extdata", "simple20x20", "infected_wsd.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host_w_sd2.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -842,9 +862,6 @@ test_that("ABC calibration has correctly formatted returns/runs with host and in temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -885,7 +902,7 @@ test_that("ABC calibration has correctly formatted returns/runs with host and in overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" verbose <- TRUE write_outputs <- "None" output_folder_path <- "" @@ -908,8 +925,10 @@ test_that("ABC calibration has correctly formatted returns/runs with host and in params_to_estimate, number_of_generations, generation_size, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -930,9 +949,6 @@ test_that("ABC calibration has correctly formatted returns/runs with host and in temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -968,7 +984,7 @@ test_that("ABC calibration has correctly formatted returns/runs with host and in leaving_scale_coefficient, calibration_method, number_of_iterations, - exposed_file, + exposed_file_list, verbose, write_outputs, output_folder_path, @@ -1012,9 +1028,13 @@ test_that("MCMC calibration has correctly formatted returns with multiple output params_to_estimate <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) number_of_generations <- 2 generation_size <- 2 - infected_file <- + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -1033,9 +1053,6 @@ test_that("MCMC calibration has correctly formatted returns with multiple output temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -1074,7 +1091,7 @@ test_that("MCMC calibration has correctly formatted returns with multiple output overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" verbose <- TRUE write_outputs <- "None" output_folder_path <- "" @@ -1094,8 +1111,10 @@ test_that("MCMC calibration has correctly formatted returns with multiple output params_to_estimate, number_of_generations, generation_size, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -1116,9 +1135,6 @@ test_that("MCMC calibration has correctly formatted returns with multiple output temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -1154,7 +1170,7 @@ test_that("MCMC calibration has correctly formatted returns with multiple output leaving_scale_coefficient, calibration_method, number_of_iterations, - exposed_file, + exposed_file_list, verbose, write_outputs, output_folder_path, @@ -1197,9 +1213,13 @@ test_that("MCMC calibration has correctly formatted returns with multiple output params_to_estimate <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) number_of_generations <- 2 generation_size <- 2 - infected_file <- + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -1218,9 +1238,6 @@ test_that("MCMC calibration has correctly formatted returns with multiple output temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -1259,7 +1276,7 @@ test_that("MCMC calibration has correctly formatted returns with multiple output overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" verbose <- TRUE write_outputs <- "None" output_folder_path <- "" @@ -1279,8 +1296,10 @@ test_that("MCMC calibration has correctly formatted returns with multiple output params_to_estimate, number_of_generations, generation_size, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -1301,9 +1320,6 @@ test_that("MCMC calibration has correctly formatted returns with multiple output temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -1339,7 +1355,7 @@ test_that("MCMC calibration has correctly formatted returns with multiple output leaving_scale_coefficient, calibration_method, number_of_iterations, - exposed_file, + exposed_file_list, verbose, write_outputs, output_folder_path, @@ -1382,9 +1398,13 @@ test_that("MCMC calibration has correctly formatted returns with multiple output params_to_estimate <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) number_of_generations <- 2 generation_size <- 2 - infected_file <- + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -1403,9 +1423,6 @@ test_that("MCMC calibration has correctly formatted returns with multiple output temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -1444,7 +1461,7 @@ test_that("MCMC calibration has correctly formatted returns with multiple output overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" verbose <- TRUE write_outputs <- "None" output_folder_path <- "" @@ -1464,8 +1481,10 @@ test_that("MCMC calibration has correctly formatted returns with multiple output params_to_estimate, number_of_generations, generation_size, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -1486,9 +1505,6 @@ test_that("MCMC calibration has correctly formatted returns with multiple output temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -1524,7 +1540,7 @@ test_that("MCMC calibration has correctly formatted returns with multiple output leaving_scale_coefficient, calibration_method, number_of_iterations, - exposed_file, + exposed_file_list, verbose, write_outputs, output_folder_path, @@ -1567,9 +1583,13 @@ test_that("MCMC calibration has correctly formatted returns with multiple output params_to_estimate <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) number_of_generations <- 2 generation_size <- 2 - infected_file <- + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -1588,9 +1608,6 @@ test_that("MCMC calibration has correctly formatted returns with multiple output temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -1629,7 +1646,7 @@ test_that("MCMC calibration has correctly formatted returns with multiple output overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" verbose <- TRUE write_outputs <- "None" output_folder_path <- "" @@ -1649,8 +1666,10 @@ test_that("MCMC calibration has correctly formatted returns with multiple output params_to_estimate, number_of_generations, generation_size, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -1671,9 +1690,6 @@ test_that("MCMC calibration has correctly formatted returns with multiple output temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -1709,7 +1725,7 @@ test_that("MCMC calibration has correctly formatted returns with multiple output leaving_scale_coefficient, calibration_method, number_of_iterations, - exposed_file, + exposed_file_list, verbose, write_outputs, output_folder_path, @@ -1752,9 +1768,13 @@ test_that("MCMC calibration has correctly formatted returns with host and initia params_to_estimate <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) number_of_generations <- 2 generation_size <- 2 - infected_file <- + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + infected_file_list <- system.file("extdata", "simple20x20", "infected_wsd.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host_w_sd2.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -1773,9 +1793,6 @@ test_that("MCMC calibration has correctly formatted returns with host and initia temperature_file <- "" lethal_temperature <- -30 lethal_temperature_month <- 1 - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 management <- FALSE @@ -1814,7 +1831,7 @@ test_that("MCMC calibration has correctly formatted returns with host and initia overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" verbose <- TRUE write_outputs <- "None" output_folder_path <- "" @@ -1836,8 +1853,10 @@ test_that("MCMC calibration has correctly formatted returns with host and initia params_to_estimate, number_of_generations, generation_size, - infected_file, - host_file, + pest_host_table = pest_host_table, + competency_table = competency_table, + infected_file_list, + host_file_list, total_populations_file, temp, temperature_coefficient_file, @@ -1858,9 +1877,6 @@ test_that("MCMC calibration has correctly formatted returns with host and initia temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -1896,7 +1912,7 @@ test_that("MCMC calibration has correctly formatted returns with host and initia leaving_scale_coefficient, calibration_method, number_of_iterations, - exposed_file, + exposed_file_list, verbose, write_outputs, output_folder_path, diff --git a/tests/testthat/test-pops.r b/tests/testthat/test-pops.r index f4ffb59b..031125f5 100644 --- a/tests/testthat/test-pops.r +++ b/tests/testthat/test-pops.r @@ -347,7 +347,8 @@ test_that("Model stops if kernel is of the wrong type and/or dimension", { test_that("Input raster resolutions, extents, and crs all match", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -832,7 +833,8 @@ test_that("Input raster resolutions, extents, and crs all match", { test_that("Infected results return initial infected if reproductive rate is set to 0", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -841,7 +843,8 @@ test_that("Infected results return initial infected if reproductive rate is set end_date <- "2010-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") expect_equal(pops(infected_file_list = infected_file_list, @@ -883,7 +886,8 @@ test_that("Infected results return initial infected if reproductive rate is set pest_host_table = pest_host_table, competency_table = competency_table, precip = TRUE, - precipitation_coefficient_file = coefficient_file)$host_pools[[1]]$infected[[1]], + precipitation_coefficient_file = + coefficient_file)$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -895,7 +899,8 @@ test_that("Infected results return initial infected if reproductive rate is set temp = TRUE, temperature_coefficient_file = coefficient_file, precip = TRUE, - precipitation_coefficient_file = coefficient_file)$host_pools[[1]]$infected[[1]], + precipitation_coefficient_file = + coefficient_file)$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -912,7 +917,8 @@ test_that("Infected results return initial infected if reproductive rate is set temp = TRUE, temperature_coefficient_file = coefficient_file, precip = TRUE, - precipitation_coefficient_file = coefficient_file)$host_pools[[1]]$infected[[1]], + precipitation_coefficient_file = + coefficient_file)$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( @@ -997,8 +1003,8 @@ test_that("Infected results return initial infected if reproductive rate is set temp = TRUE, time_step = "day", temperature_coefficient_file = - system.file("extdata", "simple2x2", - "temperature_coefficient_days.tif", package = "PoPS"))$host_pools[[1]]$infected[[1]], + system.file("extdata", "simple2x2", "temperature_coefficient_days.tif", + package = "PoPS"))$host_pools[[1]]$infected[[1]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal( pops(infected_file_list = infected_file_list, @@ -1061,7 +1067,8 @@ test_that( "Infected results returns all 0's if minimum temp drops below lethal temperature", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1070,7 +1077,8 @@ test_that( end_date <- "2010-12-31" parameter_means <- c(1, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") expect_equal(pops(infected_file_list = infected_file_list, @@ -1128,7 +1136,8 @@ test_that( "Infected results returns less infection after survival rates than before", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") survival_rates_file <- @@ -1137,7 +1146,8 @@ test_that( end_date <- "2010-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") reduced_inf <- matrix(0, ncol = 2, nrow = 2) @@ -1200,7 +1210,8 @@ test_that("Infected and Susceptible results return all 0's if treatments file is system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1212,8 +1223,10 @@ test_that("Infected and Susceptible results return all 0's if treatments file is package = "PoPS") parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") - competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -1268,8 +1281,10 @@ test_that("Infected and Susceptible results return all 0's if treatments file is start_date = start_date, end_date = end_date) - expect_equal(data$host_pools[[1]]$infected[[1]], matrix(c(2, 0, 0, 0), ncol = 2, nrow = 2)) - expect_equal(data$host_pools[[1]]$susceptible[[1]], matrix(c(5, 3, 7, 7), ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$infected[[1]], + matrix(c(2, 0, 0, 0), ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$susceptible[[1]], + matrix(c(5, 3, 7, 7), ncol = 2, nrow = 2)) data <- pops(infected_file_list = infected_file_list, @@ -1286,15 +1301,18 @@ test_that("Infected and Susceptible results return all 0's if treatments file is start_date = start_date, end_date = end_date) - expect_equal(data$host_pools[[1]]$infected[[1]], matrix(c(0, 0, 0, 0), ncol = 2, nrow = 2)) - expect_equal(data$host_pools[[1]]$susceptible[[1]], matrix(c(5, 3, 7, 7), ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$infected[[1]], + matrix(c(0, 0, 0, 0), ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$susceptible[[1]], + matrix(c(5, 3, 7, 7), ncol = 2, nrow = 2)) }) test_that("Infected results are greater than initial infected", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1303,7 +1321,8 @@ test_that("Infected results are greater than initial infected", { end_date <- "2010-12-31" parameter_means <- c(1, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") expect_equal(all(pops(infected_file_list = infected_file_list, @@ -1331,7 +1350,8 @@ test_that("Infected results are greater than initial infected", { test_that("All kernel types lead to spread", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1341,7 +1361,8 @@ test_that("All kernel types lead to spread", { time_step <- "month" parameter_means <- c(0.4, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -1610,7 +1631,8 @@ test_that("All kernel types lead to spread", { test_that("Susceptibles are never negative", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1619,7 +1641,8 @@ test_that("Susceptibles are never negative", { end_date <- "2010-12-31" parameter_means <- c(0.4, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -1661,7 +1684,8 @@ test_that("Susceptibles are never negative", { test_that("SEI model works as intended", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1675,7 +1699,8 @@ test_that("SEI model works as intended", { treatment_dates <- "2008-02-25" parameter_means <- c(0.4, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- @@ -1749,9 +1774,12 @@ test_that("SEI model works as intended", { expect_equal(all(data2$exposed[[12]][[2]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) expect_equal(all(data2$exposed[[12]][[3]] >= matrix(0, ncol = 2, nrow = 2)), TRUE) - expect_equal(all(data$host_pools[[1]]$susceptible[[1]] <= data2$host_pools[[1]]$susceptible[[1]]), TRUE) - expect_equal(all(data$host_pools[[1]]$susceptible[[2]] <= data2$host_pools[[1]]$susceptible[[1]]), TRUE) - expect_equal(all(data$host_pools[[1]]$susceptible[[3]] <= data2$host_pools[[1]]$susceptible[[1]]), TRUE) + expect_equal(all(data$host_pools[[1]]$susceptible[[1]] <= + data2$host_pools[[1]]$susceptible[[1]]), TRUE) + expect_equal(all(data$host_pools[[1]]$susceptible[[2]] <= + data2$host_pools[[1]]$susceptible[[1]]), TRUE) + expect_equal(all(data$host_pools[[1]]$susceptible[[3]] <= + data2$host_pools[[1]]$susceptible[[1]]), TRUE) expect_equal(all(data$host_pools[[1]]$infected[[1]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) expect_equal(all(data$infected[[2]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) @@ -1779,11 +1807,15 @@ test_that("SEI model works as intended", { start_exposed = start_exposed, exposed_file_list = exposed_file_list) - expect_equal(all(data3$host_pools[[1]]$susceptible[[1]] <= data2$host_pools[[1]]$susceptible[[1]]), TRUE) - expect_equal(all(data3$host_pools[[1]]$susceptible[[2]] <= data2$host_pools[[1]]$susceptible[[1]]), TRUE) - expect_equal(all(data3$host_pools[[1]]$susceptible[[3]] <= data2$host_pools[[1]]$susceptible[[1]]), TRUE) + expect_equal(all(data3$host_pools[[1]]$susceptible[[1]] <= + data2$host_pools[[1]]$susceptible[[1]]), TRUE) + expect_equal(all(data3$host_pools[[1]]$susceptible[[2]] <= + data2$host_pools[[1]]$susceptible[[1]]), TRUE) + expect_equal(all(data3$host_pools[[1]]$susceptible[[3]] <= + data2$host_pools[[1]]$susceptible[[1]]), TRUE) - expect_equal(all(data3$host_pools[[1]]$infected[[1]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) + expect_equal(all(data3$host_pools[[1]]$infected[[1]] >= + data2$host_pools[[1]]$infected[[1]]), TRUE) expect_equal(all(data3$infected[[2]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) expect_equal(all(data3$infected[[3]] >= data2$host_pools[[1]]$infected[[1]]), TRUE) @@ -1792,7 +1824,8 @@ test_that("SEI model works as intended", { test_that("Infected results with weather are less than those without weather", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1802,7 +1835,8 @@ test_that("Infected results with weather are less than those without weather", { parameter_means <- c(0.4, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) coefficient_sd_file <- system.file("extdata", "simple2x2", "coefficient_sd.tif", package = "PoPS") - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- @@ -1916,32 +1950,48 @@ test_that("Infected results with weather are less than those without weather", { expect_gte(sum(data$host_pools[[1]]$infected[[2]]), sum(data_temp$host_pools[[1]]$infected[[2]])) expect_gte(sum(data$host_pools[[1]]$infected[[3]]), sum(data_temp$host_pools[[1]]$infected[[3]])) - expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_precip$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data$host_pools[[1]]$infected[[2]]), sum(data_precip$host_pools[[1]]$infected[[2]])) - expect_gte(sum(data$host_pools[[1]]$infected[[3]]), sum(data_precip$host_pools[[1]]$infected[[3]])) - - expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_weather$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data$host_pools[[1]]$infected[[2]]), sum(data_weather$host_pools[[1]]$infected[[2]])) - expect_gte(sum(data$host_pools[[1]]$infected[[3]]), sum(data_weather$host_pools[[1]]$infected[[3]])) - - expect_gte(sum(data$host_pools[[1]]$infected[[2]]), sum(data_temp_wsd$host_pools[[1]]$infected[[2]])) - expect_gte(sum(data$host_pools[[1]]$infected[[3]]), sum(data_temp_wsd$host_pools[[1]]$infected[[3]])) - expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_temp_wsd$host_pools[[1]]$infected[[1]])) - - expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_precip_wsd$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data$host_pools[[1]]$infected[[2]]), sum(data_precip_wsd$host_pools[[1]]$infected[[2]])) - expect_gte(sum(data$host_pools[[1]]$infected[[3]]), sum(data_precip_wsd$host_pools[[1]]$infected[[3]])) - - expect_gte(sum(data$host_pools[[1]]$infected[[1]]), sum(data_weather_wsd$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data$host_pools[[1]]$infected[[2]]), sum(data_weather_wsd$host_pools[[1]]$infected[[2]])) - expect_gte(sum(data$host_pools[[1]]$infected[[3]]), sum(data_weather_wsd$host_pools[[1]]$infected[[3]])) + expect_gte(sum(data$host_pools[[1]]$infected[[1]]), + sum(data_precip$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data$host_pools[[1]]$infected[[2]]), + sum(data_precip$host_pools[[1]]$infected[[2]])) + expect_gte(sum(data$host_pools[[1]]$infected[[3]]), + sum(data_precip$host_pools[[1]]$infected[[3]])) + + expect_gte(sum(data$host_pools[[1]]$infected[[1]]), + sum(data_weather$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data$host_pools[[1]]$infected[[2]]), + sum(data_weather$host_pools[[1]]$infected[[2]])) + expect_gte(sum(data$host_pools[[1]]$infected[[3]]), + sum(data_weather$host_pools[[1]]$infected[[3]])) + + expect_gte(sum(data$host_pools[[1]]$infected[[2]]), + sum(data_temp_wsd$host_pools[[1]]$infected[[2]])) + expect_gte(sum(data$host_pools[[1]]$infected[[3]]), + sum(data_temp_wsd$host_pools[[1]]$infected[[3]])) + expect_gte(sum(data$host_pools[[1]]$infected[[1]]), + sum(data_temp_wsd$host_pools[[1]]$infected[[1]])) + + expect_gte(sum(data$host_pools[[1]]$infected[[1]]), + sum(data_precip_wsd$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data$host_pools[[1]]$infected[[2]]), + sum(data_precip_wsd$host_pools[[1]]$infected[[2]])) + expect_gte(sum(data$host_pools[[1]]$infected[[3]]), + sum(data_precip_wsd$host_pools[[1]]$infected[[3]])) + + expect_gte(sum(data$host_pools[[1]]$infected[[1]]), + sum(data_weather_wsd$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data$host_pools[[1]]$infected[[2]]), + sum(data_weather_wsd$host_pools[[1]]$infected[[2]])) + expect_gte(sum(data$host_pools[[1]]$infected[[3]]), + sum(data_weather_wsd$host_pools[[1]]$infected[[3]])) }) test_that( "Infected results are greater with same parameters for weekly spread vs. monthly", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1950,7 +2000,8 @@ test_that( end_date <- "2010-12-31" parameter_means <- c(0.2, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data_week <- @@ -1978,8 +2029,10 @@ test_that( start_date = start_date, end_date = end_date) - expect_equal(all(data_week$host_pools[[1]]$infected[[1]] >= data_month$host_pools[[1]]$infected[[1]]), TRUE) - expect_equal(all(data_week$host_pools[[1]]$infected[[2]] >= data_month$host_pools[[1]]$infected[[2]]), TRUE) + expect_equal(all(data_week$host_pools[[1]]$infected[[1]] >= + data_month$host_pools[[1]]$infected[[1]]), TRUE) + expect_equal(all(data_week$host_pools[[1]]$infected[[2]] >= + data_month$host_pools[[1]]$infected[[2]]), TRUE) }) @@ -1989,7 +2042,8 @@ test_that("Infected results are greater with same parameters for daily spread vs system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -1999,8 +2053,10 @@ test_that("Infected results are greater with same parameters for daily spread vs end_date <- "2010-12-31" parameter_means <- c(0.1, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") - competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data_day <- pops(infected_file_list = infected_file_list, @@ -2037,23 +2093,28 @@ test_that("Infected results are greater with same parameters for daily spread vs start_date = start_date, end_date = end_date) - expect_equal(all(data_day$host_pools[[1]]$infected[[1]] >= data_month$host_pools[[1]]$infected[[1]]), TRUE) - expect_equal(all(data_day$host_pools[[1]]$infected[[1]] >= data_week$host_pools[[1]]$infected[[1]]), TRUE) - expect_equal(all(data_week$host_pools[[1]]$infected[[1]] >= data_month$host_pools[[1]]$infected[[1]]), TRUE) + expect_equal(all(data_day$host_pools[[1]]$infected[[1]] >= + data_month$host_pools[[1]]$infected[[1]]), TRUE) + expect_equal(all(data_day$host_pools[[1]]$infected[[1]] >= + data_week$host_pools[[1]]$infected[[1]]), TRUE) + expect_equal(all(data_week$host_pools[[1]]$infected[[1]] >= + data_month$host_pools[[1]]$infected[[1]]), TRUE) }) test_that( "Infected results are greater without treatment than with treatment", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") treatments_file <- system.file("extdata", "simple2x2", "treatments_1_1.tif", package = "PoPS") treatment_dates <- c("2008-03-05") start_date <- "2008-01-01" end_date <- "2009-12-31" parameter_means <- c(0.8, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- @@ -2082,19 +2143,23 @@ test_that( start_date = start_date, end_date = end_date) - expect_equal(all(data$host_pools[[1]]$infected[[1]] >= data_treat$host_pools[[1]]$infected[[1]]), TRUE) - expect_equal(all(data$host_pools[[1]]$infected[[2]] >= data_treat$host_pools[[1]]$infected[[2]]), TRUE) + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= + data_treat$host_pools[[1]]$infected[[1]]), TRUE) + expect_equal(all(data$host_pools[[1]]$infected[[2]] >= + data_treat$host_pools[[1]]$infected[[2]]), TRUE) }) test_that("Infected results are greater with higher reproductive rate", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2010-12-31" parameter_means <- c(1.0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data_1 <- @@ -2167,23 +2232,33 @@ test_that("Infected results are greater with higher reproductive rate", { expect_gte(sum(data_1$host_pools[[1]]$infected[[1]]), sum(data_025$host_pools[[1]]$infected[[1]])) expect_gte(sum(data_1$host_pools[[1]]$infected[[1]]), sum(data_010$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data_075$host_pools[[1]]$infected[[1]]), sum(data_050$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data_075$host_pools[[1]]$infected[[1]]), sum(data_025$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data_075$host_pools[[1]]$infected[[1]]), sum(data_010$host_pools[[1]]$infected[[1]])) - - expect_gte(sum(data_050$host_pools[[1]]$infected[[1]]), sum(data_025$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data_050$host_pools[[1]]$infected[[2]]), sum(data_025$host_pools[[1]]$infected[[2]])) - expect_gte(sum(data_050$host_pools[[1]]$infected[[1]]), sum(data_010$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data_050$host_pools[[1]]$infected[[2]]), sum(data_010$host_pools[[1]]$infected[[2]])) - - expect_gte(sum(data_025$host_pools[[1]]$infected[[1]]), sum(data_010$host_pools[[1]]$infected[[1]])) - expect_gte(sum(data_025$host_pools[[1]]$infected[[2]]), sum(data_010$host_pools[[1]]$infected[[2]])) + expect_gte(sum(data_075$host_pools[[1]]$infected[[1]]), + sum(data_050$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data_075$host_pools[[1]]$infected[[1]]), + sum(data_025$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data_075$host_pools[[1]]$infected[[1]]), + sum(data_010$host_pools[[1]]$infected[[1]])) + + expect_gte(sum(data_050$host_pools[[1]]$infected[[1]]), + sum(data_025$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data_050$host_pools[[1]]$infected[[2]]), + sum(data_025$host_pools[[1]]$infected[[2]])) + expect_gte(sum(data_050$host_pools[[1]]$infected[[1]]), + sum(data_010$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data_050$host_pools[[1]]$infected[[2]]), + sum(data_010$host_pools[[1]]$infected[[2]])) + + expect_gte(sum(data_025$host_pools[[1]]$infected[[1]]), + sum(data_010$host_pools[[1]]$infected[[1]])) + expect_gte(sum(data_025$host_pools[[1]]$infected[[2]]), + sum(data_010$host_pools[[1]]$infected[[2]])) }) test_that("Treatments apply no matter what time step", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -2194,7 +2269,8 @@ test_that("Treatments apply no matter what time step", { parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) dates <- seq.Date(as.Date(start_date), as.Date(end_date), by = "days") - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") for (i in seq_len(length(dates))) { data <- @@ -2218,7 +2294,8 @@ test_that("Treatments apply no matter what time step", { test_that("Pesticide treatments apply no matter what time step", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") temperature_file <- @@ -2231,7 +2308,8 @@ test_that("Pesticide treatments apply no matter what time step", { parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) dates <- seq.Date(as.Date(start_date), as.Date("2009-06-30"), by = "days") - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") for (i in seq_len(length(dates))) { @@ -2275,7 +2353,8 @@ test_that("Pesticide treatments apply no matter what time step", { pesticide_duration = pesticide_duration, pesticide_efficacy = pesticide_efficacy) expect_equal(data$host_pools[[1]]$infected[[1]], matrix(c(3, 0, 0, 0), ncol = 2, nrow = 2)) - expect_equal(data$host_pools[[1]]$susceptible[[1]], matrix(c(12, 6, 14, 15), ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$susceptible[[1]], + matrix(c(12, 6, 14, 15), ncol = 2, nrow = 2)) } }) @@ -2286,14 +2365,17 @@ test_that("Changing the output frequency returns the correct number of outputs a system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2009-01-01" end_date <- "2009-12-31" treatment_dates <- c(start_date) parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") - competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(output_frequency = "year", @@ -2473,13 +2555,15 @@ test_that( "Outputs occur with non-full year date range for all time step output frequency combinations", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2009-05-01" end_date <- "2009-10-29" treatment_dates <- start_date parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(output_frequency = "year", @@ -2615,7 +2699,8 @@ test_that("Quarantine and spread rates work at all timings", { infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2009-01-01" end_date <- "2009-12-31" treatment_dates <- start_date @@ -2623,7 +2708,8 @@ test_that("Quarantine and spread rates work at all timings", { parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) quarantine_areas_file <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(output_frequency = "year", @@ -2821,7 +2907,8 @@ test_that("Mortality works as expected with multiple ", { infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2009-01-01" end_date <- "2009-12-31" treatment_dates <- start_date @@ -2869,7 +2956,8 @@ test_that("Mortality works as expected with multiple ", { expect_equal(length(data$host_pools[[1]]$mortality), 12) expect_equal(data$host_pools[[1]]$mortality[[1]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$host_pools[[1]]$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$host_pools[[1]]$mortality[[3]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + expect_equal(data$host_pools[[1]]$mortality[[3]], + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) pest_host_table <- system.file("extdata", "pest_host_table_singlehost025.csv", package = "PoPS") data <- pops(output_frequency = "week", @@ -2892,9 +2980,11 @@ test_that("Mortality works as expected with multiple ", { expect_equal(data$host_pools[[1]]$mortality[[2]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$host_pools[[1]]$mortality[[3]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$host_pools[[1]]$mortality[[4]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$host_pools[[1]]$mortality[[5]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + expect_equal(data$host_pools[[1]]$mortality[[5]], + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost025tl3.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost025tl3.csv", package = "PoPS") data <- pops(output_frequency = "week", time_step = "week", treatment_dates = start_date, @@ -2917,10 +3007,12 @@ test_that("Mortality works as expected with multiple ", { expect_equal(data$host_pools[[1]]$mortality[[4]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$host_pools[[1]]$mortality[[5]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$host_pools[[1]]$mortality[[6]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$host_pools[[1]]$mortality[[7]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + expect_equal(data$host_pools[[1]]$mortality[[7]], + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost010tl1.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost010tl1.csv", package = "PoPS") data <- pops(output_frequency = "week", time_step = "week", treatment_dates = start_date, @@ -2947,14 +3039,16 @@ test_that("Mortality works as expected with multiple ", { expect_equal(data$host_pools[[1]]$mortality[[8]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$host_pools[[1]]$mortality[[9]], matrix(0, ncol = 20, nrow = 20)) expect_equal(data$host_pools[[1]]$mortality[[10]], matrix(0, ncol = 20, nrow = 20)) - expect_equal(data$host_pools[[1]]$mortality[[11]], terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + expect_equal(data$host_pools[[1]]$mortality[[11]], + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) }) test_that("Movements works as expected", { infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2009-01-01" end_date <- "2009-12-31" treatment_dates <- start_date @@ -2962,7 +3056,8 @@ test_that("Movements works as expected", { parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) use_movements <- TRUE movements_file <- system.file("extdata", "simple20x20", "movements.tif", package = "PoPS") - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") expect_error(pops(output_frequency = "month", @@ -3075,12 +3170,14 @@ test_that( leaving the simulated area", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2008-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- @@ -3108,12 +3205,14 @@ test_that( test_that("Deterministic dispersal works as expected", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2008-12-31" parameter_means <- c(2, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- @@ -3141,14 +3240,16 @@ test_that("Network dispersal works as expected", { infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") host_file_list <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") - total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2008-03-31" parameter_means <- c(2, 21, 1, 500, 0, 0, 100, 1000) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) network_filename <- system.file("extdata", "simple20x20", "segments.csv", package = "PoPS") anthropogenic_kernel_type <- "network" - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- @@ -3183,7 +3284,8 @@ test_that("uncertainty propogation works as expected", { anthropogenic_kernel_type <- "cauchy" use_initial_condition_uncertainty <- TRUE use_host_uncertainty <- TRUE - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- @@ -3250,7 +3352,8 @@ test_that("uncertainty propogation works as expected", { anthropogenic_kernel_type <- "cauchy" use_initial_condition_uncertainty <- FALSE use_host_uncertainty <- TRUE - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- @@ -3287,7 +3390,8 @@ test_that("multiple_random seeds works and returns expected results", { anthropogenic_kernel_type <- "cauchy" multiple_random_seeds <- TRUE file_random_seeds <- NULL - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- @@ -3348,7 +3452,8 @@ test_that("Using soils returns expected results", { dispersers_to_soils_percentage <- 0.05 coefficient_file <- system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") - pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- From 30a5cbaaff11a42cc8dd16bf37185bc2862ad384 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 23 Jan 2024 09:01:39 -0500 Subject: [PATCH 44/68] update popsmultirun to handle multihost api from pops core --- R/pops_multirun.R | 205 +++++++++++++++++++++++++--------------------- 1 file changed, 113 insertions(+), 92 deletions(-) diff --git a/R/pops_multirun.R b/R/pops_multirun.R index 5580a562..6ed1a7ea 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -221,10 +221,10 @@ pops_multirun <- function(infected_file_list, config <- draw_parameters(config) # draws parameter set for the run config <- host_pool_setup(config) - config$competency_table_list <- competency_table_list_creator(competency_table) + config$competency_table_list <- competency_table_list_creator(config$competency_table) data <- PoPS::pops_model( - random_seed = config$random_seed[1], + random_seed = config$random_seed[i], multiple_random_seeds = config$multiple_random_seeds, random_seeds = as.matrix(config$random_seeds[i, ])[1, ], use_lethal_temperature = config$use_lethal_temperature, @@ -238,7 +238,6 @@ pops_multirun <- function(infected_file_list, competency_table = config$competency_table_list, pest_host_table = config$pest_host_table_list, mortality_on = config$mortality_on, - mortality = config$mortality, quarantine_areas = config$quarantine_areas, quarantine_directions = config$quarantine_directions, treatment_maps = config$treatment_maps, @@ -304,74 +303,106 @@ pops_multirun <- function(infected_file_list, dispersers_to_soils_percentage = config$dispersers_to_soils_percentage, use_soils = config$use_soils) - run <- c() - run$single_run <- data$infected - run$comp_years <- data$infected - run$number_infected <- data$number_infected - run$susceptible_runs <- data$susceptible - run$infected_area <- data$area_infected - run$spread_rate <- data$rates - run$quarantine_escape <- data$quarantine_escape - run$quarantine_escape_distance <- data$quarantine_escape_distance - run$quarantine_escape_direction <- data$quarantine_escape_directions - run$exposed_runs <- data$exposed - - if (config$write_outputs == "all_simulations") { - infected_out <- terra::rast(config$infected_file)[[1]] - susectible_out <- infected_out - exposed_out <- infected_out - for (q in seq_len(length(data$infected))) { - terra::values(infected_out[[q]]) <- data$infected[[q]] - terra::values(susectible_out[[q]]) <- data$susceptible[[q]] - for (p in seq_len(length(data$exposed[[q]]))) - terra::values(exposed_out[[q]]) <- data$exposed[[q]][[p]] + outputs <- c() + outputs$number_infected <- data$number_infected + outputs$infected_area <- data$area_infected + outputs$spread_rate <- data$rates + outputs$quarantine_escape <- data$quarantine_escape + outputs$quarantine_escape_distance <- data$quarantine_escape_distance + outputs$quarantine_escape_direction <- data$quarantine_escape_directions + output_host_pools <- c() + + zero_rast <- terra::rast(config$total_populations_file)[[1]] + values(zero_rast) <- 0 + + total_infecteds_list <- c() + total_infecteds <- as.matrix(zero_rast, wide = TRUE) + + for (p in seq_len(length(data$host_pools))) { + output_host_pool <- data$host_pools[[p]] + output_host_pool$name <- config$host_names[p] + output_host_pools[[p]] <- output_host_pool + + config$pops_runs_folder_path <- paste(config$output_folder_path, "pops_runs/", sep = "") + suppressWarnings(dir.create(config$pops_runs_folder_path)) + config$host_pool_folder_path <- + paste(config$pops_runs_folder_path , config$host_names[p], sep = "") + suppressWarnings(dir.create(config$host_pool_folder_path)) + + infected_out <- zero_rast + susectible_out <- zero_rast + exposed_outs <- c() + + for (q in seq_len(length(data$host_pools[[p]]$infected))) { + total_infecteds_list[[q]] <- total_infecteds + exposed_out <- zero_rast + if (q > 1) { + add(infected_out) <- zero_rast + add(susectible_out) <- zero_rast + } + total_infecteds_list[[q]] <- + total_infecteds_list[[q]] + data$host_pools[[p]]$infected[[q]] + terra::values(infected_out[[q]]) <- data$host_pools[[p]]$infected[[q]] + terra::values(susectible_out[[q]]) <- data$host_pools[[p]]$susceptible[[q]] + for (k in seq_len(length(data$host_pools[[p]]$exposed[[q]]))) { + if (k > 1) { + add(exposed_out) <- zero_rast + } + terra::values(exposed_out[[k]]) <- data$host_pools[[p]]$exposed[[q]][[k]] + } + if (config$write_outputs == "all_simulations") { + file_name <- paste(config$host_pool_folder_path, "/exposed_", i, "time_step_", q, ".tif", sep = "") + terra::writeRaster(exposed_out, file_name, overwrite = TRUE) + } + exposed_outs[[q]] <- exposed_out } - - dir.create(paste(config$output_folder_path, "pops_runs/", sep = "")) - file_name <- paste(config$output_folder_path, "pops_runs/infected_", i, ".tif", sep = "") - terra::writeRaster(infected_out, file_name, overwrite = TRUE) - file_name <- - paste(config$output_folder_path, "pops_runs/susectible_", i, ".tif", sep = "") - terra::writeRaster(susectible_out, file_name, overwrite = TRUE) - file_name <- paste(config$output_folder_path, "pops_runs/exposed_", i, ".tif", sep = "") - terra::writeRaster(exposed_out, file_name, overwrite = TRUE) + if (config$write_outputs == "all_simulations") { + file_name <- paste(config$host_pool_folder_path,"/infected_", i, ".tif", sep = "") + terra::writeRaster(infected_out, file_name, overwrite = TRUE) + file_name <- + paste(config$host_pool_folder_path, "/susectible_", i, ".tif", sep = "") + terra::writeRaster(susectible_out, file_name, overwrite = TRUE) + } + # file_name <- paste(config$host_pool_folder_path, "/exposed_", i, ".tif", sep = "") + # terra::writeRaster(exposed_out, file_name, overwrite = TRUE) } - run + outputs$total_infecteds <- total_infecteds_list + outputs$output_host_pools <- output_host_pools + + outputs } stopCluster(cl) - single_runs <- infected_stack[seq(1, length(infected_stack), 10)] - probability_runs <- infected_stack[seq(2, length(infected_stack), 10)] - number_infected_runs <- infected_stack[seq(3, length(infected_stack), 10)] - susceptible_runs <- infected_stack[seq(4, length(infected_stack), 10)] - area_infected_runs <- infected_stack[seq(5, length(infected_stack), 10)] - spread_rate_runs <- infected_stack[seq(6, length(infected_stack), 10)] - quarantine_escape_runs <- infected_stack[seq(7, length(infected_stack), 10)] - quarantine_escape_distance_runs <- infected_stack[seq(8, length(infected_stack), 10)] - quarantine_escape_directions_runs <- infected_stack[seq(9, length(infected_stack), 10)] - exposed_runs <- infected_stack[seq(10, length(infected_stack), 10)] - - prediction <- probability_runs[[1]] + number_infected_runs <- infected_stack[seq(1, length(infected_stack), 8)] + area_infected_runs <- infected_stack[seq(2, length(infected_stack), 8)] + spread_rate_runs <- infected_stack[seq(3, length(infected_stack), 8)] + quarantine_escape_runs <- infected_stack[seq(4, length(infected_stack), 8)] + quarantine_escape_distance_runs <- infected_stack[seq(5, length(infected_stack), 8)] + quarantine_escape_directions_runs <- infected_stack[seq(6, length(infected_stack), 8)] + total_infecteds_runs <- infected_stack[seq(7, length(infected_stack), 8)] + output_host_pools_runs <- infected_stack[seq(8, length(infected_stack), 8)] + + prediction <- total_infecteds_runs[[1]] for (w in seq_len(length(prediction))) { prediction[[w]] <- 0 } escape_probability <- - data.frame(t(rep(0, length(probability_runs[[1]])))) - infected_area <- data.frame(t(rep(0, length(probability_runs[[1]])))) - infected_number <- data.frame(t(rep(0, length(probability_runs[[1]])))) - west_rates <- data.frame(t(rep(0, length(probability_runs[[1]])))) - east_rates <- data.frame(t(rep(0, length(probability_runs[[1]])))) - south_rates <- data.frame(t(rep(0, length(probability_runs[[1]])))) - north_rates <- data.frame(t(rep(0, length(probability_runs[[1]])))) - max_values <- data.frame(t(rep(0, length(probability_runs[[1]])))) - quarantine_escapes <- data.frame(t(rep(0, length(probability_runs[[1]])))) - quarantine_escape_distances <- data.frame(t(rep(0, length(probability_runs[[1]])))) - quarantine_escape_directions <- data.frame(t(rep(0, length(probability_runs[[1]])))) - - for (p in seq_len(length(probability_runs))) { + data.frame(t(rep(0, length(total_infecteds_runs[[1]])))) + infected_area <- data.frame(t(rep(0, length(total_infecteds_runs[[1]])))) + infected_number <- data.frame(t(rep(0, length(total_infecteds_runs[[1]])))) + west_rates <- data.frame(t(rep(0, length(total_infecteds_runs[[1]])))) + east_rates <- data.frame(t(rep(0, length(total_infecteds_runs[[1]])))) + south_rates <- data.frame(t(rep(0, length(total_infecteds_runs[[1]])))) + north_rates <- data.frame(t(rep(0, length(total_infecteds_runs[[1]])))) + max_values <- data.frame(t(rep(0, length(total_infecteds_runs[[1]])))) + quarantine_escapes <- data.frame(t(rep(0, length(total_infecteds_runs[[1]])))) + quarantine_escape_distances <- data.frame(t(rep(0, length(total_infecteds_runs[[1]])))) + quarantine_escape_directions <- data.frame(t(rep(0, length(total_infecteds_runs[[1]])))) + + for (p in seq_len(length(total_infecteds_runs))) { for (w in seq_len(length(prediction))) { - prob <- probability_runs[[p]][[w]] + prob <- total_infecteds_runs[[p]][[w]] max_values[p, w] <- max(prob) prob[prob <= 1] <- 0 prob[prob > 1] <- 1 @@ -393,7 +424,7 @@ pops_multirun <- function(infected_file_list, } if (config$use_quarantine && length(quarantine_escape_runs[[p]]) == - length(probability_runs[[p]])) { + length(total_infecteds_runs[[p]])) { escape_probability <- escape_probability + quarantine_escape_runs[[p]] quarantine_escapes[p, ] <- quarantine_escape_runs[[p]] quarantine_escape_distances[p, ] <- quarantine_escape_distance_runs[[p]] @@ -403,7 +434,7 @@ pops_multirun <- function(infected_file_list, probability <- prediction for (w in seq_len(length(prediction))) { - probability[[w]] <- (prediction[[w]] / (length(probability_runs))) * 100 + probability[[w]] <- (prediction[[w]] / (length(total_infecteds_runs))) * 100 } infected_areas <- @@ -458,7 +489,7 @@ pops_multirun <- function(infected_file_list, ## add quarantine here if (use_quarantine) { - escape_probability <- escape_probability / length(probability_runs) * 100 + escape_probability <- escape_probability / length(total_infecteds_runs) * 100 if ( length(quarantine_escape_distances[quarantine_escape_directions == "N"]) > 0) { @@ -473,7 +504,7 @@ pops_multirun <- function(infected_file_list, } ), digits = 0) } else { - north_distance_to_quarantine <- data.frame(t(rep(NA, length(probability_runs[[1]])))) + north_distance_to_quarantine <- data.frame(t(rep(NA, length(total_infecteds_runs[[1]])))) } if ( @@ -490,7 +521,7 @@ pops_multirun <- function(infected_file_list, } ), digits = 0) } else { - south_distance_to_quarantine <- data.frame(t(rep(NA, length(probability_runs[[1]])))) + south_distance_to_quarantine <- data.frame(t(rep(NA, length(total_infecteds_runs[[1]])))) } if ( @@ -507,7 +538,7 @@ pops_multirun <- function(infected_file_list, } ), digits = 0) } else { - east_distance_to_quarantine <- data.frame(t(rep(NA, length(probability_runs[[1]])))) + east_distance_to_quarantine <- data.frame(t(rep(NA, length(total_infecteds_runs[[1]])))) } if ( @@ -524,14 +555,14 @@ pops_multirun <- function(infected_file_list, } ), digits = 0) } else { - west_distance_to_quarantine <- data.frame(t(rep(NA, length(probability_runs[[1]])))) + west_distance_to_quarantine <- data.frame(t(rep(NA, length(total_infecteds_runs[[1]])))) } } else { - escape_probability <- data.frame(t(rep(NA, length(probability_runs[[1]])))) - north_distance_to_quarantine <- data.frame(t(rep(NA, length(probability_runs[[1]])))) - south_distance_to_quarantine <- data.frame(t(rep(NA, length(probability_runs[[1]])))) - east_distance_to_quarantine <- data.frame(t(rep(NA, length(probability_runs[[1]])))) - west_distance_to_quarantine <- data.frame(t(rep(NA, length(probability_runs[[1]])))) + escape_probability <- data.frame(t(rep(NA, length(total_infecteds_runs[[1]])))) + north_distance_to_quarantine <- data.frame(t(rep(NA, length(total_infecteds_runs[[1]])))) + south_distance_to_quarantine <- data.frame(t(rep(NA, length(total_infecteds_runs[[1]])))) + east_distance_to_quarantine <- data.frame(t(rep(NA, length(total_infecteds_runs[[1]])))) + west_distance_to_quarantine <- data.frame(t(rep(NA, length(total_infecteds_runs[[1]])))) } which_median <- function(x) which.min(abs(x - median(x))) @@ -540,19 +571,17 @@ pops_multirun <- function(infected_file_list, min_run_index <- which.min(infected_number[[ncol(infected_number)]]) max_run_index <- which.max(infected_number[[ncol(infected_number)]]) - single_run <- single_runs[[median_run_index]] - susceptible_run <- susceptible_runs[[median_run_index]] - exposed_run <- exposed_runs[[median_run_index]] + median_run <- total_infecteds_runs[[median_run_index]] - min_run <- single_runs[[min_run_index]] - max_run <- single_runs[[max_run_index]] + min_run <- total_infecteds_runs[[min_run_index]] + max_run <- total_infecteds_runs[[max_run_index]] - for (q in seq_len(length(single_runs[[1]]))) { - for (j in seq_len(length(single_runs))) { + for (q in seq_len(length(total_infecteds_runs[[1]]))) { + for (j in seq_len(length(total_infecteds_runs))) { if (j == 1) { - raster_stacks <- list(single_runs[[j]][[q]]) + raster_stacks <- list(total_infecteds_runs[[j]][[q]]) } else { - raster_stacks[[j]] <- single_runs[[j]][[q]] + raster_stacks[[j]] <- total_infecteds_runs[[j]][[q]] } } @@ -572,7 +601,6 @@ pops_multirun <- function(infected_file_list, simulation_min <- simulation_mean simulation_probability <- simulation_mean simulation_median <- simulation_mean - simulation_susceptible <- simulation_mean terra::values(simulation_mean) <- sim_mean names(simulation_mean) <- "mean" @@ -585,15 +613,12 @@ pops_multirun <- function(infected_file_list, terra::values(simulation_min) <- min_run[[q]] names(simulation_min) <- "min" - terra::values(simulation_median) <- single_run[[q]] + terra::values(simulation_median) <- median_run[[q]] names(simulation_median) <- "median" terra::values(simulation_probability) <- probability[[q]] names(simulation_probability) <- "probability" - terra::values(simulation_susceptible) <- susceptible_run[[q]] - names(simulation_susceptible) <- "susceptible" - if (q == 1) { simulation_mean_stack <- simulation_mean simulation_sd_stack <- simulation_sd @@ -632,9 +657,7 @@ pops_multirun <- function(infected_file_list, simulation_sd_stack, simulation_min_stack, simulation_max_stack, - single_run, - susceptible_run, - exposed_run, + median_run, number_infecteds, infected_areas, west_rate, @@ -655,9 +678,7 @@ pops_multirun <- function(infected_file_list, "simulation_sd", "simulation_min", "simulation_max", - "single_run", - "susceptible_run", - "exposed_run", + "median_run", "number_infecteds", "infected_areas", "west_rate", From 5182f09ea338ec499416f81bf6d77b1cfe974dfe Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 23 Jan 2024 09:01:58 -0500 Subject: [PATCH 45/68] update tests for for pops multirun --- tests/testthat/test-pops-multirun.R | 257 ++++++++++++++-------------- 1 file changed, 124 insertions(+), 133 deletions(-) diff --git a/tests/testthat/test-pops-multirun.R b/tests/testthat/test-pops-multirun.R index cee9b685..17fa8b55 100644 --- a/tests/testthat/test-pops-multirun.R +++ b/tests/testthat/test-pops-multirun.R @@ -1,36 +1,40 @@ context("test-pops-multirun") - test_that("Model stops if files don't exist or aren't the correct extension", { - infected_file <- + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") - expect_error(pops_multirun(infected_file = "", - host_file = host_file, - total_populations_file = host_file, + expect_error(pops_multirun(infected_file_list = "", + host_file_list = host_file_list, + total_populations_file = host_file_list, parameter_means = parameter_means, - parameter_cov_matrix = parameter_cov_matrix), + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table), file_exists_error) - expect_error(pops_multirun(infected_file = infected_file, - host_file = host_file, - total_populations_file = host_file, + expect_error(pops_multirun(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = host_file_list, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, mask = ""), file_exists_error) }) test_that("Multirun model outputs work", { skip_on_os("windows") - infected_file <- - system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file <- - system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") temperature_file <- "" @@ -51,9 +55,6 @@ test_that("Multirun model outputs work", { treatment_dates <- c("2019-11-01") treatment_method <- "ratio" management <- FALSE - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 natural_kernel_type <- "cauchy" @@ -72,6 +73,9 @@ test_that("Multirun model outputs work", { latency_period <- 0 parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") start_exposed <- FALSE generate_stochasticity <- TRUE establishment_stochasticity <- TRUE @@ -87,7 +91,7 @@ test_that("Multirun model outputs work", { overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" mask <- NULL write_outputs <- "None" output_folder_path <- tempdir() @@ -110,11 +114,13 @@ test_that("Multirun model outputs work", { soil_starting_pest_file <- "" start_with_soil_populations <- FALSE - data <- pops_multirun(infected_file, - host_file, + data <- pops_multirun(infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp, temperature_coefficient_file, precip, @@ -134,9 +140,6 @@ test_that("Multirun model outputs work", { temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -170,7 +173,7 @@ test_that("Multirun model outputs work", { overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, mask, write_outputs, output_folder_path, @@ -179,11 +182,11 @@ test_that("Multirun model outputs work", { use_initial_condition_uncertainty, use_host_uncertainty) - expect_equal(length(data), 19) - expect_equal(terra::as.matrix(data$single_run[[1]], wide = TRUE), - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(terra::as.matrix(data$susceptible_run[[1]], wide = TRUE), - matrix(c(10, 6, 14, 15), nrow = 2, ncol = 2)) + expect_equal(length(data), 17) + expect_equal(terra::as.matrix(data$median_run[[1]], wide = TRUE), + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + # expect_equal(terra::as.matrix(data$susceptible_run[[1]], wide = TRUE), + # matrix(c(10, 6, 14, 15), nrow = 2, ncol = 2)) expect_equal(terra::as.matrix(data$probability[[1]], wide = TRUE), matrix(c(100, 0, 0, 0), nrow = 2, ncol = 2)) expect_equal(data$number_infecteds[[1]], 5) @@ -203,11 +206,13 @@ test_that("Multirun model outputs work", { write_outputs <- "None" output_folder_path <- "" - data <- pops_multirun(infected_file, - host_file, + data <- pops_multirun(infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp, temperature_coefficient_file, precip, @@ -227,9 +232,6 @@ test_that("Multirun model outputs work", { temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -263,7 +265,7 @@ test_that("Multirun model outputs work", { overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, mask, write_outputs, output_folder_path, @@ -282,11 +284,11 @@ test_that("Multirun model outputs work", { soil_starting_pest_file = "", start_with_soil_populations = FALSE) - expect_equal(length(data), 19) - expect_equal(terra::as.matrix(data$single_run[[1]], wide = TRUE), - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(terra::as.matrix(data$susceptible_run[[1]], wide = TRUE), - matrix(c(10, 6, 14, 15), nrow = 2, ncol = 2)) + expect_equal(length(data), 17) + expect_equal(terra::as.matrix(data$median_run[[1]], wide = TRUE), + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + # expect_equal(terra::as.matrix(data$susceptible_run[[1]], wide = TRUE), + # matrix(c(10, 6, 14, 15), nrow = 2, ncol = 2)) expect_equal(terra::as.matrix(data$probability[[1]], wide = TRUE), matrix(c(100, 0, 0, 0), nrow = 2, ncol = 2)) expect_equal(data$number_infecteds[[1]], 5) @@ -307,11 +309,13 @@ test_that("Multirun model outputs work", { system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") use_quarantine <- TRUE - data <- pops_multirun(infected_file, - host_file, + data <- pops_multirun(infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp, temperature_coefficient_file, precip, @@ -331,9 +335,6 @@ test_that("Multirun model outputs work", { temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -367,19 +368,18 @@ test_that("Multirun model outputs work", { overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, mask, write_outputs, output_folder_path, network_filename, network_movement) - - expect_equal(length(data), 19) - expect_equal(terra::as.matrix(data$single_run[[1]], wide = TRUE), - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(terra::as.matrix(data$susceptible_run[[1]], wide = TRUE), - matrix(c(10, 6, 14, 15), nrow = 2, ncol = 2)) + expect_equal(length(data), 17) + expect_equal(terra::as.matrix(data$median_run[[1]], wide = TRUE), + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + # expect_equal(terra::as.matrix(data$susceptible_run[[1]], wide = TRUE), + # matrix(c(10, 6, 14, 15), nrow = 2, ncol = 2)) expect_equal(terra::as.matrix(data$probability[[1]], wide = TRUE), matrix(c(100, 0, 0, 0), nrow = 2, ncol = 2)) expect_equal(data$number_infecteds[[1]], 5) @@ -397,11 +397,13 @@ test_that("Multirun model outputs work", { output_frequency <- "month" - data <- pops_multirun(infected_file, - host_file, + data <- pops_multirun(infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp, temperature_coefficient_file, precip, @@ -421,9 +423,6 @@ test_that("Multirun model outputs work", { temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -457,18 +456,18 @@ test_that("Multirun model outputs work", { overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, mask, write_outputs, output_folder_path, network_filename, network_movement) - expect_equal(length(data), 19) - expect_equal(terra::as.matrix(data$single_run[[1]], wide = TRUE), - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(terra::as.matrix(data$susceptible_run[[1]], wide = TRUE), - matrix(c(10, 6, 14, 15), nrow = 2, ncol = 2)) + expect_equal(length(data), 17) + expect_equal(terra::as.matrix(data$median_run[[1]], wide = TRUE), + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + # expect_equal(terra::as.matrix(data$susceptible_run[[1]], wide = TRUE), + # matrix(c(10, 6, 14, 15), nrow = 2, ncol = 2)) expect_equal(terra::as.matrix(data$probability[[1]], wide = TRUE), matrix(c(100, 0, 0, 0), nrow = 2, ncol = 2)) expect_equal(data$number_infecteds[[1]], 5) @@ -483,14 +482,13 @@ test_that("Multirun model outputs work", { expect_equal(data$south_rate[[2]], 0) expect_equal(data$north_rate[[1]], 0) expect_equal(data$north_rate[[2]], 0) - }) test_that("Multirun model outputs work with mask", { skip_on_os("windows") - infected_file <- + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -512,9 +510,6 @@ test_that("Multirun model outputs work with mask", { treatment_dates <- c("2019-11-01") treatment_method <- "ratio" management <- FALSE - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 natural_kernel_type <- "cauchy" @@ -533,6 +528,9 @@ test_that("Multirun model outputs work with mask", { latency_period <- 0 parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") start_exposed <- FALSE generate_stochasticity <- TRUE establishment_stochasticity <- TRUE @@ -554,17 +552,18 @@ test_that("Multirun model outputs work with mask", { overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" write_outputs <- "None" output_folder_path <- tempdir() network_filename <- "" - - data <- pops_multirun(infected_file, - host_file, + data <- pops_multirun(infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp, temperature_coefficient_file, precip, @@ -584,9 +583,6 @@ test_that("Multirun model outputs work with mask", { temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -620,16 +616,16 @@ test_that("Multirun model outputs work with mask", { overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, mask, write_outputs, output_folder_path, network_filename, network_movement) - expect_equal(length(data), 19) - expect_equal(terra::as.matrix(data$single_run[[1]], wide = TRUE), - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + expect_equal(length(data), 17) + expect_equal(terra::as.matrix(data$median_run[[1]], wide = TRUE), + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(data$number_infecteds[[1]], 1) expect_equal(data$number_infecteds[[2]], 0) expect_equal(data$infected_areas[[1]], 10000) @@ -645,16 +641,18 @@ test_that("Multirun model outputs work with mask", { use_initial_condition_uncertainty <- TRUE use_host_uncertainty <- TRUE - infected_file <- + infected_file_list <- system.file("extdata", "simple20x20", "infected_wsd.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host_w_sd2.tif", package = "PoPS") - data <- pops_multirun(infected_file, - host_file, + data <- pops_multirun(infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp, temperature_coefficient_file, precip, @@ -674,9 +672,6 @@ test_that("Multirun model outputs work with mask", { temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -710,7 +705,7 @@ test_that("Multirun model outputs work with mask", { overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, mask, write_outputs, output_folder_path, @@ -719,7 +714,7 @@ test_that("Multirun model outputs work with mask", { use_initial_condition_uncertainty, use_host_uncertainty) - expect_equal(length(data), 19) + expect_equal(length(data), 17) expect_equal(data$west_rate[[1]], 0) expect_equal(data$west_rate[[2]], 0) expect_equal(data$east_rate[[1]], 0) @@ -731,16 +726,18 @@ test_that("Multirun model outputs work with mask", { use_initial_condition_uncertainty <- TRUE use_host_uncertainty <- FALSE - infected_file <- + infected_file_list <- system.file("extdata", "simple20x20", "infected_wsd.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host_w_sd2.tif", package = "PoPS") - data <- pops_multirun(infected_file, - host_file, + data <- pops_multirun(infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp, temperature_coefficient_file, precip, @@ -760,9 +757,6 @@ test_that("Multirun model outputs work with mask", { temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -796,7 +790,7 @@ test_that("Multirun model outputs work with mask", { overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, mask, write_outputs, output_folder_path, @@ -805,7 +799,7 @@ test_that("Multirun model outputs work with mask", { use_initial_condition_uncertainty, use_host_uncertainty) - expect_equal(length(data), 19) + expect_equal(length(data), 17) expect_equal(data$west_rate[[1]], 0) expect_equal(data$west_rate[[2]], 0) expect_equal(data$east_rate[[1]], 0) @@ -818,16 +812,18 @@ test_that("Multirun model outputs work with mask", { use_initial_condition_uncertainty <- FALSE use_host_uncertainty <- TRUE - infected_file <- + infected_file_list <- system.file("extdata", "simple20x20", "infected_wsd.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host_w_sd2.tif", package = "PoPS") - data <- pops_multirun(infected_file, - host_file, + data <- pops_multirun(infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp, temperature_coefficient_file, precip, @@ -847,9 +843,6 @@ test_that("Multirun model outputs work with mask", { temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -883,7 +876,7 @@ test_that("Multirun model outputs work with mask", { overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, mask, write_outputs, output_folder_path, @@ -892,7 +885,7 @@ test_that("Multirun model outputs work with mask", { use_initial_condition_uncertainty, use_host_uncertainty) - expect_equal(length(data), 19) + expect_equal(length(data), 17) expect_equal(data$west_rate[[1]], 0) expect_equal(data$west_rate[[2]], 0) expect_equal(data$east_rate[[1]], 0) @@ -905,16 +898,18 @@ test_that("Multirun model outputs work with mask", { use_initial_condition_uncertainty <- FALSE use_host_uncertainty <- FALSE - infected_file <- + infected_file_list <- system.file("extdata", "simple20x20", "infected_wsd.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host_w_sd2.tif", package = "PoPS") - data <- pops_multirun(infected_file, - host_file, + data <- pops_multirun(infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp, temperature_coefficient_file, precip, @@ -934,9 +929,6 @@ test_that("Multirun model outputs work with mask", { temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -970,7 +962,7 @@ test_that("Multirun model outputs work with mask", { overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, mask, write_outputs, output_folder_path, @@ -979,7 +971,7 @@ test_that("Multirun model outputs work with mask", { use_initial_condition_uncertainty, use_host_uncertainty) - expect_equal(length(data), 19) + expect_equal(length(data), 17) expect_equal(data$west_rate[[1]], 0) expect_equal(data$west_rate[[2]], 0) expect_equal(data$east_rate[[1]], 0) @@ -992,9 +984,9 @@ test_that("Multirun model outputs work with mask", { test_that("Multirun model outputs work with writing all simulations and random seeds", { skip_on_os("windows") - infected_file <- + infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") - host_file <- + host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") @@ -1016,9 +1008,6 @@ test_that("Multirun model outputs work with writing all simulations and random s treatment_dates <- c("2019-11-01") treatment_method <- "ratio" management <- FALSE - mortality_on <- FALSE - mortality_rate <- 0 - mortality_time_lag <- 0 mortality_frequency <- "Year" mortality_frequency_n <- 1 natural_kernel_type <- "cauchy" @@ -1033,10 +1022,13 @@ test_that("Multirun model outputs work with writing all simulations and random s use_movements <- FALSE number_of_iterations <- 2 number_of_cores <- 2 - model_type <- "SI" - latency_period <- 0 + model_type <- "SEI" + latency_period <- 2 parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") start_exposed <- FALSE generate_stochasticity <- TRUE establishment_stochasticity <- TRUE @@ -1059,7 +1051,7 @@ test_that("Multirun model outputs work with writing all simulations and random s overpopulation_percentage <- 0 leaving_percentage <- 0 leaving_scale_coefficient <- 1 - exposed_file <- "" + exposed_file_list <- "" write_outputs <- "all_simulations" output_folder_path <- tempdir() network_filename <- "" @@ -1076,11 +1068,13 @@ test_that("Multirun model outputs work with writing all simulations and random s soil_starting_pest_file <- "" start_with_soil_populations <- FALSE - data <- pops_multirun(infected_file, - host_file, + data <- pops_multirun(infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, temp, temperature_coefficient_file, precip, @@ -1100,9 +1094,6 @@ test_that("Multirun model outputs work with writing all simulations and random s temperature_file, lethal_temperature, lethal_temperature_month, - mortality_on, - mortality_rate, - mortality_time_lag, mortality_frequency, mortality_frequency_n, management, @@ -1136,7 +1127,7 @@ test_that("Multirun model outputs work with writing all simulations and random s overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, mask, write_outputs, output_folder_path, @@ -1155,9 +1146,9 @@ test_that("Multirun model outputs work with writing all simulations and random s soil_starting_pest_file, start_with_soil_populations) - expect_equal(length(data), 19) - expect_equal(terra::as.matrix(data$single_run[[1]], wide = TRUE), - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + expect_equal(length(data), 17) + expect_equal(terra::as.matrix(data$median_run[[1]], wide = TRUE), + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(data$number_infecteds[[1]], 1) expect_equal(data$number_infecteds[[2]], 0) expect_equal(data$infected_areas[[1]], 10000) From 3d2715325f39704a0f85d94ff26192f4c8345518 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 23 Jan 2024 09:04:24 -0500 Subject: [PATCH 46/68] lint --- R/pops_multirun.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/pops_multirun.R b/R/pops_multirun.R index 6ed1a7ea..2b10856f 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -326,7 +326,7 @@ pops_multirun <- function(infected_file_list, config$pops_runs_folder_path <- paste(config$output_folder_path, "pops_runs/", sep = "") suppressWarnings(dir.create(config$pops_runs_folder_path)) config$host_pool_folder_path <- - paste(config$pops_runs_folder_path , config$host_names[p], sep = "") + paste(config$pops_runs_folder_path, config$host_names[p], sep = "") suppressWarnings(dir.create(config$host_pool_folder_path)) infected_out <- zero_rast @@ -351,13 +351,14 @@ pops_multirun <- function(infected_file_list, terra::values(exposed_out[[k]]) <- data$host_pools[[p]]$exposed[[q]][[k]] } if (config$write_outputs == "all_simulations") { - file_name <- paste(config$host_pool_folder_path, "/exposed_", i, "time_step_", q, ".tif", sep = "") + file_name <- + paste(config$host_pool_folder_path, "/exposed_", i, "time_step_", q, ".tif", sep = "") terra::writeRaster(exposed_out, file_name, overwrite = TRUE) } exposed_outs[[q]] <- exposed_out } if (config$write_outputs == "all_simulations") { - file_name <- paste(config$host_pool_folder_path,"/infected_", i, ".tif", sep = "") + file_name <- paste(config$host_pool_folder_path, "/infected_", i, ".tif", sep = "") terra::writeRaster(infected_out, file_name, overwrite = TRUE) file_name <- paste(config$host_pool_folder_path, "/susectible_", i, ".tif", sep = "") From f03c324972bceef5d3a37bfc95014bd919e4de41 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 23 Jan 2024 10:26:34 -0500 Subject: [PATCH 47/68] fix notes in multirun --- R/pops_multirun.R | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/R/pops_multirun.R b/R/pops_multirun.R index 2b10856f..0fe32170 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -313,7 +313,7 @@ pops_multirun <- function(infected_file_list, output_host_pools <- c() zero_rast <- terra::rast(config$total_populations_file)[[1]] - values(zero_rast) <- 0 + terra::values(zero_rast) <- 0 total_infecteds_list <- c() total_infecteds <- as.matrix(zero_rast, wide = TRUE) @@ -337,8 +337,8 @@ pops_multirun <- function(infected_file_list, total_infecteds_list[[q]] <- total_infecteds exposed_out <- zero_rast if (q > 1) { - add(infected_out) <- zero_rast - add(susectible_out) <- zero_rast + terra::add(infected_out) <- zero_rast + terra::add(susectible_out) <- zero_rast } total_infecteds_list[[q]] <- total_infecteds_list[[q]] + data$host_pools[[p]]$infected[[q]] @@ -346,7 +346,7 @@ pops_multirun <- function(infected_file_list, terra::values(susectible_out[[q]]) <- data$host_pools[[p]]$susceptible[[q]] for (k in seq_len(length(data$host_pools[[p]]$exposed[[q]]))) { if (k > 1) { - add(exposed_out) <- zero_rast + terra::add(exposed_out) <- zero_rast } terra::values(exposed_out[[k]]) <- data$host_pools[[p]]$exposed[[q]][[k]] } @@ -488,7 +488,6 @@ pops_multirun <- function(infected_file_list, south_rate[is.na(south_rate)] <- 0 north_rate[is.na(north_rate)] <- 0 - ## add quarantine here if (use_quarantine) { escape_probability <- escape_probability / length(total_infecteds_runs) * 100 if ( From 9f5d7f477560bb96e87ae5d13bda2a63fdd26574 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 23 Jan 2024 10:26:49 -0500 Subject: [PATCH 48/68] add parameters to config tests --- tests/testthat/test-configuration.R | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-configuration.R b/tests/testthat/test-configuration.R index f171420b..3f9fa0ac 100644 --- a/tests/testthat/test-configuration.R +++ b/tests/testthat/test-configuration.R @@ -11,14 +11,18 @@ config$params_to_estimate <- c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE) config$number_of_generations <- 4 config$generation_size <- 10 config$checks <- c(1200, 100000, 900, 1000) -config$infected_file <- +config$infected_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") -config$host_file <- +config$host_file_list <- system.file("extdata", "simple20x20", "host.tif", package = "PoPS") config$total_populations_file <- system.file("extdata", "simple20x20", "all_plants.tif", package = "PoPS") config$parameter_means <- c(0, 1, 0.99, 1000, 0, 0, 0, 0) config$parameter_cov_matrix <- matrix(ncol = 8, nrow = 8, 0) +config$pest_host_table <- + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") +config$competency_table <- + system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") config$temp <- FALSE config$temperature_coefficient_file <- "" config$temperature_coefficient_sd_file <- "" @@ -36,9 +40,8 @@ config$use_lethal_temperature <- FALSE config$temperature_file <- "" config$lethal_temperature <- -30 config$lethal_temperature_month <- 1 -config$mortality_on <- FALSE -config$mortality_rate <- 0 -config$mortality_time_lag <- 0 +config$mortality_frequency <- "Year" +config$mortality_frequency_n <- 1 config$management <- FALSE config$treatment_dates <- c("2003-01-24") config$treatments_file <- "" @@ -76,7 +79,7 @@ config$number_of_cores <- 1 config$calibration_method <- "ABC" config$failure <- NULL config$function_name <- "pops" -config$exposed_file <- +config$exposed_file_list <- system.file("extdata", "simple20x20", "initial_infection.tif", package = "PoPS") config$write_outputs <- "None" config$output_folder_path <- "" From 84b6c11e8603d402a3305f4e6f6cb1d2ba61653e Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 23 Jan 2024 10:50:12 -0500 Subject: [PATCH 49/68] fix mask error in calibrate --- R/calibrate.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/R/calibrate.R b/R/calibrate.R index 9a543720..3796f05f 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -557,7 +557,6 @@ calibrate <- function(infected_years_file, comparison <- comparison + infections } terra::values(reference) <- config$infection_years2[[q]] - mask <- terra::rast(config$infected_file)[[1]] terra::values(mask) <- config$mask_matrix quantity_allocation_disagreement(reference, comparison, @@ -901,7 +900,6 @@ calibrate <- function(infected_years_file, comparison <- comparison + infections } terra::values(reference) <- config$infection_years2[[q]] - mask <- terra::rast(config$infected_file)[[1]] terra::values(mask) <- config$mask_matrix quantity_allocation_disagreement(reference, comparison, @@ -1081,7 +1079,6 @@ calibrate <- function(infected_years_file, comparison <- comparison + infections } terra::values(reference) <- config$infection_years2[[q]] - mask <- terra::rast(config$infected_file)[[1]] terra::values(mask) <- config$mask_matrix quantity_allocation_disagreement(reference, comparison, From 7b126c868f8cc36464840124e32af0287f53a3d2 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 23 Jan 2024 10:56:19 -0500 Subject: [PATCH 50/68] modify order in validate stats --- R/validate.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/validate.R b/R/validate.R index 46bec0c5..43407a14 100644 --- a/R/validate.R +++ b/R/validate.R @@ -330,9 +330,9 @@ validate <- function(infected_years_file, # need to assign reference, comparison, and mask in inner loop since # terra objects are pointers comparison <- terra::rast(config$infected_file_list[[1]])[[1]] + terra::values(comparison) <- 0 reference <- comparison mask <- comparison - terra::values(comparison) <- 0 infections <- comparison for (p in seq_len(length(data$host_pools))) { terra::values(infections) <- data$host_pools[[p]]$infected[[q]] From b4b6d588a18f0eaec15c6e8ea03daa5371d42915 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Tue, 23 Jan 2024 16:43:29 -0500 Subject: [PATCH 51/68] add check to ensure that all host populations are less than total populations in all cells --- R/calibrate.R | 5 +++++ R/configuration.R | 22 ++++++++++++++++++++-- R/helpers.R | 11 +++++++++++ R/pops.r | 5 +++++ R/pops_multirun.R | 5 +++++ R/validate.R | 5 +++++ 6 files changed, 51 insertions(+), 2 deletions(-) diff --git a/R/calibrate.R b/R/calibrate.R index 3796f05f..f02d6c40 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -324,6 +324,11 @@ calibrate <- function(infected_years_file, config$random_seed <- sample(1:999999999999, 1, replace = FALSE) random_seeds <- create_random_seeds(1) config <- host_pool_setup(config) + while(any(config$total_hosts > config$total_populations) || + any(config$total_exposed > config$total_populations) || + any(config$total_infecteds> config$total_populations)) { + config <- host_pool_setup(config) + } config$competency_table_list <- competency_table_list_creator(config$competency_table) data <- pops_model( diff --git a/R/configuration.R b/R/configuration.R index 8b882192..a6f6f831 100644 --- a/R/configuration.R +++ b/R/configuration.R @@ -166,7 +166,9 @@ configuration <- function(config) { zero_rast <- total_populations[[1]] terra::values(zero_rast) <- 0 + config$zero_rast <- zero_rast zero_matrix <- terra::as.matrix(zero_rast, wide = TRUE) + config$zero_matrix <- zero_matrix one_matrix <- total_populations[[1]] terra::values(one_matrix) <- 0 @@ -521,6 +523,10 @@ configuration <- function(config) { host_pool_host_means <- list() host_pool_host_sds <- list() suitable <- zero_rast + + total_infecteds <- config$zero_matrix + total_exposeds <- config$zero_matrix + total_hosts <- config$zero_matrix for (i in seq_along(config$infected_file_list)) { host_pool <- list() # check that infection rasters have the same crs, resolution, and extent @@ -558,6 +564,7 @@ configuration <- function(config) { host_pool$infected <- infected_mean host_pool_infected_means[[i]] <- infected_mean host_pool_infected_sds[[i]] <- infected_sd + total_infecteds <- total_infecteds + infected_mean # prepare exposed exposed <- list(zero_matrix) if (config$model_type == "SEI" && config$latency_period > 1) { @@ -608,6 +615,7 @@ configuration <- function(config) { exposed[[config$latency_period + 1]] <- exposed_mean host_pool$total_exposed <- total_exposed host_pool$exposed <- exposed + total_exposeds <- total_exposeds + exposed_mean # check that host raster has the same crs, resolution, and extent if (config$function_name %in% aws_bucket_list) { @@ -642,6 +650,7 @@ configuration <- function(config) { host_pool_host_means[[i]] <- host_mean host_pool_host_sds[[i]] <- host_sd host_pool$total_hosts <- host_mean + total_hosts <- total_hosts + host_mean susceptible <- host_mean - infected_mean - exposed_mean susceptible[susceptible < 0] <- 0 @@ -685,6 +694,17 @@ configuration <- function(config) { host_pools[[i]] <- host_pool } + config$total_hosts <- total_hosts + config$total_exposed <- total_exposeds + config$total_infecteds <- total_infecteds + config$total_populations <- terra::as.matrix(total_populations, wide = TRUE) + + while(any(config$total_hosts > config$total_populations) || + any(config$total_exposed > config$total_populations) || + any(config$total_infecteds> config$total_populations)) { + config <- host_pool_setup(config) + } + config$host_pools <- host_pools config$host_pool_infected_means <- host_pool_infected_means config$host_pool_infected_sds <- host_pool_infected_sds @@ -723,8 +743,6 @@ configuration <- function(config) { rows_cols$num_cols <- terra::ncol(infected) config$rows_cols <- rows_cols - config$total_populations <- terra::as.matrix(total_populations, wide = TRUE) - if (!is.null(config$mask)) { if (config$function_name %in% aws_bucket_list) { mask_check <- secondary_raster_checks(config$mask, infected, config$use_s3, config$bucket) diff --git a/R/helpers.R b/R/helpers.R index 55425d40..65f7fb92 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -294,6 +294,9 @@ competency_table_list_creator <- function(competency_table) { # Update host pools when uncertainties are used host_pool_setup <- function(config) { + total_infecteds <- config$zero_matrix + total_exposeds <- config$zero_matrix + total_hosts <- config$zero_matrix for (i in seq_along(config$host_file_list)) { host_pool <- config$host_pools[[i]] if (config$use_initial_condition_uncertainty) { @@ -316,6 +319,9 @@ host_pool_setup <- function(config) { host_pool$infected <- infected host_pool$exposed <- exposed host_pool$total_exposed <- exposed2 + + total_infecteds <- total_infecteds + infected + total_exposeds <- total_exposeds + exposed2 } if (config$use_host_uncertainty) { @@ -326,6 +332,7 @@ host_pool_setup <- function(config) { config$host_pool_host_sds[[i]]) } host_pool$total_host <- host + total_hosts <- total_hosts + host } susceptible <- host_pool$total_host - host_pool$infected - host_pool$total_exposed @@ -339,5 +346,9 @@ host_pool_setup <- function(config) { } config$host_pools[[i]] <- host_pool } + config$total_hosts <- total_hosts + config$total_exposed <- total_exposeds + config$total_infecteds <- total_infecteds + return(config) } diff --git a/R/pops.r b/R/pops.r index 599bc542..06557d1e 100644 --- a/R/pops.r +++ b/R/pops.r @@ -376,6 +376,11 @@ pops <- function(infected_file_list, config <- draw_parameters(config) # draws parameter set for the run config <- host_pool_setup(config) + while (any(config$total_hosts > config$total_populations) || + any(config$total_exposed > config$total_populations) || + any(config$total_infecteds> config$total_populations)) { + config <- host_pool_setup(config) + } config$competency_table_list <- competency_table_list_creator(config$competency_table) data <- pops_model(random_seed = config$random_seed[1], diff --git a/R/pops_multirun.R b/R/pops_multirun.R index 0fe32170..54124cdd 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -221,6 +221,11 @@ pops_multirun <- function(infected_file_list, config <- draw_parameters(config) # draws parameter set for the run config <- host_pool_setup(config) + while (any(config$total_hosts > config$total_populations) || + any(config$total_exposed > config$total_populations) || + any(config$total_infecteds> config$total_populations)) { + config <- host_pool_setup(config) + } config$competency_table_list <- competency_table_list_creator(config$competency_table) data <- PoPS::pops_model( diff --git a/R/validate.R b/R/validate.R index 43407a14..e12c3baf 100644 --- a/R/validate.R +++ b/R/validate.R @@ -239,6 +239,11 @@ validate <- function(infected_years_file, config <- draw_parameters(config) # draws parameter set for the run config <- host_pool_setup(config) + while(any(config$total_hosts > config$total_populations) || + any(config$total_exposed > config$total_populations) || + any(config$total_infecteds> config$total_populations)) { + config <- host_pool_setup(config) + } config$competency_table_list <- competency_table_list_creator(config$competency_table) data <- pops_model( From b5e65205786b2ade249a55a34148c69e614a647a Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Thu, 25 Jan 2024 09:30:46 -0500 Subject: [PATCH 52/68] add error messages --- R/error_messages.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/R/error_messages.R b/R/error_messages.R index dc1207d9..f0b7f6f7 100644 --- a/R/error_messages.R +++ b/R/error_messages.R @@ -196,3 +196,15 @@ pest_host_table_wrong_columns <- pest_host_table_value_error <- "pest_host_table susceptiblity and mortality_rate must be between 0 and 1" + +multihosts_gt_totpop_error <- + "All hosts sum to more than the total populations in some cells. Check rasters to ensure that + combined summed host layers are not greater than total populations raster." + +multiinfected_gt_totpop_error <- + "All infecteds sum to more than the total populations in some cells. Check rasters to ensure that + combined summed infected layers are not greater than total populations raster." + +multiexposed_gt_totpop_error <- + "All exposeds sum to more than the total populations in some cells. Check rasters to ensure that + combined summed exposed layers are not greater than total populations raster." \ No newline at end of file From 3b91d8839f8eb3dc502d9fe2b8cee52577bdaf3c Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Thu, 25 Jan 2024 09:30:58 -0500 Subject: [PATCH 53/68] update if to while --- R/helpers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/helpers.R b/R/helpers.R index 65f7fb92..dc477161 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -277,7 +277,7 @@ competency_table_list_creator <- function(competency_table) { rnorm(n = nrow(competency_table), mean = competency_table$competency_mean, sd = competency_table$compentency_sd) names(competency_table2)[ncol(competency_table2)] <- "competency" - if (any(competencies > 1) || any(competencies < 0)) { + while (any(competencies > 1) || any(competencies < 0)) { competencies <- rnorm(n = nrow(competency_table), mean = competency_table$competency_mean, sd = competency_table$compentency_sd) From 7cc1e5e0719c18e84f10d35f42247c114da7830f Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Thu, 25 Jan 2024 09:31:22 -0500 Subject: [PATCH 54/68] add data for tests --- inst/extdata/simple2x2/host.tif | Bin 0 -> 746 bytes inst/extdata/simple2x2/host_baylaurel.tif | Bin 0 -> 746 bytes inst/extdata/simple2x2/host_oak.tif | Bin 0 -> 746 bytes inst/extdata/simple2x2/host_tanoak.tif | Bin 0 -> 745 bytes inst/extdata/simple2x2/infected_baylaurel.tif | Bin 0 -> 739 bytes inst/extdata/simple2x2/infected_oak.tif | Bin 0 -> 737 bytes inst/extdata/simple2x2/infected_tanoak.tif | Bin 0 -> 738 bytes inst/extdata/simple2x2/total_plants.tif | Bin 733 -> 747 bytes 8 files changed, 0 insertions(+), 0 deletions(-) create mode 100644 inst/extdata/simple2x2/host.tif create mode 100644 inst/extdata/simple2x2/host_baylaurel.tif create mode 100644 inst/extdata/simple2x2/host_oak.tif create mode 100644 inst/extdata/simple2x2/host_tanoak.tif create mode 100644 inst/extdata/simple2x2/infected_baylaurel.tif create mode 100644 inst/extdata/simple2x2/infected_oak.tif create mode 100644 inst/extdata/simple2x2/infected_tanoak.tif diff --git a/inst/extdata/simple2x2/host.tif b/inst/extdata/simple2x2/host.tif new file mode 100644 index 0000000000000000000000000000000000000000..b857edf498fa2277e24ef1bddb2234c04d09bcbb GIT binary patch literal 746 zcma))TT22#6vxkAQVS^zx(Gc?`cxnqL>Ev|T(ODPq}?uWGUz@Cx+}XI^x%V9uy1{a z9(oVo`YL^aK1XNP5tJZX*!}72v#s>{W%U?b7&sF#36!wf&39DK#-r1CxHz6 z$e+l=cNs3Rm~R}9kX2Nh+4u#>*R=ALZuzXud{$f|Bu{;-M{L%!3Ms=Zo76CA#c1l~ z2ddxdDdMqSzl(FZRPpFEpXJ$q*{bFGf+us1&vF~B|JvK?eB(`6Cp7AU`3`Lmm#0 zKar>JJX~Tk-}pX57EvAM;1fV;>DrZH2dvKmrsfGzXkd?s!$x*ZHZ9GfrbQcO*U%oQ zacjuLXQS~D=c=-Le5zEU>c4DFt-azYpX0UOM%%x4TkA3{U2op~cRRglHg0IgqSq@O z63>l3uW$Q3Z!iu9t|O~~8?a$_JY-JbFS}4Gt0xzqCV*OBz*3XpwbD*}n6Nl6S%`j9 z#2AiPd2t>VaUCu<53^8&42F|~w-QK^7PiD#4@>tglboH93hDUvW8WrECD S6PRLJc_}xo&j==j<@q17RD+=a literal 0 HcmV?d00001 diff --git a/inst/extdata/simple2x2/host_oak.tif b/inst/extdata/simple2x2/host_oak.tif new file mode 100644 index 0000000000000000000000000000000000000000..b857edf498fa2277e24ef1bddb2234c04d09bcbb GIT binary patch literal 746 zcma))TT22#6vxkAQVS^zx(Gc?`cxnqL>Ev|T(ODPq}?uWGUz@Cx+}XI^x%V9uy1{a z9(oVo`YL^aK1XNP5tJZX*!}72v#s>{W%U?b7&sF#36!wf&39DK#-r1CxHz6 z$e+l=cNs3Rm~R}9kX2Nh+4u#>*R=ALZuzXud{$f|Bu{;-M{L%!3Ms=Zo76CA#c1l~ z2ddxdDdMqSzl(FZRPpFEpXJ$q*{bFGf+us1&vF~B|JvO zAKvvUy+F^=nRSJgAY0h||K`m3&zzY(l|4%aDl~qsf`2VU|p4n6zv(_0j{? zZ}kiruwK85bNNj1@IcFn?7wW)QhmX*e~Qm?8?FD^?RcrnFe{bn-G8^MRE_ctZJ6|G zp+e$1;&^Rq&~iI{-f`?qkvp7qoBb}c`Cwj!mRr0z?=}I7XET_qA6_bT--jLM^-BcA zZxW2n;i;@nCn;PS5XUDUwn0j51(kw_H9aYo7V)5vhSnyO1yhTOA2$ij3I&^#G~RlsR>;k# z@Gb>k#aHktJUB^HND-`o?Ejb9`R`74htdO(0ALe<6M#eF@#Rv?CrmIdB)o>4NjUNp zIWhKrqIoM7-%dDMb0^8kBk!hi>M1r87BDA2%|WDxXnualK?Yeveh&p8$N};!XEblA zab?J4WDkZ9I9HR^Bc&Q8|K-w~oh3`<6ra^L+WECvZKcb!G)=$$?{=DQwk~Pcq8CdQ z65osd&S9gT-ya5j&z04_d(V0Sa~2gS)#XEr4-yBpF{gzt;;Xci_^`X;UdcjqMG<3T z#LA1au!PHS(k#qE2{PE29K4nx7in=rjCH?!(>BS;F{zU7h&?)9#bAEV4m^K6pBTdg OK;ph7XiU!S5XUDUwxv`>L8ahfO;3uYJt!!op`i(7!PH{n$4x@BLct~_jkg}E6>{?_ zyi37X@fCayC+QYa1ZyDs|7CXmyOZ6a^au(7unizcARvkO3KP}_!nVX?^d+{o36gs3!P1LC^_)=+Fmcc|^qmVIyOchtJJ z6f$xL!$+K}E83}AOOpR`nR;i*Qa#6KwT*UuZB}3DvK_-PZ~nWTVcM-L+I8sVQiUW8 zlE3rVs2BE!Q9tk%t?xguUc|gb1!`^i(9(m%L2J%wp^Nw`?QkDZSz zc@~#(8KE$X^H7EyHl_e?6~LAeU~5xO^{{f=w#nHEsgdr8J$XUZVqwpXf^a;a7{dgh MD9Xk4{IuEp0j_RS5XUDUwneJaf=a=|nw}I(i+E5-gRu!^!PH{n$4x@JLct~_jkkhT3%U6e z-lgEH_zFIUvuO$`f;Eu+|1vxO-O27yx(_)3C;|u)2uLEnLW;$N3C5*_SCBIab5B8# zWA7K5H&gMgg!!7=NzNMbPAaFKVmo08bJkz;!1VylFOxiEkPYOINCJW!B2Oa`c9B1k z$L}JTSj;zmKO@Vip6lTVpf(Nt++v~IbwgKMB}Anm>l4rIv$|qCxWV`IcB z%G0QX%Lut?l!X#xurURAD?^@ZVMC5}uYA+A$?*}XlJ<~2cKwRQf{q*d!Du!yf-w*y LSA-{Vaz@AxGSPu` literal 0 HcmV?d00001 diff --git a/inst/extdata/simple2x2/total_plants.tif b/inst/extdata/simple2x2/total_plants.tif index 953005eda26236018e75106345cc60ab513fb275..a301515f1379d8e5ec1aa5568860e863eab4daf6 100644 GIT binary patch delta 162 zcmcc1`kIx~(^HFqgMooTXdmXT2&6$+kdXyU-<{~MEXW5GkU^5Pomeh! zXu`z6(A2`izy_4`0kYS(Gczav*)>4+#&#wKMId_*klnC^iNP0WA;Bq0RRzQ8|VN4 delta 176 zcmaFOdY6^c(^HFqgMooTa3ZI!BqNZ)#>mV7qCr@Ykp)bjo#?L|DgYFaL6QuHvYCP6 ze9b%zAX0e#fg=M$0uUc?0I>lnsv21U From ec3acd9fb9b2a265dda09b9e324b6419fef959f0 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Thu, 25 Jan 2024 09:31:33 -0500 Subject: [PATCH 55/68] update tests --- tests/testthat/test-pops.r | 158 ++++++++++++++++++++++++++----------- 1 file changed, 113 insertions(+), 45 deletions(-) diff --git a/tests/testthat/test-pops.r b/tests/testthat/test-pops.r index 031125f5..fad8b03e 100644 --- a/tests/testthat/test-pops.r +++ b/tests/testthat/test-pops.r @@ -2,7 +2,7 @@ context("test-pops") test_that("Model stops if files don't exist or aren't the correct extension", { infected_file_list <- c("") - host_file_list <- c(system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS")) + host_file_list <- c(system.file("extdata", "simple2x2", "host.tif", package = "PoPS")) total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -55,7 +55,7 @@ test_that("Model stops if files don't exist or aren't the correct extension", { competency_table = competency_table), raster_type_error, fixed = TRUE) - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- "" expect_error(pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -220,7 +220,9 @@ test_that("Model stops if files don't exist or aren't the correct extension", { test_that("Model stops if treatments don't have correct dimenisions", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2010-12-31" parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) @@ -245,7 +247,7 @@ test_that("Model stops if treatments don't have correct dimenisions", { test_that("Model stops if time and date parameters are of the wrong type and/or dimension", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -308,7 +310,7 @@ test_that("Model stops if time and date parameters are of the wrong type and/or test_that("Model stops if kernel is of the wrong type and/or dimension", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -346,7 +348,7 @@ test_that("Model stops if kernel is of the wrong type and/or dimension", { test_that("Input raster resolutions, extents, and crs all match", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -832,7 +834,7 @@ test_that("Input raster resolutions, extents, and crs all match", { test_that("Infected results return initial infected if reproductive rate is set to 0", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -1066,7 +1068,7 @@ test_that("Infected results return initial infected if reproductive rate is set test_that( "Infected results returns all 0's if minimum temp drops below lethal temperature", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -1135,7 +1137,7 @@ test_that( test_that( "Infected results returns less infection after survival rates than before", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -1209,7 +1211,7 @@ test_that("Infected and Susceptible results return all 0's if treatments file is infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- - system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -1284,7 +1286,7 @@ test_that("Infected and Susceptible results return all 0's if treatments file is expect_equal(data$host_pools[[1]]$infected[[1]], matrix(c(2, 0, 0, 0), ncol = 2, nrow = 2)) expect_equal(data$host_pools[[1]]$susceptible[[1]], - matrix(c(5, 3, 7, 7), ncol = 2, nrow = 2)) + matrix(c(6, 7, 3, 7), ncol = 2, nrow = 2)) data <- pops(infected_file_list = infected_file_list, @@ -1304,13 +1306,12 @@ test_that("Infected and Susceptible results return all 0's if treatments file is expect_equal(data$host_pools[[1]]$infected[[1]], matrix(c(0, 0, 0, 0), ncol = 2, nrow = 2)) expect_equal(data$host_pools[[1]]$susceptible[[1]], - matrix(c(5, 3, 7, 7), ncol = 2, nrow = 2)) - + matrix(c(6, 7, 3, 7), ncol = 2, nrow = 2)) }) test_that("Infected results are greater than initial infected", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -1337,7 +1338,7 @@ test_that("Infected results are greater than initial infected", { expect_equal(all( pops(infected_file_list = infected_file_list, host_file_list = system.file("extdata", "simple2x2", - "total_plants_host_greater_than_infected.tif", package = "PoPS"), + "total_plants_host_greater_than_infected.tif", package = "PoPS"), total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, @@ -1349,7 +1350,7 @@ test_that("Infected results are greater than initial infected", { test_that("All kernel types lead to spread", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -1359,7 +1360,7 @@ test_that("All kernel types lead to spread", { start_date <- "2008-01-01" end_date <- "2008-12-31" time_step <- "month" - parameter_means <- c(0.4, 21, 1, 500, 0, 0, 0, 0) + parameter_means <- c(3.0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") @@ -1630,7 +1631,7 @@ test_that("All kernel types lead to spread", { test_that("Susceptibles are never negative", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -1665,7 +1666,7 @@ test_that("Susceptibles are never negative", { data <- pops(infected_file_list = infected_file_list, host_file_list = system.file("extdata", "simple2x2", - "total_plants_host_greater_than_infected.tif", package = "PoPS"), + "total_plants_host_greater_than_infected.tif", package = "PoPS"), total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, @@ -1683,7 +1684,7 @@ test_that("Susceptibles are never negative", { test_that("SEI model works as intended", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -1823,7 +1824,7 @@ test_that("SEI model works as intended", { test_that("Infected results with weather are less than those without weather", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -1832,7 +1833,7 @@ test_that("Infected results with weather are less than those without weather", { system.file("extdata", "simple2x2", "critical_temp_all_below_threshold.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2010-12-31" - parameter_means <- c(0.4, 21, 1, 500, 0, 0, 0, 0) + parameter_means <- c(2.0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) coefficient_sd_file <- system.file("extdata", "simple2x2", "coefficient_sd.tif", package = "PoPS") pest_host_table <- @@ -1847,7 +1848,7 @@ test_that("Infected results with weather are less than those without weather", { parameter_cov_matrix = parameter_cov_matrix, pest_host_table = pest_host_table, competency_table = competency_table, - random_seed = 44, + random_seed = 42, start_date = start_date, end_date = end_date) @@ -1861,7 +1862,7 @@ test_that("Infected results with weather are less than those without weather", { parameter_cov_matrix = parameter_cov_matrix, pest_host_table = pest_host_table, competency_table = competency_table, - random_seed = 44, + random_seed = 42, start_date = start_date, end_date = end_date) @@ -1875,7 +1876,7 @@ test_that("Infected results with weather are less than those without weather", { parameter_cov_matrix = parameter_cov_matrix, pest_host_table = pest_host_table, competency_table = competency_table, - random_seed = 44, + random_seed = 42, start_date = start_date, end_date = end_date) @@ -1891,7 +1892,7 @@ test_that("Infected results with weather are less than those without weather", { parameter_cov_matrix = parameter_cov_matrix, pest_host_table = pest_host_table, competency_table = competency_table, - random_seed = 44, + random_seed = 42, start_date = start_date, end_date = end_date) @@ -1905,7 +1906,7 @@ test_that("Infected results with weather are less than those without weather", { parameter_cov_matrix = parameter_cov_matrix, pest_host_table = pest_host_table, competency_table = competency_table, - random_seed = 44, + random_seed = 42, start_date = start_date, end_date = end_date, weather_type = "probabilistic", @@ -1921,7 +1922,7 @@ test_that("Infected results with weather are less than those without weather", { parameter_cov_matrix = parameter_cov_matrix, pest_host_table = pest_host_table, competency_table = competency_table, - random_seed = 44, + random_seed = 42, start_date = start_date, end_date = end_date, weather_type = "probabilistic", @@ -1939,7 +1940,7 @@ test_that("Infected results with weather are less than those without weather", { parameter_cov_matrix = parameter_cov_matrix, pest_host_table = pest_host_table, competency_table = competency_table, - random_seed = 44, + random_seed = 42, start_date = start_date, end_date = end_date, weather_type = "probabilistic", @@ -1989,7 +1990,7 @@ test_that("Infected results with weather are less than those without weather", { test_that( "Infected results are greater with same parameters for weekly spread vs. monthly", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -2041,7 +2042,7 @@ test_that("Infected results are greater with same parameters for daily spread vs infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- - system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -2104,7 +2105,7 @@ test_that("Infected results are greater with same parameters for daily spread vs test_that( "Infected results are greater without treatment than with treatment", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") treatments_file <- system.file("extdata", "simple2x2", "treatments_1_1.tif", package = "PoPS") @@ -2125,7 +2126,7 @@ test_that( parameter_cov_matrix = parameter_cov_matrix, pest_host_table = pest_host_table, competency_table = competency_table, - random_seed = 44, + random_seed = 42, start_date = start_date, end_date = end_date) data_treat <- @@ -2139,7 +2140,7 @@ test_that( parameter_cov_matrix = parameter_cov_matrix, pest_host_table = pest_host_table, competency_table = competency_table, - random_seed = 44, + random_seed = 42, start_date = start_date, end_date = end_date) @@ -2151,7 +2152,7 @@ test_that( test_that("Infected results are greater with higher reproductive rate", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" @@ -2256,7 +2257,7 @@ test_that("Infected results are greater with higher reproductive rate", { test_that("Treatments apply no matter what time step", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -2293,7 +2294,7 @@ test_that("Treatments apply no matter what time step", { test_that("Pesticide treatments apply no matter what time step", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") coefficient_file <- @@ -2354,9 +2355,8 @@ test_that("Pesticide treatments apply no matter what time step", { pesticide_efficacy = pesticide_efficacy) expect_equal(data$host_pools[[1]]$infected[[1]], matrix(c(3, 0, 0, 0), ncol = 2, nrow = 2)) expect_equal(data$host_pools[[1]]$susceptible[[1]], - matrix(c(12, 6, 14, 15), ncol = 2, nrow = 2)) + matrix(c(14, 14, 6, 15), ncol = 2, nrow = 2)) } - }) test_that("Changing the output frequency returns the correct number of outputs and output @@ -2364,7 +2364,7 @@ test_that("Changing the output frequency returns the correct number of outputs a infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") host_file_list <- - system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2009-01-01" @@ -2554,7 +2554,7 @@ test_that("Changing the output frequency returns the correct number of outputs a test_that( "Outputs occur with non-full year date range for all time step output frequency combinations", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2009-05-01" @@ -2563,7 +2563,7 @@ test_that( parameter_means <- c(0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) pest_host_table <- - system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") + system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") data <- pops(output_frequency = "year", @@ -3169,7 +3169,7 @@ test_that( "Overpopulation dispersal works as expected with directionality to prevent dispersers from leaving the simulated area", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" @@ -3204,7 +3204,7 @@ test_that( test_that("Deterministic dispersal works as expected", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" @@ -3441,7 +3441,7 @@ test_that("multiple_random seeds works and returns expected results", { test_that("Using soils returns expected results", { infected_file_list <- system.file("extdata", "simple2x2", "infected.tif", package = "PoPS") - host_file_list <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + host_file_list <- system.file("extdata", "simple2x2", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" @@ -3504,3 +3504,71 @@ test_that("Using soils returns expected results", { expect_equal(length(data$soil_reservoirs[[1]]), 20) expect_equal(length(data$soil_reservoirs[[2]]), 20) }) + +test_that("Using multiple hosts works as expected", { + infected_file_list <- + c(system.file("extdata", "simple2x2", "infected_oak.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "infected_tanoak.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "infected_baylaurel.tif", package = "PoPS")) + host_file_list <- + c(system.file("extdata", "simple2x2", "host_oak.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "host_tanoak.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "host_baylaurel.tif", package = "PoPS")) + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + start_date <- "2008-01-01" + end_date <- "2009-12-31" + parameter_means <- c(5, 21, 1, 500, 0, 0, 100, 1000) + parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + coefficient_file <- + system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_multihost.csv", package = "PoPS") + + data <- + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, + parameter_means = parameter_means, + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, + start_date = start_date, + end_date = end_date, + temp = TRUE, + temperature_coefficient_file = coefficient_file) + + test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) + expect_equal(length(data$soil_reservoirs[[1]]), 20) + expect_equal(length(data$soil_reservoirs[[2]]), 20) + + data <- + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, + parameter_means = parameter_means, + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, + start_date = start_date, + end_date = end_date, + temp = TRUE, + temperature_coefficient_file = coefficient_file, + use_soils = use_soils, + dispersers_to_soils_percentage = dispersers_to_soils_percentage, + soil_starting_pest_file = infected_file_list, + start_with_soil_populations = TRUE) + + test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) + expect_equal(length(data$soil_reservoirs[[1]]), 20) + expect_equal(length(data$soil_reservoirs[[2]]), 20) +}) From 8020bd38abd95f3f00cc16bacb40541866a8aed9 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Thu, 25 Jan 2024 09:32:09 -0500 Subject: [PATCH 56/68] add returns for config errors --- R/configuration.R | 37 ++++++++++++++++++++++++++----------- 1 file changed, 26 insertions(+), 11 deletions(-) diff --git a/R/configuration.R b/R/configuration.R index a6f6f831..4f171537 100644 --- a/R/configuration.R +++ b/R/configuration.R @@ -47,11 +47,13 @@ configuration <- function(config) { if (config$write_outputs %notin% output_list) { config$failure <- write_outputs_error + return(config) } if (config$write_outputs %in% output_write_list) { if (!base::dir.exists(config$output_folder_path)) { config$failure <- output_path_error + return(config) } } @@ -89,6 +91,7 @@ configuration <- function(config) { config$mortality_on <- multihost_check$mortality_on } else { config$failure <- multihost_check$failed_check + return(config) } seasons <- seq(1, 12, 1) @@ -100,6 +103,7 @@ configuration <- function(config) { config$season_month_start_end <- season_month_start_end } else { config$failure <- season_month_error + return(config) } # ensures latent period is correct for type of model selected @@ -661,16 +665,18 @@ configuration <- function(config) { mortality_tracker <- list(zero_matrix) if (config$mortality_on) { - mortality_length <- - 1 / config$pest_host_table$mortality_rate[i] + - config$pest_host_table$mortality_time_lag[i] + if (config$pest_host_table$mortality_rate[i] <= 0) { + mortality_length <- 1 + } else { + mortality_length <- + 1 / config$pest_host_table$mortality_rate[i] + + config$pest_host_table$mortality_time_lag[i] + } for (mt in 2:(mortality_length)) { mortality_tracker[[mt]] <- zero_matrix } - } - # add currently infected cells to last element of the mortality tracker so - # that mortality occurs at the appropriate interval - if (config$mortality_on) { + # add currently infected cells to last element of the mortality tracker so + # that mortality occurs at the appropriate interval mortality_tracker[[length(mortality_tracker)]] <- infected_mean } @@ -699,10 +705,19 @@ configuration <- function(config) { config$total_infecteds <- total_infecteds config$total_populations <- terra::as.matrix(total_populations, wide = TRUE) - while(any(config$total_hosts > config$total_populations) || - any(config$total_exposed > config$total_populations) || - any(config$total_infecteds> config$total_populations)) { - config <- host_pool_setup(config) + if (any(config$total_hosts > config$total_populations)) { + config$failure <- multihosts_gt_totpop_error + return(config) + } + + if (any(config$total_exposed > config$total_populations)) { + config$failure <- multiinfected_gt_totpop_error + return(config) + } + + if (any(config$total_infecteds> config$total_populations)) { + config$failure <- multiexposed_gt_totpop_error + return(config) } config$host_pools <- host_pools From aa09d12f588e7f3d0d77144ccec4a44159e97b9a Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Sat, 27 Jan 2024 07:29:42 -0500 Subject: [PATCH 57/68] add data for 2 host --- inst/extdata/competency_table_2host.csv | 5 +++++ inst/extdata/pest_host_table_2host.csv | 3 +++ 2 files changed, 8 insertions(+) create mode 100644 inst/extdata/competency_table_2host.csv create mode 100644 inst/extdata/pest_host_table_2host.csv diff --git a/inst/extdata/competency_table_2host.csv b/inst/extdata/competency_table_2host.csv new file mode 100644 index 00000000..71ea375c --- /dev/null +++ b/inst/extdata/competency_table_2host.csv @@ -0,0 +1,5 @@ +oak,tanoak,competency_mean,compentency_sd +0,0,0,0 +1,0,0,0 +0,1,0.7,0.1 +1,1,0.8,0.05 \ No newline at end of file diff --git a/inst/extdata/pest_host_table_2host.csv b/inst/extdata/pest_host_table_2host.csv new file mode 100644 index 00000000..843aa802 --- /dev/null +++ b/inst/extdata/pest_host_table_2host.csv @@ -0,0 +1,3 @@ +host,susceptibility,mortality_rate,mortality_time_lag +oak,0.7,0.1,1 +tanoak,1,0.5,1 \ No newline at end of file From 0236c30bd1fae7d0c717adad70e26ee862ae5a44 Mon Sep 17 00:00:00 2001 From: Vaclav Petras Date: Sat, 27 Jan 2024 23:42:36 -0500 Subject: [PATCH 58/68] Store references to matrices only after the objects have fixed addresses (i.e., vector size is stable) --- src/pops.cpp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/pops.cpp b/src/pops.cpp index 9a0f8432..e76c7463 100644 --- a/src/pops.cpp +++ b/src/pops.cpp @@ -287,6 +287,8 @@ List pops_model_cpp( input_host_pool.mortality.emplace_back(host_pools[i]["mortality"]); std::vector mortality_tracker = host_pools[i]["mortality_tracker"]; input_host_pool.mortality_tracker.push_back(mortality_tracker); + } + for (unsigned i = 0; i < host_pools.size(); i++) { host_pool_vector.emplace_back(new PoPSModel::StandardSingleHostPool( mt, input_host_pool.susceptible[i], From 3fe87a658e1707161aefb3eee377ce53078c24ea Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Sun, 28 Jan 2024 06:46:47 -0500 Subject: [PATCH 59/68] lint --- R/calibrate.R | 4 ++-- R/configuration.R | 2 +- R/error_messages.R | 2 +- R/pops.r | 2 +- R/pops_multirun.R | 2 +- tests/testthat/test-pops.r | 10 ++++++---- 6 files changed, 12 insertions(+), 10 deletions(-) diff --git a/R/calibrate.R b/R/calibrate.R index f02d6c40..b6f6a038 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -324,9 +324,9 @@ calibrate <- function(infected_years_file, config$random_seed <- sample(1:999999999999, 1, replace = FALSE) random_seeds <- create_random_seeds(1) config <- host_pool_setup(config) - while(any(config$total_hosts > config$total_populations) || + while (any(config$total_hosts > config$total_populations) || any(config$total_exposed > config$total_populations) || - any(config$total_infecteds> config$total_populations)) { + any(config$total_infecteds > config$total_populations)) { config <- host_pool_setup(config) } config$competency_table_list <- competency_table_list_creator(config$competency_table) diff --git a/R/configuration.R b/R/configuration.R index 4f171537..04607c48 100644 --- a/R/configuration.R +++ b/R/configuration.R @@ -715,7 +715,7 @@ configuration <- function(config) { return(config) } - if (any(config$total_infecteds> config$total_populations)) { + if (any(config$total_infecteds > config$total_populations)) { config$failure <- multiexposed_gt_totpop_error return(config) } diff --git a/R/error_messages.R b/R/error_messages.R index f0b7f6f7..99febb95 100644 --- a/R/error_messages.R +++ b/R/error_messages.R @@ -207,4 +207,4 @@ multiinfected_gt_totpop_error <- multiexposed_gt_totpop_error <- "All exposeds sum to more than the total populations in some cells. Check rasters to ensure that - combined summed exposed layers are not greater than total populations raster." \ No newline at end of file + combined summed exposed layers are not greater than total populations raster." diff --git a/R/pops.r b/R/pops.r index 06557d1e..3a7f07b1 100644 --- a/R/pops.r +++ b/R/pops.r @@ -378,7 +378,7 @@ pops <- function(infected_file_list, config <- host_pool_setup(config) while (any(config$total_hosts > config$total_populations) || any(config$total_exposed > config$total_populations) || - any(config$total_infecteds> config$total_populations)) { + any(config$total_infecteds > config$total_populations)) { config <- host_pool_setup(config) } config$competency_table_list <- competency_table_list_creator(config$competency_table) diff --git a/R/pops_multirun.R b/R/pops_multirun.R index 54124cdd..aa348087 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -223,7 +223,7 @@ pops_multirun <- function(infected_file_list, config <- host_pool_setup(config) while (any(config$total_hosts > config$total_populations) || any(config$total_exposed > config$total_populations) || - any(config$total_infecteds> config$total_populations)) { + any(config$total_infecteds > config$total_populations)) { config <- host_pool_setup(config) } config$competency_table_list <- competency_table_list_creator(config$competency_table) diff --git a/tests/testthat/test-pops.r b/tests/testthat/test-pops.r index fad8b03e..dcd5e346 100644 --- a/tests/testthat/test-pops.r +++ b/tests/testthat/test-pops.r @@ -1337,8 +1337,9 @@ test_that("Infected results are greater than initial infected", { terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)), TRUE) expect_equal(all( pops(infected_file_list = infected_file_list, - host_file_list = system.file("extdata", "simple2x2", - "total_plants_host_greater_than_infected.tif", package = "PoPS"), + host_file_list = + system.file("extdata", "simple2x2", + "total_plants_host_greater_than_infected.tif", package = "PoPS"), total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, @@ -1665,8 +1666,9 @@ test_that("Susceptibles are never negative", { parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) data <- pops(infected_file_list = infected_file_list, - host_file_list = system.file("extdata", "simple2x2", - "total_plants_host_greater_than_infected.tif", package = "PoPS"), + host_file_list = + system.file("extdata", "simple2x2", + "total_plants_host_greater_than_infected.tif", package = "PoPS"), total_populations_file = total_populations_file, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, From 69a6bf720304b58cdff28d7b9e2b27f3a72c8457 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Sun, 28 Jan 2024 06:53:14 -0500 Subject: [PATCH 60/68] lint --- R/validate.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/validate.R b/R/validate.R index e12c3baf..38cc4eab 100644 --- a/R/validate.R +++ b/R/validate.R @@ -239,9 +239,9 @@ validate <- function(infected_years_file, config <- draw_parameters(config) # draws parameter set for the run config <- host_pool_setup(config) - while(any(config$total_hosts > config$total_populations) || + while (any(config$total_hosts > config$total_populations) || any(config$total_exposed > config$total_populations) || - any(config$total_infecteds> config$total_populations)) { + any(config$total_infecteds > config$total_populations)) { config <- host_pool_setup(config) } config$competency_table_list <- competency_table_list_creator(config$competency_table) From 10705a31a92a800b0f9afb565a560994a1a3d712 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Sun, 28 Jan 2024 07:08:25 -0500 Subject: [PATCH 61/68] update data --- inst/extdata/competency_table_multihost.csv | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/inst/extdata/competency_table_multihost.csv b/inst/extdata/competency_table_multihost.csv index 5414f0ea..16a43fa8 100644 --- a/inst/extdata/competency_table_multihost.csv +++ b/inst/extdata/competency_table_multihost.csv @@ -1,5 +1,5 @@ -oak,tanoak,bay laurel,competency_mean,compentency_sd +oak,tanoak,bay_laurel,competency_mean,compentency_sd 0,0,0,0,0 1,0,0,0,0 -0,1,0,1,0.1 -0,0,1,0.7,0.1 \ No newline at end of file +0,1,0,0.7,0.1 +0,0,1,0.8,0.05 \ No newline at end of file From 176b797368860df59042a1a368154a86f66930fa Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Sun, 28 Jan 2024 07:08:39 -0500 Subject: [PATCH 62/68] fix config test error --- tests/testthat/test-configuration.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-configuration.R b/tests/testthat/test-configuration.R index 3f9fa0ac..a1a4585d 100644 --- a/tests/testthat/test-configuration.R +++ b/tests/testthat/test-configuration.R @@ -481,13 +481,13 @@ test_that("configuration returns proper errors", { expect_equal(config2$failure, output_path_error) config$network_movement <- "hello" + config$write_outputs <- "None" config$output_folder_path <- "" config2 <- configuration(config) expect_equal(config2$failure, network_movement_error) config$parameter_means <- c(0, 1, 0.99, 1000, 0, 0, 25, 150) config$function_name <- "pops" - config$write_outputs <- "None" config$network_movement <- "walk" config$anthropogenic_kernel_type <- "network" config2 <- configuration(config) From 3bdcff7537cf25ff3541e533ea19f6ce74a2234e Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 29 Jan 2024 08:02:42 -0500 Subject: [PATCH 63/68] add uncertainty test data --- inst/extdata/simple2x2/host_baylaurel_wsd.tif | Bin 0 -> 1088 bytes inst/extdata/simple2x2/host_oak_wsd.tif | Bin 0 -> 1098 bytes inst/extdata/simple2x2/host_tanoak_wsd.tif | Bin 0 -> 1087 bytes .../extdata/simple2x2/infected_baylaurel_wsd.tif | Bin 0 -> 1068 bytes inst/extdata/simple2x2/infected_oak_wsd.tif | Bin 0 -> 1047 bytes inst/extdata/simple2x2/infected_tanoak_wsd.tif | Bin 0 -> 1068 bytes 6 files changed, 0 insertions(+), 0 deletions(-) create mode 100644 inst/extdata/simple2x2/host_baylaurel_wsd.tif create mode 100644 inst/extdata/simple2x2/host_oak_wsd.tif create mode 100644 inst/extdata/simple2x2/host_tanoak_wsd.tif create mode 100644 inst/extdata/simple2x2/infected_baylaurel_wsd.tif create mode 100644 inst/extdata/simple2x2/infected_oak_wsd.tif create mode 100644 inst/extdata/simple2x2/infected_tanoak_wsd.tif diff --git a/inst/extdata/simple2x2/host_baylaurel_wsd.tif b/inst/extdata/simple2x2/host_baylaurel_wsd.tif new file mode 100644 index 0000000000000000000000000000000000000000..6e32724b10b0db27c5e507283421b2f0f874e5ba GIT binary patch literal 1088 zcmbW0%}T>S5XUEJtU-$(h)O|ljVFbESqm0wXlaWqm?|cI++=AZ2yIf@=&1+4pdL!k zK7e=W3y9C)qxb;gY>beq7aGJYU{M=oZ6P6I<~{=$IUvkoOWOoUow@#OvV42Dir-Q zRj5qH(@D3bQrWd+HXRuA=gj?l`?r}(DZkBJE;0P(+;<3|=HKDNddq>P;_0wX-KrY} z{=hk7iMdvk2Hhy0Bglj9C`2KQB`!dJ86ws literal 0 HcmV?d00001 diff --git a/inst/extdata/simple2x2/host_oak_wsd.tif b/inst/extdata/simple2x2/host_oak_wsd.tif new file mode 100644 index 0000000000000000000000000000000000000000..9fe7d1eb8555fce33b99f1b685412276bebd15c0 GIT binary patch literal 1098 zcmbVL%}T>S5T2y5mQwshMG#!$NyRq(v8@n`!B$x?RZRT3$&4X5@H}NRq z(Yy2wJo^UTd(fN=mW030G7KhB4F#Ey^P40!$l z+y_1Ea7H=7O2tvBXhw2J zDwED8|0)|^@K4#0DMi!W)QMy^70>=%#hA?aicq>;_i%7gr-To1pI4^ds|`v3p{ literal 0 HcmV?d00001 diff --git a/inst/extdata/simple2x2/host_tanoak_wsd.tif b/inst/extdata/simple2x2/host_tanoak_wsd.tif new file mode 100644 index 0000000000000000000000000000000000000000..9bf2c56fe2cac78e84e378ff875c19249b4d051d GIT binary patch literal 1087 zcmbW0OH0E*5XUEJY^xL>6cs^mO)o0grnMFewY1nG3#N*RkDDwug3uo&V16uuJJ2gaIH5AOt`_67d&2EF$wUf-T^V z_hCQiGS`djpds_T0c?X85wrluXwEMq5JbL4 zerN}9R{)R5owf+m$nVIf_aa=N_!awS$ha*qnTZx4w^}N$sfNv}%x3ukLUPnL>cnJq zV_DYpqE0oPu4sE|ahIxFs!Up}-l*Z6BIi@dT!KgcBr6vyJ(~F}e*Q9A`I2qXSEcEt zQhEEg=}Kj7Ws`2`biHSXq-pWvRgKnu^RQtbTBe-0Et}Q$8Z~CxE#F;ysZLG#{I+mO`L~73C3>%%a}Ckt3!l{W-Elu(adr4k zomUqEe!)586LY*Mb=niSj1ca$LofkBeBuIJ#~{M}$dKgt+1SpiMwZefK{i^(QPrAP rjpjbHt>($+#0i`N^q+^H58kGpZlq}PHc~j72`fY@z}*#uUWPva2Uh4V literal 0 HcmV?d00001 diff --git a/inst/extdata/simple2x2/infected_baylaurel_wsd.tif b/inst/extdata/simple2x2/infected_baylaurel_wsd.tif new file mode 100644 index 0000000000000000000000000000000000000000..0b61691a225f5e8b4047f4e0e768170af022a9c0 GIT binary patch literal 1068 zcmbW0-%G+!6vxlzQVA&|N`#2pdMYrd6)5OPn#6@>(bkW*SZ;xkQ*=E923CSS_1quO zdkFmj{Q>A)y@b2Gd}ICj}zXR1fHMsX^TGI^B9kShRpniuut5?a0EER;kp-tFmez1 zu^+;y0G^NseI6E&-;lcxJY1mo73WvT7#7%ujUzx|ODS!umSdQPW60x#6sTj>iEY%a zqNwR5ooYJW)Q;8C5mon9k+h9^^9=VSQO*|9?C@`@a;Y*RN#(Hx%V_1BGbvD|>55W5 z_^UgmtZnYmU7hZXL`Yf<_IIY$uC{7Tr`E7Vxn`eQRmU;|Blwo2j3`ShS!vj^`J9wp z4ZdU~XL!RubH;oJI{TWl-`)L~vyAwcoE6fe56yjiILI4A`m~?xLAK)QusYpZivWAp zjIpp>%L{{k60hN+gMI{(5XQph;BFCO%uY=Tu3cI@+|o#HjikwL+d4NJDb;FK4X4rS c3^zK^1&DI*>-R77&s`y!kuJw?m6Le<1JD}b6#xJL literal 0 HcmV?d00001 diff --git a/inst/extdata/simple2x2/infected_oak_wsd.tif b/inst/extdata/simple2x2/infected_oak_wsd.tif new file mode 100644 index 0000000000000000000000000000000000000000..3503fadb363b4feadfef6f40b40b789d33eab543 GIT binary patch literal 1047 zcmbW0-%G+!6vxkgq#{yDR0uuX=2L;GP*9*Nb0Qa-iCaG&q8PeB&?&ll^1(9jt-m6A z4d42U`UCn4I(IIZ8P3{e_k8ZX=eu)uxQEhh2m!zf04D&4#N*3(m`7%N1c%`6FW@@h zGSfsk(a{D)fK`un&BN=i&ocUNc(hp$S6oIH(2!YN0mtGXf-}H1PLEF!2q51hzYPV< z3g8uaG~{6u`2)HC!b1bapSXTN#ET(@q`s%_SMGngt;T9Q*ce=QS={#hm#&Ns=Q zWttuC*D|H0dCHVYPTno&z5&QbWB9i2wy!CEULNz;8!)|qY!4su(uxeUChlh4a?uT>Tt&A-&><_ZQ|JDG z?jiJtMMUS`tShV;t~A5W`^=B;ytj{elx{;909F7vA8<%Kew>SWWVS}I`<(Rv&Vvp! z%`)e=wX1%BRhM?n#p}+Qbv(b}((b#s;xHZo6`A?yPpI@2=vL#1{)oIsS2-ve`jD=-e z-aj0~@ER^W9E2bSK`d+zp5qWsFKVcNs@BUxNfu)iqWm>R=ayU+PH-~ XAad|he3AMj^ii#S2cl1Mt-SOD&iCP$ literal 0 HcmV?d00001 From 1ecbba9a6b1941ffe8b35e3631f03403879695cc Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 29 Jan 2024 08:02:54 -0500 Subject: [PATCH 64/68] add tests for multihost --- tests/testthat/test-pops.r | 189 +++++++++++++++++++++++++++++++++---- 1 file changed, 172 insertions(+), 17 deletions(-) diff --git a/tests/testthat/test-pops.r b/tests/testthat/test-pops.r index dcd5e346..14b324af 100644 --- a/tests/testthat/test-pops.r +++ b/tests/testthat/test-pops.r @@ -1835,7 +1835,7 @@ test_that("Infected results with weather are less than those without weather", { system.file("extdata", "simple2x2", "critical_temp_all_below_threshold.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2010-12-31" - parameter_means <- c(2.0, 21, 1, 500, 0, 0, 0, 0) + parameter_means <- c(3.0, 21, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) coefficient_sd_file <- system.file("extdata", "simple2x2", "coefficient_sd.tif", package = "PoPS") pest_host_table <- @@ -2159,7 +2159,7 @@ test_that("Infected results are greater with higher reproductive rate", { system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" end_date <- "2010-12-31" - parameter_means <- c(1.0, 21, 1, 500, 0, 0, 0, 0) + parameter_means <- c(4.0, 15, 1, 500, 0, 0, 0, 0) parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) pest_host_table <- system.file("extdata", "pest_host_table_singlehost_nomort.csv", package = "PoPS") @@ -2177,7 +2177,7 @@ test_that("Infected results are greater with higher reproductive rate", { random_seed = 42, start_date = start_date, end_date = end_date) - parameter_means <- c(0.75, 21, 1, 500, 0, 0, 0, 0) + parameter_means <- c(3.0, 15, 1, 500, 0, 0, 0, 0) data_075 <- pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -2190,7 +2190,7 @@ test_that("Infected results are greater with higher reproductive rate", { random_seed = 42, start_date = start_date, end_date = end_date) - parameter_means <- c(0.5, 21, 1, 500, 0, 0, 0, 0) + parameter_means <- c(2.0, 15, 1, 500, 0, 0, 0, 0) data_050 <- pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -2203,7 +2203,7 @@ test_that("Infected results are greater with higher reproductive rate", { random_seed = 42, start_date = start_date, end_date = end_date) - parameter_means <- c(0.25, 21, 1, 500, 0, 0, 0, 0) + parameter_means <- c(1.0, 15, 1, 500, 0, 0, 0, 0) data_025 <- pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -2216,7 +2216,7 @@ test_that("Infected results are greater with higher reproductive rate", { random_seed = 42, start_date = start_date, end_date = end_date) - parameter_means <- c(0.1, 21, 1, 500, 0, 0, 0, 0) + parameter_means <- c(0.5, 15, 1, 500, 0, 0, 0, 0) data_010 <- pops(infected_file_list = infected_file_list, host_file_list = host_file_list, @@ -3508,6 +3508,50 @@ test_that("Using soils returns expected results", { }) test_that("Using multiple hosts works as expected", { + infected_file_list <- + c(system.file("extdata", "simple2x2", "infected_oak.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "infected_tanoak.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "infected_baylaurel.tif", package = "PoPS")) + host_file_list <- + c(system.file("extdata", "simple2x2", "host_oak.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "host_tanoak.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "host_baylaurel.tif", package = "PoPS")) + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + start_date <- "2008-01-01" + end_date <- "2009-12-31" + parameter_means <- c(0, 21, 1, 500, 0, 0, 100, 1000) + parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + coefficient_file <- + system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_multihost.csv", package = "PoPS") + + data <- + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, + parameter_means = parameter_means, + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, + start_date = start_date, + end_date = end_date, + temp = TRUE, + temperature_coefficient_file = coefficient_file) + + test_mat <- terra::as.matrix(terra::rast(infected_file_list[1]), wide = TRUE) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) + test_mat <- terra::as.matrix(terra::rast(infected_file_list[2]), wide = TRUE) + expect_gte(data$host_pools[[2]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[4]], test_mat[[4]]) + infected_file_list <- c(system.file("extdata", "simple2x2", "infected_oak.tif", package = "PoPS"), system.file("extdata", "simple2x2", "infected_tanoak.tif", package = "PoPS"), @@ -3541,13 +3585,35 @@ test_that("Using multiple hosts works as expected", { temp = TRUE, temperature_coefficient_file = coefficient_file) - test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) + test_mat <- terra::as.matrix(terra::rast(infected_file_list[1]), wide = TRUE) expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) - expect_equal(length(data$soil_reservoirs[[1]]), 20) - expect_equal(length(data$soil_reservoirs[[2]]), 20) + test_mat <- terra::as.matrix(terra::rast(infected_file_list[2]), wide = TRUE) + expect_gte(data$host_pools[[2]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[4]], test_mat[[4]]) + + + infected_file_list <- + c(system.file("extdata", "simple2x2", "infected_oak.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "infected_tanoak.tif", package = "PoPS")) + host_file_list <- + c(system.file("extdata", "simple2x2", "host_oak.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "host_tanoak.tif", package = "PoPS")) + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + start_date <- "2008-01-01" + end_date <- "2009-12-31" + parameter_means <- c(5, 21, 1, 500, 0, 0, 100, 1000) + parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + coefficient_file <- + system.file("extdata", "simple2x2", "temperature_coefficient.tif", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_2host.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_2host.csv", package = "PoPS") data <- pops(infected_file_list = infected_file_list, @@ -3560,17 +3626,106 @@ test_that("Using multiple hosts works as expected", { start_date = start_date, end_date = end_date, temp = TRUE, - temperature_coefficient_file = coefficient_file, - use_soils = use_soils, - dispersers_to_soils_percentage = dispersers_to_soils_percentage, - soil_starting_pest_file = infected_file_list, - start_with_soil_populations = TRUE) + temperature_coefficient_file = coefficient_file) - test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) + test_mat <- terra::as.matrix(terra::rast(infected_file_list[1]), wide = TRUE) expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) - expect_equal(length(data$soil_reservoirs[[1]]), 20) - expect_equal(length(data$soil_reservoirs[[2]]), 20) + test_mat <- terra::as.matrix(terra::rast(infected_file_list[2]), wide = TRUE) + expect_gte(data$host_pools[[2]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[4]], test_mat[[4]]) +}) + + +test_that("Using multiple hosts with uncertainty works as expected", { + infected_file_list <- + c(system.file("extdata", "simple2x2", "infected_oak_wsd.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "infected_tanoak_wsd.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "infected_baylaurel_wsd.tif", package = "PoPS")) + host_file_list <- + c(system.file("extdata", "simple2x2", "host_oak_wsd.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "host_tanoak_wsd.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "host_baylaurel_wsd.tif", package = "PoPS")) + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + start_date <- "2008-01-01" + end_date <- "2009-12-31" + parameter_means <- c(5, 21, 1, 500, 0, 0, 100, 1000) + parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + coefficient_file <- + system.file("extdata", "simple2x2", "coefficient_sd.tif", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_multihost.csv", package = "PoPS") + + data <- + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, + parameter_means = parameter_means, + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, + start_date = start_date, + end_date = end_date, + temp = TRUE, + temperature_coefficient_file = coefficient_file) + + test_mat <- terra::as.matrix(terra::rast(infected_file_list[1]), wide = TRUE) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) + test_mat <- terra::as.matrix(terra::rast(infected_file_list[2]), wide = TRUE) + expect_gte(data$host_pools[[2]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[4]], test_mat[[4]]) + + + infected_file_list <- + c(system.file("extdata", "simple2x2", "infected_oak_wsd.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "infected_tanoak_wsd.tif", package = "PoPS")) + host_file_list <- + c(system.file("extdata", "simple2x2", "host_oak_wsd.tif", package = "PoPS"), + system.file("extdata", "simple2x2", "host_tanoak_wsd.tif", package = "PoPS")) + total_populations_file <- + system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") + start_date <- "2008-01-01" + end_date <- "2009-12-31" + parameter_means <- c(5, 21, 1, 500, 0, 0, 100, 1000) + parameter_cov_matrix <- matrix(0, nrow = 8, ncol = 8) + coefficient_file <- + system.file("extdata", "simple2x2", "coefficient_sd.tif", package = "PoPS") + pest_host_table <- + system.file("extdata", "pest_host_table_2host.csv", package = "PoPS") + competency_table <- system.file("extdata", "competency_table_2host.csv", package = "PoPS") + + data <- + pops(infected_file_list = infected_file_list, + host_file_list = host_file_list, + total_populations_file = total_populations_file, + parameter_means = parameter_means, + parameter_cov_matrix = parameter_cov_matrix, + pest_host_table = pest_host_table, + competency_table = competency_table, + start_date = start_date, + end_date = end_date, + temp = TRUE, + temperature_coefficient_file = coefficient_file) + + test_mat <- terra::as.matrix(terra::rast(infected_file_list[1]), wide = TRUE) + expect_gte(data$host_pools[[1]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[1]]$infected[[1]][[4]], test_mat[[4]]) + test_mat <- terra::as.matrix(terra::rast(infected_file_list[2]), wide = TRUE) + expect_gte(data$host_pools[[2]]$infected[[1]][[1]], test_mat[[1]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[2]], test_mat[[2]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[3]], test_mat[[3]]) + expect_gte(data$host_pools[[2]]$infected[[1]][[4]], test_mat[[4]]) }) From 547a8da4ab75449a1fa52176246818e326be0682 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 29 Jan 2024 11:46:02 -0500 Subject: [PATCH 65/68] add set.seed --- R/calibrate.R | 1 + R/configuration.R | 4 +++- R/pops_multirun.R | 1 + R/validate.R | 1 + 4 files changed, 6 insertions(+), 1 deletion(-) diff --git a/R/calibrate.R b/R/calibrate.R index b6f6a038..64e3338a 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -322,6 +322,7 @@ calibrate <- function(infected_years_file, network_max_distance) { config$random_seed <- sample(1:999999999999, 1, replace = FALSE) + set.seed(config$random_seed[[1]]) random_seeds <- create_random_seeds(1) config <- host_pool_setup(config) while (any(config$total_hosts > config$total_populations) || diff --git a/R/configuration.R b/R/configuration.R index 04607c48..6f15150f 100644 --- a/R/configuration.R +++ b/R/configuration.R @@ -25,9 +25,11 @@ configuration <- function(config) { config$rclmat <- matrix(config$rcl, ncol = 3, byrow = TRUE) if (is.null(config$random_seed)) { - config$random_seed <- sample(1:999999999999, config$number_of_iterations, replace = FALSE) + config$random_seed <- as.integer(sample.int(1e9, config$number_of_iterations, replace = FALSE)) } + set.seed(config$random_seed[[1]]) + if (config$multiple_random_seeds) { if (!is.null(config$file_random_seeds)) { ## check random seed file diff --git a/R/pops_multirun.R b/R/pops_multirun.R index aa348087..921a92c4 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -219,6 +219,7 @@ pops_multirun <- function(infected_file_list, .packages = c("PoPS", "terra") ) %dopar% { + set.seed(config$random_seed[[i]]) config <- draw_parameters(config) # draws parameter set for the run config <- host_pool_setup(config) while (any(config$total_hosts > config$total_populations) || diff --git a/R/validate.R b/R/validate.R index 38cc4eab..e10e347b 100644 --- a/R/validate.R +++ b/R/validate.R @@ -237,6 +237,7 @@ validate <- function(infected_years_file, .packages = c("terra", "PoPS", "foreach") ) %dopar% { + set.seed(config$random_seed[[i]]) config <- draw_parameters(config) # draws parameter set for the run config <- host_pool_setup(config) while (any(config$total_hosts > config$total_populations) || From 0f6e559e884cfa41e95d3924b258a1a6415c0b02 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 29 Jan 2024 13:44:58 -0500 Subject: [PATCH 66/68] update multihost tests --- tests/testthat/test-pops-multirun.R | 84 ++++++++++++++++++++++++++--- 1 file changed, 77 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test-pops-multirun.R b/tests/testthat/test-pops-multirun.R index 17fa8b55..a282b5d7 100644 --- a/tests/testthat/test-pops-multirun.R +++ b/tests/testthat/test-pops-multirun.R @@ -518,7 +518,7 @@ test_that("Multirun model outputs work with mask", { anthropogenic_dir <- "NONE" pesticide_duration <- c(0) pesticide_efficacy <- 1.0 - random_seed <- 42 + random_seed <- NULL output_frequency <- "year" movements_file <- "" use_movements <- FALSE @@ -556,6 +556,24 @@ test_that("Multirun model outputs work with mask", { write_outputs <- "None" output_folder_path <- tempdir() network_filename <- "" + quarantine_directions <- "" + multiple_random_seeds <- TRUE + file_random_seeds <- NULL + use_soils <- FALSE + soil_starting_pest_file <- "" + start_with_soil_populations <- FALSE + use_initial_condition_uncertainty <- FALSE + use_host_uncertainty <- FALSE + weather_type <- "deterministic" + temperature_coefficient_sd_file <- "" + precipitation_coefficient_sd_file <- "" + dispersers_to_soils_percentage <- 0 + quarantine_directions <- "" + multiple_random_seeds <- FALSE + file_random_seeds <- NULL + use_soils <- FALSE + soil_starting_pest_file <- "" + start_with_soil_populations <- FALSE data <- pops_multirun(infected_file_list, host_file_list, @@ -621,7 +639,19 @@ test_that("Multirun model outputs work with mask", { write_outputs, output_folder_path, network_filename, - network_movement) + network_movement, + use_initial_condition_uncertainty = FALSE, + use_host_uncertainty = FALSE, + weather_type = "deterministic", + temperature_coefficient_sd_file = "", + precipitation_coefficient_sd_file = "", + dispersers_to_soils_percentage = 0, + quarantine_directions = "", + multiple_random_seeds = FALSE, + file_random_seeds = NULL, + use_soils = FALSE, + soil_starting_pest_file = "", + start_with_soil_populations = FALSE) expect_equal(length(data), 17) expect_equal(terra::as.matrix(data$median_run[[1]], wide = TRUE), @@ -712,7 +742,17 @@ test_that("Multirun model outputs work with mask", { network_filename, network_movement, use_initial_condition_uncertainty, - use_host_uncertainty) + use_host_uncertainty, + weather_type = "deterministic", + temperature_coefficient_sd_file = "", + precipitation_coefficient_sd_file = "", + dispersers_to_soils_percentage = 0, + quarantine_directions = "", + multiple_random_seeds = FALSE, + file_random_seeds = NULL, + use_soils = FALSE, + soil_starting_pest_file = "", + start_with_soil_populations = FALSE) expect_equal(length(data), 17) expect_equal(data$west_rate[[1]], 0) @@ -797,7 +837,17 @@ test_that("Multirun model outputs work with mask", { network_filename, network_movement, use_initial_condition_uncertainty, - use_host_uncertainty) + use_host_uncertainty, + weather_type = "deterministic", + temperature_coefficient_sd_file = "", + precipitation_coefficient_sd_file = "", + dispersers_to_soils_percentage = 0, + quarantine_directions = "", + multiple_random_seeds = FALSE, + file_random_seeds = NULL, + use_soils = FALSE, + soil_starting_pest_file = "", + start_with_soil_populations = FALSE) expect_equal(length(data), 17) expect_equal(data$west_rate[[1]], 0) @@ -883,7 +933,17 @@ test_that("Multirun model outputs work with mask", { network_filename, network_movement, use_initial_condition_uncertainty, - use_host_uncertainty) + use_host_uncertainty, + weather_type = "deterministic", + temperature_coefficient_sd_file = "", + precipitation_coefficient_sd_file = "", + dispersers_to_soils_percentage = 0, + quarantine_directions = "", + multiple_random_seeds = FALSE, + file_random_seeds = NULL, + use_soils = FALSE, + soil_starting_pest_file = "", + start_with_soil_populations = FALSE) expect_equal(length(data), 17) expect_equal(data$west_rate[[1]], 0) @@ -969,7 +1029,17 @@ test_that("Multirun model outputs work with mask", { network_filename, network_movement, use_initial_condition_uncertainty, - use_host_uncertainty) + use_host_uncertainty, + weather_type = "deterministic", + temperature_coefficient_sd_file = "", + precipitation_coefficient_sd_file = "", + dispersers_to_soils_percentage = 0, + quarantine_directions = "", + multiple_random_seeds = FALSE, + file_random_seeds = NULL, + use_soils = FALSE, + soil_starting_pest_file = "", + start_with_soil_populations = FALSE) expect_equal(length(data), 17) expect_equal(data$west_rate[[1]], 0) @@ -1016,7 +1086,7 @@ test_that("Multirun model outputs work with writing all simulations and random s anthropogenic_dir <- "NONE" pesticide_duration <- c(0) pesticide_efficacy <- 1.0 - random_seed <- 42 + random_seed <- NULL output_frequency <- "year" movements_file <- "" use_movements <- FALSE From 05f36f72c3316bbd3e604fbcb6f2b1c9c7ac7cec Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 29 Jan 2024 14:11:45 -0500 Subject: [PATCH 67/68] export output host pools from all runs --- R/pops_multirun.R | 6 ++++-- tests/testthat/test-pops-multirun.R | 20 ++++++++++---------- 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/R/pops_multirun.R b/R/pops_multirun.R index 921a92c4..2eee7256 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -674,7 +674,8 @@ pops_multirun <- function(infected_file_list, north_distance_to_quarantine, south_distance_to_quarantine, east_distance_to_quarantine, - west_distance_to_quarantine + west_distance_to_quarantine, + output_host_pools_runs ) names(outputs) <- @@ -695,7 +696,8 @@ pops_multirun <- function(infected_file_list, "north_distance_to_quarantine", "south_distance_to_quarantine", "east_distance_to_quarantine", - "west_distance_to_quarantine" + "west_distance_to_quarantine", + "output_host_pools_runs" ) if (config$write_outputs %in% config$output_write_list) { diff --git a/tests/testthat/test-pops-multirun.R b/tests/testthat/test-pops-multirun.R index a282b5d7..ca55c515 100644 --- a/tests/testthat/test-pops-multirun.R +++ b/tests/testthat/test-pops-multirun.R @@ -182,7 +182,7 @@ test_that("Multirun model outputs work", { use_initial_condition_uncertainty, use_host_uncertainty) - expect_equal(length(data), 17) + expect_equal(length(data), 18) expect_equal(terra::as.matrix(data$median_run[[1]], wide = TRUE), terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) # expect_equal(terra::as.matrix(data$susceptible_run[[1]], wide = TRUE), @@ -284,7 +284,7 @@ test_that("Multirun model outputs work", { soil_starting_pest_file = "", start_with_soil_populations = FALSE) - expect_equal(length(data), 17) + expect_equal(length(data), 18) expect_equal(terra::as.matrix(data$median_run[[1]], wide = TRUE), terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) # expect_equal(terra::as.matrix(data$susceptible_run[[1]], wide = TRUE), @@ -375,7 +375,7 @@ test_that("Multirun model outputs work", { network_filename, network_movement) - expect_equal(length(data), 17) + expect_equal(length(data), 18) expect_equal(terra::as.matrix(data$median_run[[1]], wide = TRUE), terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) # expect_equal(terra::as.matrix(data$susceptible_run[[1]], wide = TRUE), @@ -463,7 +463,7 @@ test_that("Multirun model outputs work", { network_filename, network_movement) - expect_equal(length(data), 17) + expect_equal(length(data), 18) expect_equal(terra::as.matrix(data$median_run[[1]], wide = TRUE), terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) # expect_equal(terra::as.matrix(data$susceptible_run[[1]], wide = TRUE), @@ -653,7 +653,7 @@ test_that("Multirun model outputs work with mask", { soil_starting_pest_file = "", start_with_soil_populations = FALSE) - expect_equal(length(data), 17) + expect_equal(length(data), 18) expect_equal(terra::as.matrix(data$median_run[[1]], wide = TRUE), terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(data$number_infecteds[[1]], 1) @@ -754,7 +754,7 @@ test_that("Multirun model outputs work with mask", { soil_starting_pest_file = "", start_with_soil_populations = FALSE) - expect_equal(length(data), 17) + expect_equal(length(data), 18) expect_equal(data$west_rate[[1]], 0) expect_equal(data$west_rate[[2]], 0) expect_equal(data$east_rate[[1]], 0) @@ -849,7 +849,7 @@ test_that("Multirun model outputs work with mask", { soil_starting_pest_file = "", start_with_soil_populations = FALSE) - expect_equal(length(data), 17) + expect_equal(length(data), 18) expect_equal(data$west_rate[[1]], 0) expect_equal(data$west_rate[[2]], 0) expect_equal(data$east_rate[[1]], 0) @@ -945,7 +945,7 @@ test_that("Multirun model outputs work with mask", { soil_starting_pest_file = "", start_with_soil_populations = FALSE) - expect_equal(length(data), 17) + expect_equal(length(data), 18) expect_equal(data$west_rate[[1]], 0) expect_equal(data$west_rate[[2]], 0) expect_equal(data$east_rate[[1]], 0) @@ -1041,7 +1041,7 @@ test_that("Multirun model outputs work with mask", { soil_starting_pest_file = "", start_with_soil_populations = FALSE) - expect_equal(length(data), 17) + expect_equal(length(data), 18) expect_equal(data$west_rate[[1]], 0) expect_equal(data$west_rate[[2]], 0) expect_equal(data$east_rate[[1]], 0) @@ -1216,7 +1216,7 @@ test_that("Multirun model outputs work with writing all simulations and random s soil_starting_pest_file, start_with_soil_populations) - expect_equal(length(data), 17) + expect_equal(length(data), 18) expect_equal(terra::as.matrix(data$median_run[[1]], wide = TRUE), terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) expect_equal(data$number_infecteds[[1]], 1) From f059bc1188d8e47f5519029d16f642a74dbf8d12 Mon Sep 17 00:00:00 2001 From: Chris Jones Date: Mon, 29 Jan 2024 15:01:05 -0500 Subject: [PATCH 68/68] fix cal error --- R/calibrate.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/calibrate.R b/R/calibrate.R index 64e3338a..ee6cf2ff 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -321,7 +321,7 @@ calibrate <- function(infected_years_file, network_min_distance, network_max_distance) { - config$random_seed <- sample(1:999999999999, 1, replace = FALSE) + config$random_seed <- as.integer(sample.int(1e9, 1, replace = FALSE)) set.seed(config$random_seed[[1]]) random_seeds <- create_random_seeds(1) config <- host_pool_setup(config)