diff --git a/R/RcppExports.R b/R/RcppExports.R index 98e9d486..166dc0b0 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -7,5 +7,5 @@ pops_model_cpp <- function(random_seed, multiple_random_seeds, random_seeds, let # Register entry points for exported C++ functions methods::setLoadAction(function(ns) { - .Call('_PoPS_RcppExport_registerCCallable', PACKAGE = 'PoPS') + .Call(`_PoPS_RcppExport_registerCCallable`) }) diff --git a/R/calibrate.R b/R/calibrate.R index ee6cf2ff..1edec5c6 100644 --- a/R/calibrate.R +++ b/R/calibrate.R @@ -331,6 +331,7 @@ calibrate <- function(infected_years_file, config <- host_pool_setup(config) } config$competency_table_list <- competency_table_list_creator(config$competency_table) + config$pest_host_table_list <- pest_host_table_list_creator(config$pest_host_table) data <- pops_model( random_seed = config$random_seed, diff --git a/R/checks.R b/R/checks.R index a6a4573b..d84e7045 100644 --- a/R/checks.R +++ b/R/checks.R @@ -331,40 +331,53 @@ multihost_checks <- checks_passed <- FALSE failed_check <- competency_value_error } - + + if (!checks_passed && identical(names(competency_table) + [(length(names(competency_table)) - 1): + length(names(competency_table))], + competency_table_colnames)) { + checks_passed <- FALSE + failed_check <- competency_table_wrong_columns + } + if (!checks_passed && (length(infected_file_list) + 1) <= nrow(competency_table)) { checks_passed <- FALSE failed_check <- competency_table_row_length_error } else { competency_table_list <- competency_table_list_creator(competency_table) } - - if (!checks_passed && length(infected_file_list) != nrow(pest_host_table)) { + + if (!checks_passed && identical(names(pest_host_table), pest_host_table_colnames)) { checks_passed <- FALSE - failed_check <- pest_host_table_row_length_error + failed_check <- pest_host_table_wrong_columns } - 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)) { + + if (!checks_passed && all(pest_host_table$susceptibility_mean <= 1) && + all(pest_host_table$susceptibility_mean >= 0) && all(pest_host_table$susceptibility_sd <= 1) && + all(pest_host_table$susceptibility_sd >= 0)) { checks_passed <- FALSE - failed_check <- pest_host_table_value_error + failed_check <- pest_host_susceptbility_value_error } - - if (!checks_passed && identical(names(pest_host_table), pest_host_table_list)) { + + if (!checks_passed && all(pest_host_table$mortality_rate_mean <= 1) && + all(pest_host_table$mortality_rate_mean >= 0) && all(pest_host_table$mortality_rate_sd <= 1) && + all(pest_host_table$mortality_rate_sd >= 0)) { checks_passed <- FALSE - failed_check <- pest_host_table_wrong_columns + failed_check <- pest_host_mortality_rate_value_error + } + + + if (!checks_passed && length(infected_file_list) != nrow(pest_host_table)) { + checks_passed <- FALSE + failed_check <- pest_host_table_row_length_error } 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]])) - } + pest_host_table <- pest_host_table[,-1] + pest_host_table_list <- pest_host_table_list_creator(pest_host_table) } - if (any(pest_host_table$mortality_rate > 0)) { + if (any(pest_host_table$mortality_rate_mean > 0)) { mortality_on <- TRUE } else { mortality_on <- FALSE @@ -383,7 +396,7 @@ multihost_checks <- names(outs) <- failed_check_list return(outs) } -} + } multispecies_checks <- function(species, infected_files, diff --git a/R/configuration.R b/R/configuration.R index 6f15150f..dcef2490 100644 --- a/R/configuration.R +++ b/R/configuration.R @@ -667,11 +667,11 @@ configuration <- function(config) { mortality_tracker <- list(zero_matrix) if (config$mortality_on) { - if (config$pest_host_table$mortality_rate[i] <= 0) { + if (config$pest_host_table$mortality_rate_mean[i] <= 0) { mortality_length <- 1 } else { mortality_length <- - 1 / config$pest_host_table$mortality_rate[i] + + 1 / config$pest_host_table$mortality_rate_mean[i] + config$pest_host_table$mortality_time_lag[i] } for (mt in 2:(mortality_length)) { diff --git a/R/error_messages.R b/R/error_messages.R index 99febb95..28f41e9c 100644 --- a/R/error_messages.R +++ b/R/error_messages.R @@ -10,7 +10,6 @@ detailed_file_exists_error <- function(file_name) { frequency_error <- "Output frequency must be either 'week', 'month', 'day', 'year', 'time_step', or 'every_n_steps'" raster_type_error <- - "file is not one of '.grd', '.tif', '.img', or '.vrt'" extent_error <- "Extents of input rasters do not match. Ensure that all of your input rasters have the same extent" @@ -184,6 +183,10 @@ 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_table_wrong_columns <- + "Check column order and headings. The competency table requires a column for each + host species, followed by a competency_mean column and competency_sd column" + competency_value_error <- "competency_table competency_mean and competency_sd values must be between 0 and 1" @@ -191,11 +194,14 @@ 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 must the 6 columns named and order: host, susceptibility_mean, + susceptibility_sd, mortality_rate_mean, mortality_rate_sd, mortality_time_lag" + +pest_host_susceptbility_value_error <- + "pest_host_table susceptiblity_mean and susceptibility_sd values must be between 0 and 1" -pest_host_table_value_error <- - "pest_host_table susceptiblity and mortality_rate must be between 0 and 1" +pest_host_mortality_rate_value_error <- + "pest_host_table mortality_rate_mean and mortality_rate_sd values 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 diff --git a/R/helpers.R b/R/helpers.R index dc477161..be285231 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -271,19 +271,21 @@ combined_sd <- function(v1, v2, m1, m2, n1, n2) { (((n1 * n2) * (m1 - m2)^2) / ((n1 + n2) * (n1 + n2 - 1))) } +# Reformat competency_table into list (per host composition) with competency values +# randomly sampled from a normal distribution using mean and sd in competency table + 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) + sd = competency_table$competency_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) + mean = competency_table$competency_mean, sd = competency_table$competency_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]]) @@ -292,6 +294,35 @@ competency_table_list_creator <- function(competency_table) { return(competency_table_list) } +# Reformat pest_host_table into list (per host species) with susceptibility and +# mortality rates randomly sampled from a normal distribution using the means and sds i +# in the pest_host_table + +pest_host_table_list_creator <- function(pest_host_table){ + pest_host_table2 <- pest_host_table[,!grepl("_sd", colnames(pest_host_table))] + susceptibilities <- + rnorm(n = nrow(pest_host_table), mean = pest_host_table$susceptibility_mean, sd = pest_host_table$susceptibility_sd) + names(pest_host_table2)[1] <- "susceptibility" + while (any(susceptibilities > 1) || any(susceptibilities < 0)) { + susceptibilities <- rnorm(n = nrow(pest_host_table), mean = pest_host_table$susceptibility_mean, sd = pest_host_table$susceptibility_sd) + } + pest_host_table2$susceptibility <- susceptibilities + mortality_rates <- + rnorm(n = nrow(pest_host_table), mean = pest_host_table$mortality_rate_mean, sd = pest_host_table$mortality_rate_sd) + names(pest_host_table2)[2] <- "mortality_rate" + while (any(mortality_rates > 1) || any(mortality_rates < 0)) { + mortality_rates <- + rnorm(n = nrow(pest_host_table), mean = pest_host_table$mortality_rate_mean, sd = pest_host_table$mortality_rate_sd) + } + pest_host_table2$mortality_rate <- mortality_rates + pest_host_table_list <- split(pest_host_table2, seq_len(nrow(pest_host_table2))) + 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]])) + } + return(pest_host_table_list) +} + # Update host pools when uncertainties are used host_pool_setup <- function(config) { total_infecteds <- config$zero_matrix diff --git a/R/lists.R b/R/lists.R index e06e86aa..a738f44b 100644 --- a/R/lists.R +++ b/R/lists.R @@ -121,4 +121,7 @@ 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") +competency_table_colnames <- c("competency_mean","competency_sd") +pest_host_table_colnames <- c("host","susceptibility_mean","susceptibility_sd", + "mortality_rate_mean","mortality_rate_sd", + "mortality_time_lag") diff --git a/R/pops.r b/R/pops.r index 3a7f07b1..ef2169fb 100644 --- a/R/pops.r +++ b/R/pops.r @@ -187,10 +187,11 @@ #' @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. +#' susceptibility_mean, susceptibility_sd, mortality_rate, mortality_rate_mean, 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 character string of the species name, and is only used for metadata +#' and labeling output files. Susceptibility and mortality_rate values must be between 0 and 1. #' @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. @@ -382,6 +383,7 @@ pops <- function(infected_file_list, config <- host_pool_setup(config) } config$competency_table_list <- competency_table_list_creator(config$competency_table) + config$pest_host_table_list <- pest_host_table_list_creator(config$pest_host_table) data <- pops_model(random_seed = config$random_seed[1], multiple_random_seeds = config$multiple_random_seeds, diff --git a/R/pops_multirun.R b/R/pops_multirun.R index 2eee7256..e87c89ba 100644 --- a/R/pops_multirun.R +++ b/R/pops_multirun.R @@ -228,6 +228,7 @@ pops_multirun <- function(infected_file_list, config <- host_pool_setup(config) } config$competency_table_list <- competency_table_list_creator(config$competency_table) + config$pest_host_table_list <- pest_host_table_list_creator(config$pest_host_table) data <- PoPS::pops_model( random_seed = config$random_seed[i], diff --git a/R/validate.R b/R/validate.R index e10e347b..9f4562be 100644 --- a/R/validate.R +++ b/R/validate.R @@ -246,6 +246,7 @@ validate <- function(infected_years_file, config <- host_pool_setup(config) } config$competency_table_list <- competency_table_list_creator(config$competency_table) + config$pest_host_table_list <- pest_host_table_list_creator(config$pest_host_table) data <- pops_model( random_seed = config$random_seed[i], diff --git a/inst/extdata/competency_table_2host.csv b/inst/extdata/competency_table_2host.csv index 71ea375c..b83db79e 100644 --- a/inst/extdata/competency_table_2host.csv +++ b/inst/extdata/competency_table_2host.csv @@ -1,5 +1,5 @@ -oak,tanoak,competency_mean,compentency_sd +oak,tanoak,competency_mean,competency_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 +1,1,0.8,0.05 diff --git a/inst/extdata/competency_table_multihost.csv b/inst/extdata/competency_table_multihost.csv index 16a43fa8..48e0fe46 100644 --- a/inst/extdata/competency_table_multihost.csv +++ b/inst/extdata/competency_table_multihost.csv @@ -1,5 +1,5 @@ -oak,tanoak,bay_laurel,competency_mean,compentency_sd +oak,tanoak,bay_laurel,competency_mean,competency_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 +0,0,1,0.8,0.05 diff --git a/inst/extdata/competency_table_singlehost.csv b/inst/extdata/competency_table_singlehost.csv index 63951f53..fff6ba12 100644 --- a/inst/extdata/competency_table_singlehost.csv +++ b/inst/extdata/competency_table_singlehost.csv @@ -1,3 +1,3 @@ -tanoak,competency_mean,compentency_sd +tanoak,competency_mean,competency_sd 0,0,0 -1,1,0.1 \ No newline at end of file +1,1,0.1 diff --git a/inst/extdata/pest_host_table.csv b/inst/extdata/pest_host_table.csv index 4d1da095..98847d2c 100644 --- a/inst/extdata/pest_host_table.csv +++ b/inst/extdata/pest_host_table.csv @@ -1,4 +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 +host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag +oak,0.7,0.12,0.1,0,1 +tanoak,1,0.13,0.5,0,1 +bay laurel,0.5,0,0,0,0 diff --git a/inst/extdata/pest_host_table_2host.csv b/inst/extdata/pest_host_table_2host.csv index 843aa802..554fefc2 100644 --- a/inst/extdata/pest_host_table_2host.csv +++ b/inst/extdata/pest_host_table_2host.csv @@ -1,3 +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 +host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag +oak,0.7,0.12,0.1,0.02,1 +tanoak,1,0.13,0.5,0.08,1 diff --git a/inst/extdata/pest_host_table_singlehost.csv b/inst/extdata/pest_host_table_singlehost.csv index c121dc6e..49f106b7 100644 --- a/inst/extdata/pest_host_table_singlehost.csv +++ b/inst/extdata/pest_host_table_singlehost.csv @@ -1,2 +1,2 @@ -host,susceptibility,mortality_rate,mortality_time_lag -oak,0.7,0.5,1 \ No newline at end of file +host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag +oak,0.7,0.12,0.5,0.02,1 diff --git a/inst/extdata/pest_host_table_singlehost010tl1.csv b/inst/extdata/pest_host_table_singlehost010tl1.csv index bbf4ef49..b1d30338 100644 --- a/inst/extdata/pest_host_table_singlehost010tl1.csv +++ b/inst/extdata/pest_host_table_singlehost010tl1.csv @@ -1,2 +1,2 @@ -host,susceptibility,mortality_rate,mortality_time_lag -oak,0.7,0.1,1 \ No newline at end of file +host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag +oak,0.7,0.12,0.1,0.02,1 diff --git a/inst/extdata/pest_host_table_singlehost025.csv b/inst/extdata/pest_host_table_singlehost025.csv index f76d0695..461ce031 100644 --- a/inst/extdata/pest_host_table_singlehost025.csv +++ b/inst/extdata/pest_host_table_singlehost025.csv @@ -1,2 +1,2 @@ -host,susceptibility,mortality_rate,mortality_time_lag -oak,0.7,0.25,1 \ No newline at end of file +host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag +oak,0.7,0.12,0.25,0.02,1 diff --git a/inst/extdata/pest_host_table_singlehost025tl3.csv b/inst/extdata/pest_host_table_singlehost025tl3.csv index 1361dfa8..d9ef9f05 100644 --- a/inst/extdata/pest_host_table_singlehost025tl3.csv +++ b/inst/extdata/pest_host_table_singlehost025tl3.csv @@ -1,2 +1,2 @@ -host,susceptibility,mortality_rate,mortality_time_lag -oak,0.7,0.25,3 \ No newline at end of file +host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag +oak,0.7,0.12,0.25,0.02,3 diff --git a/inst/extdata/pest_host_table_singlehost_nomort.csv b/inst/extdata/pest_host_table_singlehost_nomort.csv index 94a94f9c..84dc713a 100644 --- a/inst/extdata/pest_host_table_singlehost_nomort.csv +++ b/inst/extdata/pest_host_table_singlehost_nomort.csv @@ -1,2 +1,2 @@ -host,susceptibility,mortality_rate,mortality_time_lag -oak,0.7,0,1 \ No newline at end of file +host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag +oak,0.7,0.12,0,0,0 diff --git a/inst/extdata/simple2x2/infected_tanoak.tif b/inst/extdata/simple2x2/infected_tanoak.tif index 946cc401..a5ebb51b 100644 Binary files a/inst/extdata/simple2x2/infected_tanoak.tif 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 index 0192d7df..083c1a17 100644 Binary files a/inst/extdata/simple2x2/infected_tanoak_wsd.tif and b/inst/extdata/simple2x2/infected_tanoak_wsd.tif differ