Updated pest_host_table_list to include susceptibility and mortality …

…rate means and sd (#197)

* added in random seeds

* Update scripts to consider pest_host_table with susceptibility and mortality rate means and sd rather than mean only

* fixed typo

* fixed tests

---------

Co-authored-by: Chris Jones <cjones1688@gmail.com>

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,

R/checks.R

@@ -332,39 +332,52 @@ multihost_checks <-
     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

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)) {

R/error_messages.R

@@ -184,18 +184,25 @@ 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"
 
-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_table_value_error <-
-  "pest_host_table susceptiblity and mortality_rate must be between 0 and 1"
+pest_host_susceptbility_value_error <-
+  "pest_host_table susceptiblity_mean and susceptibility_sd values 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"
+
+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"
 
 multihosts_gt_totpop_error <-
   "All hosts sum to more than the total populations in some cells. Check rasters to ensure that

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,40 @@ 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

R/lists.R

@@ -121,4 +121,6 @@ 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")
+pest_host_table_colnames <- c("host", "susceptibility_mean", "susceptibility_sd",
+                          "mortality_rate_mean", "mortality_rate_sd", "mortality_time_lag")
+competency_table_colnames <- c("competency_mean", "competency_sd")

R/pops.r

@@ -187,10 +187,12 @@
 #' @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 +384,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,

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],

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],

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
+1,1,0.8,0.05

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
+0,0,1,0.8,0.05

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
+1,1,0.1

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
+host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag
+oak,0.7,0.1,0.1,0.02,1
+tanoak,1,0.05,0.5,0.1,1
+bay laurel,0.5,0.06,0,0,0

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
+host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag
+oak,0.7,0.1,0.1,0.02,1
+tanoak,1,0.05,0.5,0.1,1

inst/extdata/pest_host_table_singlehost.csv

@@ -1,2 +1,2 @@
-host,susceptibility,mortality_rate,mortality_time_lag
-oak,0.7,0.5,1
+host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag
+oak,0.7,0.1,0.5,0.02,1

inst/extdata/pest_host_table_singlehost010tl1.csv

@@ -1,2 +1,2 @@
-host,susceptibility,mortality_rate,mortality_time_lag
-oak,0.7,0.1,1
+host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag
+oak,0.7,0.1,0.1,0.02,1

inst/extdata/pest_host_table_singlehost025.csv

@@ -1,2 +1,2 @@
-host,susceptibility,mortality_rate,mortality_time_lag
-oak,0.7,0.25,1
+host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag
+oak,0.7,0.1,0.25,0.02,1

inst/extdata/pest_host_table_singlehost025tl3.csv

@@ -1,2 +1,2 @@
-host,susceptibility,mortality_rate,mortality_time_lag
-oak,0.7,0.25,3
+host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag
+oak,0.7,0.1,0.25,0.02,3

inst/extdata/pest_host_table_singlehost_nomort.csv

@@ -1,2 +1,2 @@
-host,susceptibility,mortality_rate,mortality_time_lag
-oak,0.7,0,1
+host,susceptibility_mean,susceptibility_sd,mortality_rate_mean,mortality_rate_sd,mortality_time_lag
+oak,0.7,0.1,0,0,1

renv.lock

@@ -94,7 +94,7 @@
     },
     "XML": {
       "Package": "XML",
-      "Version": "3.99-0.14",
+      "Version": "3.99-0.16.1",
       "Source": "Repository",
       "Repository": "CRAN",
       "Requirements": [