diff --git a/R/RcppExports.R b/R/RcppExports.R index 8d188761..98e9d486 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -1,8 +1,8 @@ # 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 diff --git a/R/calibrate.R b/R/calibrate.R index 506fe866..ee6cf2ff 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -123,8 +123,10 @@ 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, + pest_host_table, + competency_table, + infected_file_list, + host_file_list, total_populations_file, temp = FALSE, temperature_coefficient_file = "", @@ -145,9 +147,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, @@ -183,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 = "", @@ -213,8 +212,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 @@ -235,9 +234,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 @@ -272,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. @@ -296,6 +292,8 @@ 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 + config$competency_table <- competency_table # call configuration function to perform data checks and transform data into # format used in pops c++ @@ -323,49 +321,16 @@ 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) - 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$infected_mean, config$infected_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) + 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, @@ -377,21 +342,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, @@ -407,8 +367,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, @@ -590,16 +548,21 @@ 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 quantity_allocation_disagreement(reference, comparison, @@ -609,7 +572,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 @@ -928,16 +891,21 @@ 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 quantity_allocation_disagreement(reference, comparison, @@ -947,7 +915,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 @@ -1102,26 +1070,31 @@ 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]] 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/R/checks.R b/R/checks.R index 94e4cefe..a6a4573b 100644 --- a/R/checks.R +++ b/R/checks.R @@ -312,6 +312,79 @@ 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_passed <- FALSE + failed_check <- multihost_file_length_error + } + + if (!checks_passed && length(infected_file_list) != (ncol(competency_table) - 2)) { + checks_passed <- FALSE + 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 + } 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 + } + + 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 + } else { + 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)) { + mortality_on <- TRUE + } else { + mortality_on <- FALSE + } + + if (checks_passed) { + outs <- + 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", "pest_host_table2") + return(outs) + } else { + outs <- list(checks_passed, failed_check) + names(outs) <- failed_check_list + return(outs) + } +} + multispecies_checks <- function(species, infected_files, parameter_means, diff --git a/R/configuration.R b/R/configuration.R index 81ddda0f..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 @@ -47,11 +49,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) } } @@ -75,6 +79,23 @@ configuration <- function(config) { return(config) } + 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 <- + 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 + config$competency_table_list <- multihost_check$competency_table_list + config$mortality_on <- multihost_check$mortality_on + } else { + config$failure <- multihost_check$failed_check + return(config) + } + seasons <- seq(1, 12, 1) if (config$season_month_start %in% seasons && config$season_month_end %in% seasons) { @@ -84,6 +105,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 @@ -131,54 +153,12 @@ configuration <- function(config) { return(config) } - # check that initial raster file exists - if (config$function_name %in% aws_bucket_list) { - infected_check <- initial_raster_checks(config$infected_file, config$use_s3, config$bucket) - } else { - infected_check <- initial_raster_checks(config$infected_file) - } - 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) - } - - zero_rast <- infected[[1]] - terra::values(zero_rast) <- 0 - zero_matrix <- terra::as.matrix(zero_rast, wide = TRUE) - - one_matrix <- infected[[1]] - 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) + initial_raster_checks(config$total_populations_file, config$use_s3, config$bucket) } else { - total_populations_check <- secondary_raster_checks(config$total_populations_file, infected) + total_populations_check <- initial_raster_checks(config$total_populations_file) } if (total_populations_check$checks_passed) { total_populations <- total_populations_check$raster @@ -190,6 +170,16 @@ configuration <- function(config) { return(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 + one_matrix <- terra::as.matrix(one_matrix, wide = TRUE) + # 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) @@ -201,9 +191,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 @@ -225,9 +215,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 @@ -254,9 +245,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 @@ -285,19 +277,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) } } @@ -332,20 +324,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) } } @@ -382,19 +374,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) } } @@ -476,9 +468,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) { @@ -511,7 +504,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 @@ -527,65 +520,217 @@ configuration <- function(config) { config$movements_dates <- config$start_date } - 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 + # loop over infected and host files to create multi-host setup + 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 + + 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 + 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_list[i]) + } + return(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) + 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 { - exposed_check <- secondary_raster_checks(config$exposed_file, infected) + infected_mean <- terra::as.matrix(infected[[1]], wide = TRUE) + infected_sd <- zero_matrix + } + 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 + total_infecteds <- total_infecteds + infected_mean + # prepare exposed + exposed <- list(zero_matrix) + if (config$model_type == "SEI" && config$latency_period > 1) { + for (ex in 2:(config$latency_period + 1)) { + exposed[[ex]] <- zero_matrix + } } - 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 (config$model_type == "SEI" && config$start_exposed) { + if (config$function_name %in% aws_bucket_list) { + exposed_check <- + secondary_raster_checks(config$exposed_file_list[i], total_populations, config$use_s3, + config$bucket) + } else { + exposed_check <- secondary_raster_checks(config$exposed_file_list[i], total_populations) + } + 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 } + total_exposed <- exposed_mean } 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_list[i]) + } + return(config) } } else { - config$failure <- exposed_check$failed_check + total_exposed <- zero_matrix + exposed_mean <- zero_matrix + exposed_sd <- zero_matrix + } + + 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 + 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) { + 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$exposed_file) + config$failure <- detailed_file_exists_error(config$host_file_list[i]) } return(config) } - } else { - exposed_mean <- zero_matrix - exposed_sd <- zero_matrix + + 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_hosts <- host_mean + total_hosts <- total_hosts + host_mean + + susceptible <- host_mean - infected_mean - exposed_mean + susceptible[susceptible < 0] <- 0 + host_pool$susceptible <- terra::as.matrix(susceptible, wide = TRUE) + + host_pool$mortality <- zero_matrix + host_pool$resistant <- zero_matrix + + mortality_tracker <- list(zero_matrix) + if (config$mortality_on) { + 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 + mortality_tracker[[length(mortality_tracker)]] <- infected_mean + } + + host_pool$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_pools[[i]] <- host_pool } - config$exposed_mean <- exposed_mean - config$exposed_sd <- exposed_sd + 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) - # 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 (any(config$total_hosts > config$total_populations)) { + config$failure <- multihosts_gt_totpop_error + return(config) } - if (config$use_initial_condition_uncertainty && terra::nlyr(infected) > 1) { - suitable <- suitable + infected[[2]] + + if (any(config$total_exposed > config$total_populations)) { + config$failure <- multiinfected_gt_totpop_error + return(config) } - 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]] - } + + if (any(config$total_infecteds > config$total_populations)) { + config$failure <- multiexposed_gt_totpop_error + return(config) } + + 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_points <- terra::as.points(suitable) names(suitable_points) <- "data" suitable_points <- suitable_points[suitable_points$data > 0] @@ -615,21 +760,6 @@ 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) { mask_check <- secondary_raster_checks(config$mask, infected, config$use_s3, config$bucket) @@ -660,34 +790,6 @@ 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 - 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) { @@ -712,23 +814,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()) { diff --git a/R/error_messages.R b/R/error_messages.R index b434b0b0..99febb95 100644 --- a/R/error_messages.R +++ b/R/error_messages.R @@ -172,3 +172,39 @@ 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" + +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" + +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." diff --git a/R/helpers.R b/R/helpers.R index b702de46..dc477161 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -270,3 +270,85 @@ 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" + while (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_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) { + 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) { + 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 <- host_pool$exposed + exposed[[config$latency_period + 1]] <- exposed2 + 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) { + 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 + total_hosts <- total_hosts + host + } + + 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 + mortality_tracker[[length(mortality_tracker)]] <- host_pool$infected + host_pool$mortality_tracker <- mortality_tracker + } + 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/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") diff --git a/R/pops.r b/R/pops.r index d4a61a97..3a7f07b1 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 @@ -50,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 @@ -105,8 +102,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 @@ -133,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. @@ -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 @@ -185,6 +186,15 @@ #' 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: 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. +#' @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. +#' #' #' @useDynLib PoPS, .registration = TRUE #' @importFrom terra app rast xres yres classify extract ext as.points ncol nrow project @@ -198,11 +208,13 @@ #' @export #' -pops <- function(infected_file, - host_file, +pops <- function(infected_file_list, + host_file_list, total_populations_file, parameter_means, parameter_cov_matrix, + pest_host_table, + competency_table, temp = FALSE, temperature_coefficient_file = "", precip = FALSE, @@ -222,9 +234,6 @@ pops <- function(infected_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, @@ -256,7 +265,7 @@ pops <- function(infected_file, overpopulation_percentage = 0, leaving_percentage = 0, leaving_scale_coefficient = 1, - exposed_file = "", + exposed_file_list = "", mask = NULL, network_filename = "", network_movement = "walk", @@ -275,8 +284,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 @@ -299,9 +308,6 @@ pops <- function(infected_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 @@ -340,7 +346,7 @@ pops <- function(infected_file, # 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 @@ -359,6 +365,8 @@ pops <- function(infected_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$competency_table <- competency_table config <- configuration(config) @@ -367,48 +375,13 @@ pops <- function(infected_file, } 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$infected_mean, config$infected_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) + 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], multiple_random_seeds = config$multiple_random_seeds, @@ -419,21 +392,16 @@ pops <- function(infected_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, @@ -449,8 +417,6 @@ pops <- function(infected_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_model.R b/R/pops_model.R index 547ca876..53319722 100644 --- a/R/pops_model.R +++ b/R/pops_model.R @@ -9,13 +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_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 mortality_on Boolean to indicate if mortality is used +#' @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 @@ -33,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". @@ -99,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, @@ -129,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", @@ -235,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 = competency_table, + pest_host_table = pest_host_table, 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, @@ -264,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, @@ -281,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, diff --git a/R/pops_multirun.R b/R/pops_multirun.R index ff723b58..2eee7256 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -33,11 +33,13 @@ #' @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, + pest_host_table, + competency_table, temp = FALSE, temperature_coefficient_file = "", precip = FALSE, @@ -57,9 +59,6 @@ pops_multirun <- function(infected_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, @@ -93,7 +92,7 @@ pops_multirun <- function(infected_file, overpopulation_percentage = 0, leaving_percentage = 0, leaving_scale_coefficient = 1, - exposed_file = "", + exposed_file_list = "", mask = NULL, write_outputs = "None", output_folder_path = "", @@ -113,8 +112,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 @@ -137,9 +136,6 @@ pops_multirun <- function(infected_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 @@ -176,7 +172,7 @@ pops_multirun <- function(infected_file, # 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 @@ -195,6 +191,8 @@ pops_multirun <- function(infected_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$competency_table <- competency_table config <- configuration(config) @@ -221,52 +219,18 @@ pops_multirun <- function(infected_file, .packages = c("PoPS", "terra") ) %dopar% { + set.seed(config$random_seed[[i]]) 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$infected_mean, config$infected_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) + 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( - 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, @@ -275,21 +239,16 @@ pops_multirun <- function(infected_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, @@ -305,8 +264,6 @@ pops_multirun <- function(infected_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, @@ -352,74 +309,107 @@ pops_multirun <- function(infected_file, 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]] + terra::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) { + 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]] + 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) { + terra::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 @@ -441,7 +431,7 @@ pops_multirun <- function(infected_file, } 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]] @@ -451,7 +441,7 @@ pops_multirun <- function(infected_file, 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 <- @@ -504,9 +494,8 @@ pops_multirun <- function(infected_file, 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(probability_runs) * 100 + escape_probability <- escape_probability / length(total_infecteds_runs) * 100 if ( length(quarantine_escape_distances[quarantine_escape_directions == "N"]) > 0) { @@ -521,7 +510,7 @@ pops_multirun <- function(infected_file, } ), 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 ( @@ -538,7 +527,7 @@ pops_multirun <- function(infected_file, } ), 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 ( @@ -555,7 +544,7 @@ pops_multirun <- function(infected_file, } ), 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 ( @@ -572,14 +561,14 @@ pops_multirun <- function(infected_file, } ), 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))) @@ -588,19 +577,17 @@ pops_multirun <- function(infected_file, 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]] } } @@ -620,7 +607,6 @@ pops_multirun <- function(infected_file, 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" @@ -633,15 +619,12 @@ pops_multirun <- function(infected_file, 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 @@ -680,9 +663,7 @@ pops_multirun <- function(infected_file, simulation_sd_stack, simulation_min_stack, simulation_max_stack, - single_run, - susceptible_run, - exposed_run, + median_run, number_infecteds, infected_areas, west_rate, @@ -693,7 +674,8 @@ pops_multirun <- function(infected_file, 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) <- @@ -703,9 +685,7 @@ pops_multirun <- function(infected_file, "simulation_sd", "simulation_min", "simulation_max", - "single_run", - "susceptible_run", - "exposed_run", + "median_run", "number_infecteds", "infected_areas", "west_rate", @@ -716,7 +696,8 @@ pops_multirun <- function(infected_file, "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/R/validate.R b/R/validate.R index 8fb4e7bb..e10e347b 100644 --- a/R/validate.R +++ b/R/validate.R @@ -51,8 +51,10 @@ validate <- function(infected_years_file, number_of_cores = NA, parameter_means, parameter_cov_matrix, - infected_file, - host_file, + pest_host_table, + competency_table, + infected_file_list, + host_file_list, total_populations_file, temp = FALSE, temperature_coefficient_file = "", @@ -73,9 +75,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, @@ -107,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 = "", @@ -129,8 +128,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 @@ -153,9 +152,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 @@ -193,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 @@ -214,6 +210,8 @@ 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$competency_table <- competency_table config <- configuration(config) @@ -225,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 @@ -240,49 +237,15 @@ 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 - - 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$infected_mean, config$infected_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) + 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[i], @@ -294,21 +257,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, @@ -324,8 +282,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, @@ -374,15 +330,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% - comparison <- terra::rast(config$infected_file)[[1]] + # terra objects are pointers + comparison <- terra::rast(config$infected_file_list[[1]])[[1]] + terra::values(comparison) <- 0 reference <- comparison mask <- comparison - terra::values(comparison) <- data$infected[[q]] + 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 <- 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/competency_table_multihost.csv b/inst/extdata/competency_table_multihost.csv new file mode 100644 index 00000000..16a43fa8 --- /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,0.7,0.1 +0,0,1,0.8,0.05 \ 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 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_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 diff --git a/inst/extdata/pest_host_table_singlehost.csv b/inst/extdata/pest_host_table_singlehost.csv new file mode 100644 index 00000000..c121dc6e --- /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.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 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 diff --git a/inst/extdata/simple2x2/host.tif b/inst/extdata/simple2x2/host.tif new file mode 100644 index 00000000..b857edf4 Binary files /dev/null and b/inst/extdata/simple2x2/host.tif differ diff --git a/inst/extdata/simple2x2/host_baylaurel.tif b/inst/extdata/simple2x2/host_baylaurel.tif new file mode 100644 index 00000000..61d1bfc0 Binary files /dev/null and b/inst/extdata/simple2x2/host_baylaurel.tif differ diff --git a/inst/extdata/simple2x2/host_baylaurel_wsd.tif b/inst/extdata/simple2x2/host_baylaurel_wsd.tif new file mode 100644 index 00000000..6e32724b Binary files /dev/null and b/inst/extdata/simple2x2/host_baylaurel_wsd.tif differ diff --git a/inst/extdata/simple2x2/host_oak.tif b/inst/extdata/simple2x2/host_oak.tif new file mode 100644 index 00000000..b857edf4 Binary files /dev/null and b/inst/extdata/simple2x2/host_oak.tif differ diff --git a/inst/extdata/simple2x2/host_oak_wsd.tif b/inst/extdata/simple2x2/host_oak_wsd.tif new file mode 100644 index 00000000..9fe7d1eb Binary files /dev/null and b/inst/extdata/simple2x2/host_oak_wsd.tif differ diff --git a/inst/extdata/simple2x2/host_tanoak.tif b/inst/extdata/simple2x2/host_tanoak.tif new file mode 100644 index 00000000..87439f05 Binary files /dev/null and b/inst/extdata/simple2x2/host_tanoak.tif differ diff --git a/inst/extdata/simple2x2/host_tanoak_wsd.tif b/inst/extdata/simple2x2/host_tanoak_wsd.tif new file mode 100644 index 00000000..9bf2c56f Binary files /dev/null and b/inst/extdata/simple2x2/host_tanoak_wsd.tif differ diff --git a/inst/extdata/simple2x2/infected_baylaurel.tif b/inst/extdata/simple2x2/infected_baylaurel.tif new file mode 100644 index 00000000..c14e4921 Binary files /dev/null and b/inst/extdata/simple2x2/infected_baylaurel.tif differ diff --git a/inst/extdata/simple2x2/infected_baylaurel_wsd.tif b/inst/extdata/simple2x2/infected_baylaurel_wsd.tif new file mode 100644 index 00000000..0b61691a Binary files /dev/null and b/inst/extdata/simple2x2/infected_baylaurel_wsd.tif differ diff --git a/inst/extdata/simple2x2/infected_oak.tif b/inst/extdata/simple2x2/infected_oak.tif new file mode 100644 index 00000000..6d3aeb70 Binary files /dev/null and b/inst/extdata/simple2x2/infected_oak.tif differ diff --git a/inst/extdata/simple2x2/infected_oak_wsd.tif b/inst/extdata/simple2x2/infected_oak_wsd.tif new file mode 100644 index 00000000..3503fadb Binary files /dev/null and b/inst/extdata/simple2x2/infected_oak_wsd.tif differ diff --git a/inst/extdata/simple2x2/infected_tanoak.tif b/inst/extdata/simple2x2/infected_tanoak.tif new file mode 100644 index 00000000..946cc401 Binary files /dev/null and b/inst/extdata/simple2x2/infected_tanoak.tif differ diff --git a/inst/extdata/simple2x2/infected_tanoak_wsd.tif b/inst/extdata/simple2x2/infected_tanoak_wsd.tif new file mode 100644 index 00000000..0192d7df Binary files /dev/null and b/inst/extdata/simple2x2/infected_tanoak_wsd.tif differ diff --git a/inst/extdata/simple2x2/total_plants.tif b/inst/extdata/simple2x2/total_plants.tif index 953005ed..a301515f 100644 Binary files a/inst/extdata/simple2x2/total_plants.tif and b/inst/extdata/simple2x2/total_plants.tif differ 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/man/calibrate.Rd b/man/calibrate.Rd index 16d1df22..75cbbfe7 100644 --- a/man/calibrate.Rd +++ b/man/calibrate.Rd @@ -13,8 +13,10 @@ 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, + competency_table, + infected_file_list, + host_file_list, total_populations_file, temp = FALSE, temperature_coefficient_file = "", @@ -35,9 +37,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, @@ -73,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 = "", @@ -153,14 +152,25 @@ 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 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{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{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 +239,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 +305,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} @@ -350,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). @@ -383,7 +390,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..8c8c6b05 100644 --- a/man/pops.Rd +++ b/man/pops.Rd @@ -5,11 +5,13 @@ \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, + competency_table, temp = FALSE, temperature_coefficient_file = "", precip = FALSE, @@ -29,9 +31,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, @@ -63,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", @@ -82,14 +81,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 +108,16 @@ 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: 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{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{temp}{boolean that allows the use of temperature coefficients to modify spread (TRUE or FALSE)} @@ -167,13 +177,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 +233,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} @@ -270,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 @@ -285,7 +292,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..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{mortality_on}{Boolean to turn host mortality on and off (TRUE or FALSE)} +\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_tracker}{matrix of 0's to track mortality per year} +\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}{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, @@ -193,11 +182,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..b89455b9 100644 --- a/man/pops_multirun.Rd +++ b/man/pops_multirun.Rd @@ -5,11 +5,13 @@ \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, + competency_table, temp = FALSE, temperature_coefficient_file = "", precip = FALSE, @@ -29,9 +31,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, @@ -65,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 = "", @@ -86,14 +85,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 +112,16 @@ 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: 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{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{temp}{boolean that allows the use of temperature coefficients to modify spread (TRUE or FALSE)} @@ -171,13 +181,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 +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} @@ -280,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 @@ -301,7 +308,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..d2792d91 100644 --- a/man/validate.Rd +++ b/man/validate.Rd @@ -11,8 +11,10 @@ validate( number_of_cores = NA, parameter_means, parameter_cov_matrix, - infected_file, - host_file, + pest_host_table, + competency_table, + infected_file_list, + host_file_list, total_populations_file, temp = FALSE, temperature_coefficient_file = "", @@ -33,9 +35,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, @@ -67,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 = "", @@ -105,14 +104,25 @@ 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 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{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{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 +191,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 +249,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} @@ -286,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.} @@ -311,7 +318,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} 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..e76c7463 100644 --- a/src/pops.cpp +++ b/src/pops.cpp @@ -32,6 +32,27 @@ 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; + 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 +65,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 +89,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 +161,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 +206,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 +266,56 @@ 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); + config.read_pest_host_table(pest_host_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; + InputHostPool input_host_pool; + host_pool_vector.reserve(host_pools.size()); + host_pool_vector_plain.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"]); + std::vector exposed = host_pools[i]["exposed"]; + 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); + } + for (unsigned i = 0; i < host_pools.size(); i++) { + host_pool_vector.emplace_back(new PoPSModel::StandardSingleHostPool( + mt, + input_host_pool.susceptible[i], + input_host_pool.exposed[i], + config.latency_period_steps, + 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, + 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 +402,35 @@ 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 = input_host_pool.mortality[i]; + 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++) { + 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; + if (config.model_type == "SEI") { + 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 = input_host_pool.exposed[i]; + } + output_host_pool_vector[i].exposed.push_back(exposed_v); + num_infected += sum_of_infected(input_host_pool.infected[i], spatial_indices); + all_infected += input_host_pool.infected[i]; } - 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 +442,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 +472,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, 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-configuration.R b/tests/testthat/test-configuration.R index f171420b..a1a4585d 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 <- "" @@ -478,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) diff --git a/tests/testthat/test-pops-multirun.R b/tests/testthat/test-pops-multirun.R index cee9b685..ca55c515 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), 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), + # 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), 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), + # 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), 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), + # 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), 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), + # 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" @@ -523,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 @@ -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,36 @@ 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 <- "" + 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, - 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 +601,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 +634,28 @@ 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) + 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), 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), 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) expect_equal(data$number_infecteds[[2]], 0) expect_equal(data$infected_areas[[1]], 10000) @@ -645,16 +671,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 +702,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,16 +735,26 @@ 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, 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), 19) + 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) @@ -731,16 +766,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 +797,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,16 +830,26 @@ 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, 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), 19) + 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) @@ -818,16 +862,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 +893,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,16 +926,26 @@ 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, 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), 19) + 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) @@ -905,16 +958,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 +989,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,16 +1022,26 @@ 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, 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), 19) + 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) @@ -992,9 +1054,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 +1078,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" @@ -1027,16 +1086,19 @@ 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 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 +1121,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 +1138,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 +1164,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 +1197,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 +1216,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), 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) expect_equal(data$number_infecteds[[2]], 0) expect_equal(data$infected_areas[[1]], 10000) diff --git a/tests/testthat/test-pops.r b/tests/testthat/test-pops.r index 589ea3bb..14b324af 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", "host.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,232 @@ 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", "host.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", "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) 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 +246,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", "host.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 +258,99 @@ 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", "host.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", "host.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 +359,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 +436,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 +662,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 +677,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 +692,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 +812,31 @@ 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", "host.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 +845,72 @@ 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") + 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)$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, + 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)$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, + 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, + 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, + 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, + 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, + 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, + 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, + 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, @@ -752,39 +919,46 @@ 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]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + 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 = 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)) + time_step = "week")$host_pools[[1]]$infected[[1]], + 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)) + time_step = "week")$host_pools[[1]]$infected[[1]], + 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", @@ -793,14 +967,16 @@ 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]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + time_step = "week")$host_pools[[1]]$infected[[1]], + 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, @@ -815,39 +991,45 @@ 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]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + time_step = "week")$host_pools[[1]]$infected[[1]], + 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)) + 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 = 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)) + time_step = "day")$host_pools[[1]]$infected[[1]], + 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", @@ -856,14 +1038,16 @@ 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]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + time_step = "day")$host_pools[[1]]$infected[[1]], + 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, @@ -877,14 +1061,16 @@ 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]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + time_step = "day")$host_pools[[1]]$infected[[1]], + 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", "host.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 <- @@ -893,38 +1079,47 @@ 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 = 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)$host_pools[[1]]$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, 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 = 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, 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 = 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, @@ -932,15 +1127,19 @@ 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)) }) 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", "host.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 <- @@ -949,41 +1148,50 @@ 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 - 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]], + 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 = 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, 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 = 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, 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 = 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, @@ -991,15 +1199,21 @@ 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) }) 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", "host.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 <- @@ -1011,78 +1225,95 @@ 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 = 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, 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 = 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, 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)) treatments_file <- 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, 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$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(6, 7, 3, 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, 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$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(6, 7, 3, 7), ncol = 2, nrow = 2)) }) 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", "host.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 <- @@ -1091,29 +1322,38 @@ 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 = 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) + 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( - pops(infected_file = infected_file, - host_file = system.file("extdata", "simple2x2", - "total_plants_host_greater_than_infected.tif", package = "PoPS"), - total_populations_file = host_file, + 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 = 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) + 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 <- 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", "host.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 <- @@ -1121,100 +1361,119 @@ 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") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") - 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, + pest_host_table = pest_host_table, + competency_table = competency_table, 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), 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, + pest_host_table = pest_host_table, + competency_table = competency_table, 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), 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, + pest_host_table = pest_host_table, + competency_table = competency_table, 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), 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, + pest_host_table = pest_host_table, + competency_table = competency_table, 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), 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, + pest_host_table = pest_host_table, + competency_table = competency_table, 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), 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, + pest_host_table = pest_host_table, + competency_table = competency_table, 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), 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, + pest_host_table = pest_host_table, + competency_table = competency_table, 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), 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, + pest_host_table = pest_host_table, + competency_table = competency_table, 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), 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 +1481,160 @@ 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, + # pest_host_table = pest_host_table, + # competency_table = competency_table, # 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), 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, + # pest_host_table = pest_host_table, + # competency_table = competency_table, # 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), 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, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "exponential") - expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= + 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, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "cauchy") - expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= + 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, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "uniform") - expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= + 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, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "hyperbolic secant") - expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= + 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, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "logistic") - expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= + 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, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "weibull") - expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= + 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, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "power law") - expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= + 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, + pest_host_table = pest_host_table, + competency_table = competency_table, anthropogenic_kernel_type = "gamma") - expect_equal(all(data$infected[[1]] >= - terra::as.matrix(terra::rast(infected_file), wide = TRUE)), TRUE) + expect_equal(all(data$host_pools[[1]]$infected[[1]] >= + 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, + # pest_host_table = pest_host_table, + # competency_table = competency_table, # anthropogenic_kernel_type = "exponential-power") - # expect_equal(all(data$infected[[1]] >= - # terra::as.matrix(terra::rast(infected_file), wide = TRUE)), + # expect_equal(all(data$host_pools[[1]]$infected[[1]] >= + # 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, + # pest_host_table = pest_host_table, + # competency_table = competency_table, # anthropogenic_kernel_type = "log normal") - # expect_equal(all(data$infected[[1]] >= - # terra::as.matrix(terra::rast(infected_file), wide = TRUE)), + # expect_equal(all(data$host_pools[[1]]$infected[[1]] >= + # 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", "host.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 <- @@ -1358,42 +1643,52 @@ 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 = 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, + 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) data <- - pops(infected_file = infected_file, - host_file = system.file("extdata", "simple2x2", - "total_plants_host_greater_than_infected.tif", package = "PoPS"), - total_populations_file = host_file, + 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 = 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 <- 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", "host.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 <- @@ -1407,13 +1702,18 @@ 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 = 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, random_seed = 42, start_date = start_date, end_date = end_date, @@ -1424,11 +1724,13 @@ 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, + pest_host_table = pest_host_table, + competency_table = competency_table, random_seed = 42, start_date = start_date, end_date = end_date, @@ -1475,23 +1777,28 @@ 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$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 <- 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, + pest_host_table = pest_host_table, + competency_table = competency_table, random_seed = 42, start_date = start_date, end_date = end_date, @@ -1501,102 +1808,122 @@ 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) - 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$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) }) 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", "host.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") 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(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 <- + 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 = 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, random_seed = 42, start_date = start_date, 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, 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) 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, 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) 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, precipitation_coefficient_file = coefficient_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) 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, 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, weather_type = "probabilistic", temperature_coefficient_sd_file = coefficient_sd_file) - 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, 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, @@ -1604,15 +1931,17 @@ 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, precipitation_coefficient_file = coefficient_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, @@ -1620,35 +1949,52 @@ 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$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$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$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$infected[[1]]), sum(data_precip_wsd$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$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[[1]]), sum(data_temp$host_pools[[1]]$infected[[1]])) + 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]])) }) 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", "host.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 <- @@ -1657,37 +2003,50 @@ 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 = 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, time_step = "week", random_seed = 42, 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, + 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$infected[[1]] >= data_month$infected[[1]]), TRUE) - expect_equal(all(data_week$infected[[2]] >= data_month$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) }) 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", "host.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 <- @@ -1697,163 +2056,212 @@ 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 = 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, 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, + pest_host_table = pest_host_table, + competency_table = competency_table, time_step = "week", random_seed = 42, 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, + 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_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( "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", "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") 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 = 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, + pest_host_table = pest_host_table, + competency_table = competency_table, + random_seed = 42, 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, parameter_means = parameter_means, parameter_cov_matrix = parameter_cov_matrix, - random_seed = 44, + 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$infected[[1]] >= data_treat$infected[[1]]), TRUE) - expect_equal(all(data$infected[[2]] >= data_treat$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 <- 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", "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(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") + competency_table <- system.file("extdata", "competency_table_singlehost.csv", package = "PoPS") 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, + pest_host_table = pest_host_table, + competency_table = competency_table, time_step = "month", 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 = 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, time_step = "month", 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 = 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, time_step = "month", 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 = 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, time_step = "month", 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 = 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, time_step = "month", random_seed = 42, 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_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_050$infected[[1]]), sum(data_025$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$infected[[2]]), sum(data_010$infected[[2]])) - - expect_gte(sum(data_025$infected[[1]]), sum(data_010$infected[[1]])) - expect_gte(sum(data_025$infected[[2]]), sum(data_010$infected[[2]])) - + 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$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 <- 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", "host.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 <- @@ -1864,26 +2272,33 @@ 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 = 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, 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)) } }) 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", "host.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 <- @@ -1896,24 +2311,29 @@ 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 <- - 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, 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$infected[[1]], matrix(0, ncol = 2, nrow = 2)) - expect_equal(data$susceptible[[1]], - terra::as.matrix(terra::rast(host_file), wide = TRUE)) + expect_equal(data$host_pools[[1]]$infected[[1]], matrix(0, ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$susceptible[[1]], + terra::as.matrix(terra::rast(host_file_list), wide = TRUE)) } pesticide_duration <- c(120) @@ -1921,308 +2341,368 @@ 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, 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$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]]$infected[[1]], matrix(c(3, 0, 0, 0), ncol = 2, nrow = 2)) + expect_equal(data$host_pools[[1]]$susceptible[[1]], + matrix(c(14, 14, 6, 15), ncol = 2, nrow = 2)) } - }) 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", "host.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", 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, + 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", 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, + 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", 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, + 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", 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, + 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", 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, + 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", 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, + 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", 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, + 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", 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, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date), output_frequency_error) 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, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date), output_frequency_error) 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, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date), output_frequency_error) 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, + 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, 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, + 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 <- 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", "host.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", 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, + 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", 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, + 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", 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, + 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", 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, + 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", 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, + 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", 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, + 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", 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, + 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" , 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, + 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", 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, + 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 <- 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") + 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 @@ -2230,21 +2710,26 @@ 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", 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, + 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) @@ -2253,17 +2738,19 @@ 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, + 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) @@ -2272,17 +2759,19 @@ 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, + 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) @@ -2291,17 +2780,19 @@ 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, + 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) @@ -2310,17 +2801,19 @@ 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, + 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) @@ -2329,17 +2822,19 @@ 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, + 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) @@ -2348,17 +2843,19 @@ 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, + 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) @@ -2367,17 +2864,19 @@ 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, + 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) @@ -2386,160 +2885,172 @@ 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, + 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 <- 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") + 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", 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, + 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) + mortality_frequency_n = 1) - 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(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", 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, + 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), 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, - 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, + 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), 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, - 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, + 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), 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, - 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, + 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), 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 <- 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") + 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 @@ -2547,14 +3058,20 @@ 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, - 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, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, use_movements = use_movements, @@ -2566,30 +3083,32 @@ 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, + 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(data$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(data$infected[[2]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(data$infected[[3]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(data$infected[[4]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + 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$host_pools[[1]]$infected[[2]], + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + expect_equal(data$host_pools[[1]]$infected[[3]], + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + 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) - sus <- terra::rast(host_file) - terra::rast(infected_file) + 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 sus5[1, 1] <- sus5[1, 1] - 199 @@ -2597,40 +3116,42 @@ 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", 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, + 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(data$infected[[1]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(data$infected[[2]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(data$infected[[3]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) - expect_equal(data$infected[[4]], - terra::as.matrix(terra::rast(infected_file), wide = TRUE)) + 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$host_pools[[1]]$infected[[2]], + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + expect_equal(data$host_pools[[1]]$infected[[3]], + terra::as.matrix(terra::rast(infected_file_list), wide = TRUE)) + 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) - sus <- terra::rast(host_file) - terra::rast(infected_file) + 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 sus5[1, 1] <- sus5[1, 1] - 199 @@ -2638,30 +3159,37 @@ 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( "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", "host.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 = 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, start_date = start_date, end_date = end_date, use_overpopulation_movements = TRUE, @@ -2669,72 +3197,86 @@ 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) - 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]]) + test_mat <- terra::as.matrix(terra::rast(infected_file_list), wide = TRUE) + 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", { - 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", "host.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 = 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, start_date = start_date, end_date = end_date, generate_stochasticity = FALSE, establishment_stochasticity = FALSE, movement_stochasticity = FALSE, dispersal_stochasticity = TRUE) - test_mat <- terra::as.matrix(terra::rast(infected_file), 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]]) + 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]]) }) 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") + 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 = 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, start_date = start_date, end_date = end_date, anthropogenic_kernel_type = anthropogenic_kernel_type, network_filename = network_filename) - test_mat <- terra::as.matrix(terra::rast(infected_file), 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]]) + 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]]) }) 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" @@ -2744,27 +3286,32 @@ 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 = 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, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, anthropogenic_kernel_type = anthropogenic_kernel_type, 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) - 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]]) + 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]]) - 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,26 +3323,28 @@ 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, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, anthropogenic_kernel_type = anthropogenic_kernel_type, 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) - 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]]) + 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]]) - 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" @@ -2805,30 +3354,35 @@ 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 = 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, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, anthropogenic_kernel_type = anthropogenic_kernel_type, 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) - 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]]) + 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]]) }) 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" @@ -2838,51 +3392,58 @@ 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 = 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, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, anthropogenic_kernel_type = anthropogenic_kernel_type, multiple_random_seeds = multiple_random_seeds, file_random_seeds = file_random_seeds) - test_mat <- terra::as.matrix(terra::rast(infected_file), 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]]) + 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]]) 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, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, anthropogenic_kernel_type = anthropogenic_kernel_type, multiple_random_seeds = multiple_random_seeds, file_random_seeds = file_random_seeds) - test_mat <- terra::as.matrix(terra::rast(infected_file), 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]]) + 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]]) }) 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", "host.tif", package = "PoPS") total_populations_file <- system.file("extdata", "simple2x2", "total_plants.tif", package = "PoPS") start_date <- "2008-01-01" @@ -2893,14 +3454,18 @@ 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 = 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, + pest_host_table = pest_host_table, + competency_table = competency_table, start_date = start_date, end_date = end_date, temp = TRUE, @@ -2908,34 +3473,259 @@ 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) - 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]]) + 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 = 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, + 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, + soil_starting_pest_file = infected_file_list, start_with_soil_populations = TRUE) - test_mat <- terra::as.matrix(terra::rast(infected_file), 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]]) + 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) }) + +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"), + 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[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")) + 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, + 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]]) +}) + + +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]]) +}) diff --git a/tests/testthat/test-validate.R b/tests/testthat/test-validate.R index 4bb2e926..51a55062 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,12 @@ 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 <- + 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 <- 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 +65,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 +102,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 +133,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 +157,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 +188,7 @@ test_that( overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, write_outputs, output_folder_path, point_file, @@ -233,10 +239,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 +264,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 +301,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 +332,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 +356,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 +387,7 @@ test_that( overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, write_outputs, output_folder_path, point_file, @@ -426,18 +431,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 +463,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 +500,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 +531,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 +555,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 +586,7 @@ test_that( overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, write_outputs, output_folder_path, point_file, @@ -635,10 +638,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 +663,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 +700,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 +731,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 +755,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 +786,7 @@ test_that( overpopulation_percentage, leaving_percentage, leaving_scale_coefficient, - exposed_file, + exposed_file_list, write_outputs, output_folder_path, point_file,