Update to network version of PoPS Core (#131)

* Update core code, use empty network * Add network to pops_model function interface * update documentation * add documentation for network and update pops_model with all network variables in all functions that use it. * fix errors in function setup * add network checks and test. * update data * update pops-core * update pops_model.R * update pops cpp from time to distance for network * update pops r functions to distance from time for network * update docs * update network test * updated network file * updated automanage function to handle network distance instead of time and spped * remove speed and node filname in validate * update git workflow for checking package installation * Update CHANGELOG.md Co-authored-by: ChrisJones687 <cjones1688@gmail.com>
ncsu-landscape-dynamics · Dec 8, 2021 · fb6105c · fb6105c
1 parent 82d01d2
commit fb6105c
Show file tree

Hide file tree

Showing 44 changed files with 1,728 additions and 237 deletions.
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -60,14 +60,16 @@ jobs:
             libudunits2-dev \
             libgdal-dev \
             libgeos-dev \
-            libproj-dev
+            libproj-dev \
+            libharfbuzz-dev \
+            libfribidi-dev
 
       - name: Install system dependencies
         if: runner.os == 'macOS'
         run: |
           # install spatial dependencies
           rm '/usr/local/bin/gfortran'
-          brew install pkg-config gdal proj geos
+          brew install pkg-config gdal proj geos harfbuzz fribidi
 
       - name: Install renv
         shell: Rscript {0}

diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -19,6 +19,11 @@ this repository.
 - `quantity_allocation_disagreement` now takes in the use_distance parameter which is FALSE
   by default. This allows the model to commute the minimum total distance between observed
   and simulated infestations (@ChrisJones, #130).
+
+- `validate`, `calibrate`, `pops_multirun`, `auto_manage` and `pops` now take in 
+  network_min_distance, network_max_distance, and network_filename parameters these are 
+  used when the anthropogenic_kernel_type = "network". This allows directed spread along
+  a network such as a railroad (@ChrisJones and @wenzeslaus, #131)
 
 ### Changed
 

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -58,5 +58,5 @@ Suggests:
     pkgdown
 LinkingTo: 
     Rcpp
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2
 VignetteBuilder: knitr
diff --git 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, lethal_temperature, lethal_temperature_month, infected, total_exposed, exposed, susceptible, total_populations, total_hosts, mortality_tracker, mortality, quarantine_areas, treatment_maps, treatment_dates, pesticide_duration, resistant, movements, movements_dates, temperature, weather_coefficient, res, rows_cols, 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, output_frequency_n = 1L, quarantine_frequency_n = 1L, spreadrate_frequency_n = 1L, mortality_frequency_n = 1L, model_type_ = "SI", latency_period = 0L, establishment_probability = 0, dispersal_percentage = 0.99, overpopulation_config = NULL) {
-    .Call(`_PoPS_pops_model_cpp`, random_seed, lethal_temperature, lethal_temperature_month, infected, total_exposed, exposed, susceptible, total_populations, total_hosts, mortality_tracker, mortality, quarantine_areas, treatment_maps, treatment_dates, pesticide_duration, resistant, movements, movements_dates, temperature, weather_coefficient, res, rows_cols, 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, output_frequency_n, quarantine_frequency_n, spreadrate_frequency_n, mortality_frequency_n, model_type_, latency_period, establishment_probability, dispersal_percentage, overpopulation_config)
+pops_model_cpp <- function(random_seed, lethal_temperature, lethal_temperature_month, infected, total_exposed, exposed, susceptible, total_populations, total_hosts, mortality_tracker, mortality, quarantine_areas, treatment_maps, treatment_dates, pesticide_duration, resistant, movements, movements_dates, temperature, weather_coefficient, bbox, res, rows_cols, 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, overpopulation_config = NULL, network_config = NULL, network_data_config = NULL) {
+    .Call(`_PoPS_pops_model_cpp`, random_seed, lethal_temperature, lethal_temperature_month, infected, total_exposed, exposed, susceptible, total_populations, total_hosts, mortality_tracker, mortality, quarantine_areas, treatment_maps, treatment_dates, pesticide_duration, resistant, movements, movements_dates, temperature, weather_coefficient, bbox, res, rows_cols, 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, overpopulation_config, network_config, network_data_config)
 }
 
 # Register entry points for exported C++ functions

diff --git a/R/auto_manage.R b/R/auto_manage.R
@@ -119,7 +119,10 @@ auto_manage <- function(infected_files,
                         exposed_file = "",
                         mask = NULL,
                         write_outputs = "None",
-                        output_folder_path = "") {
+                        output_folder_path = "",
+                        network_min_distance = 0,
+                        network_max_distance = 0,
+                        network_filename = "") {
 
   config <- c()
   config$random_seed <- random_seed
@@ -186,6 +189,9 @@ auto_manage <- function(infected_files,
   config$mask <- mask
   config$write_outputs <- write_outputs
   config$output_folder_path <- output_folder_path
+  config$network_min_distance <- network_min_distance
+  config$network_max_distance <- network_max_distance
+  config$network_filename <- network_filename
 
   config <- configuration(config)
 
@@ -321,7 +327,11 @@ auto_manage <- function(infected_files,
                            use_overpopulation_movements = config$use_overpopulation_movements,
                            overpopulation_percentage = overpopulation_percentage,
                            leaving_percentage = leaving_percentage,
-                           leaving_scale_coefficient = leaving_scale_coefficient
+                           leaving_scale_coefficient = leaving_scale_coefficient,
+                           bbox = config$bounding_box,
+                           network_min_distance = config$network_min_distance,
+                           network_max_distance = config$network_max_distance,
+                           network_filename = config$network_filename
         )
 
         infected_runs <- raster::stack(lapply(1:length(data$infected), function(x) host))

diff --git a/R/calibrate.R b/R/calibrate.R
@@ -175,6 +175,9 @@ calibrate <- function(infected_years_file,
                       verbose = TRUE,
                       write_outputs = "None",
                       output_folder_path = "",
+                      network_min_distance = 0,
+                      network_max_distance = 0,
+                      network_filename = "",
                       use_distance = FALSE,
                       use_rmse = FALSE) {
 
@@ -252,6 +255,9 @@ calibrate <- function(infected_years_file,
   config$output_folder_path <- output_folder_path
   config$mortality_frequency <- mortality_frequency
   config$mortality_frequency_n <- mortality_frequency_n
+  config$network_min_distance <- network_min_distance
+  config$network_max_distance <- network_max_distance
+  config$network_filename <- network_filename
   config$use_distance <- use_distance
   config$use_rmse <- use_rmse
 
@@ -340,7 +346,11 @@ calibrate <- function(infected_years_file,
         use_overpopulation_movements = config$use_overpopulation_movements,
         overpopulation_percentage = config$overpopulation_percentage,
         leaving_percentage = config$leaving_percentage,
-        leaving_scale_coefficient = config$leaving_scale_coefficient
+        leaving_scale_coefficient = config$leaving_scale_coefficient,
+        bbox = config$bounding_box,
+        network_min_distance = config$network_min_distance,
+        network_max_distance = config$network_max_distance,
+        network_filename = config$network_filename
       )
       return(data)
     }

diff --git a/R/configuration.R b/R/configuration.R
@@ -172,6 +172,7 @@ configuration <- function(config) {
     if (terra::nlyr(infected) > 1) {
       infected <- output_from_raster_mean_and_sd(infected)
     }
+    infected <- terra::classify(infected, matrix(c(NA, 0), ncol = 2, byrow = TRUE), right = NA)
   } else {
     config$failure <- infected_check$failed_check
     return(config)
@@ -487,7 +488,9 @@ configuration <- function(config) {
     # "Log normal",
     # "Log Normal",
     "logistic",
-    "Logistic"
+    "Logistic",
+    "network",
+    "Network"
   )
 
   if (config$natural_kernel_type %notin% kernel_list) {
@@ -668,6 +671,12 @@ configuration <- function(config) {
   config$xmin <- terra::xmin(config$host)
   config$ymax <- terra::ymax(config$host)
   config$ymin <- terra::ymin(config$host)
+  bounding_box <- c()
+  bounding_box$north <- config$ymax
+  bounding_box$south <- config$ymin
+  bounding_box$west <- config$xmin
+  bounding_box$east <- config$xmax
+  config$bounding_box <- bounding_box
 
   return(config)
 }
diff --git a/R/helpers.R b/R/helpers.R
@@ -107,8 +107,8 @@ natural_kernel_error <-
   "Natural kernel type not one of 'cauchy', 'exponential', 'uniform', 'deterministic neighbor',
   'power law', 'hyperbolic secant', 'gamma', 'weibull', 'logistic'"
 anthropogenic_kernel_error <-
-  "Anthropogenic kernel type not one of 'cauchy', 'exponential', 'uniform',
-  'deterministic neighbor', 'power law', 'hyperbolic secant', 'gamma', 'weibull', 'logistic'"
+  "Anthropogenic kernel type not one of 'cauchy', 'exponential', 'uniform', 'deterministic
+  neighbor', 'power law', 'hyperbolic secant', 'gamma', 'weibull', 'logistic', 'network'"
 covariance_mat_error <-
   "parameter covariance matrix is not 6 x 6"
 paramter_means_error <-

diff --git a/R/pops.r b/R/pops.r
@@ -164,6 +164,9 @@
 #' 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.
+#' @param network_min_distance minimum time a propagule rides on the network
+#' @param network_max_distance maximum time a propagule rides on the network
+#' @param network_filename entire file path for the network file
 #'
 #' @useDynLib PoPS, .registration = TRUE
 #' @importFrom terra app rast xres yres classify extract ext as.points ncol nrow
@@ -233,7 +236,10 @@ pops <- function(infected_file,
                  leaving_percentage = 0,
                  leaving_scale_coefficient = 1,
                  exposed_file = "",
-                 mask = NULL) {
+                 mask = NULL,
+                 network_min_distance = 0,
+                 network_max_distance = 0,
+                 network_filename = "") {
 
   config <- c()
   config$random_seed <- random_seed
@@ -303,6 +309,10 @@ pops <- function(infected_file,
   config$mortality_frequency <- mortality_frequency
   config$mortality_frequency_n <- mortality_frequency_n
 
+  config$network_min_distance <- network_min_distance
+  config$network_max_distance <- network_max_distance
+  config$network_filename <- network_filename
+
   config <- configuration(config)
 
   if (!is.null(config$failure)) {
@@ -345,15 +355,11 @@ pops <- function(infected_file,
                      end_date = config$end_date,
                      treatment_method = config$treatment_method,
                      natural_kernel_type = config$natural_kernel_type,
-                     anthropogenic_kernel_type =
-                       config$anthropogenic_kernel_type,
-                     use_anthropogenic_kernel =
-                       config$use_anthropogenic_kernel,
-                     percent_natural_dispersal =
-                       config$percent_natural_dispersal[1],
+                     anthropogenic_kernel_type = config$anthropogenic_kernel_type,
+                     use_anthropogenic_kernel = config$use_anthropogenic_kernel,
+                     percent_natural_dispersal = config$percent_natural_dispersal[1],
                      natural_distance_scale = config$natural_distance_scale[1],
-                     anthropogenic_distance_scale =
-                       config$anthropogenic_distance_scale[1],
+                     anthropogenic_distance_scale = config$anthropogenic_distance_scale[1],
                      natural_dir = config$natural_dir,
                      natural_kappa = config$natural_kappa[1],
                      anthropogenic_dir = config$anthropogenic_dir,
@@ -370,22 +376,20 @@ pops <- function(infected_file,
                      use_spreadrates = config$use_spreadrates,
                      model_type_ = config$model_type,
                      latency_period = config$latency_period,
-                     generate_stochasticity =
-                       config$generate_stochasticity,
-                     establishment_stochasticity =
-                       config$establishment_stochasticity,
+                     generate_stochasticity = config$generate_stochasticity,
+                     establishment_stochasticity = config$establishment_stochasticity,
                      movement_stochasticity = config$movement_stochasticity,
                      deterministic = config$deterministic,
-                     establishment_probability =
-                       config$establishment_probability,
+                     establishment_probability = config$establishment_probability,
                      dispersal_percentage = config$dispersal_percentage,
-                     use_overpopulation_movements =
-                       config$use_overpopulation_movements,
-                     overpopulation_percentage =
-                       config$overpopulation_percentage,
+                     use_overpopulation_movements = config$use_overpopulation_movements,
+                     overpopulation_percentage = config$overpopulation_percentage,
                      leaving_percentage = config$leaving_percentage,
-                     leaving_scale_coefficient =
-                       config$leaving_scale_coefficient
+                     leaving_scale_coefficient = config$leaving_scale_coefficient,
+                     bbox = config$bounding_box,
+                     network_min_distance = config$network_min_distance,
+                     network_max_distance = config$network_max_distance,
+                     network_filename = config$network_filename
   )
 
   return(data)

diff --git a/R/pops_model.R b/R/pops_model.R
@@ -65,6 +65,8 @@
 #' 'day' or 'time step') in which to calculate and export spread rate
 #' statistics.
 #' @param spatial_indices list of all spatial locations with suitable hosts
+#' @param bbox bounding box for network kernel
+#'
 #' @return list of vector matrices of infected and susceptible hosts per
 #' simulated year and associated statistics (e.g. spread rate)
 #' @export
@@ -137,14 +139,38 @@ pops_model <-
            use_overpopulation_movements = FALSE,
            overpopulation_percentage = 0.0,
            leaving_percentage = 0.0,
-           leaving_scale_coefficient = 1.0) {
+           leaving_scale_coefficient = 1.0,
+           bbox = NULL,
+           network_min_distance = 0,
+           network_max_distance = 0,
+           network_filename = "") {
 
     # List of overpopulation parameters of type double
     overpopulation_config <- c()
     overpopulation_config$overpopulation_percentage <- overpopulation_percentage
     overpopulation_config$leaving_percentage <- leaving_percentage
     overpopulation_config$leaving_scale_coefficient <- leaving_scale_coefficient
 
+
+    # List of frequency n parameters
+    frequencies_n_config <- c()
+    frequencies_n_config$output_frequency_n <- output_frequency_n
+    frequencies_n_config$quarantine_frequency_n <- quarantine_frequency_n
+    frequencies_n_config$spreadrate_frequency_n <- spreadrate_frequency_n
+    frequencies_n_config$mortality_frequency_n <- mortality_frequency_n
+
+    # Network configuration
+    network_config <- NULL;
+    network_data_config <- NULL;
+    if (!(is.na(network_filename) || is.null(network_filename) || network_filename == '')) {
+      network_config <- c()
+      network_config$network_min_distance <- network_min_distance
+      network_config$network_max_distance <- network_max_distance
+
+      network_data_config <- c()
+      network_data_config$network_filename <- network_filename
+    }
+
     # List of frequencies type string
     frequency_config <- c()
     frequency_config$time_step <- time_step
@@ -168,6 +194,7 @@ pops_model <-
     bool_config$deterministic <- deterministic
     bool_config$use_overpopulation_movements <- use_overpopulation_movements
 
+
     data <-
       pops_model_cpp(random_seed = random_seed,
                      lethal_temperature = lethal_temperature,
@@ -189,6 +216,7 @@ pops_model <-
                      movements_dates = movements_dates,
                      temperature = temperature,
                      weather_coefficient = weather_coefficient,
+                     bbox = bbox,
                      res = res,
                      rows_cols = rows_cols,
                      reproductive_rate = reproductive_rate,
@@ -210,14 +238,14 @@ pops_model <-
                      natural_kappa = natural_kappa,
                      anthropogenic_dir = anthropogenic_dir,
                      anthropogenic_kappa = anthropogenic_kappa,
-                     output_frequency_n = output_frequency_n,
-                     quarantine_frequency_n = quarantine_frequency_n,
-                     spreadrate_frequency_n = spreadrate_frequency_n,
-                     mortality_frequency_n = mortality_frequency_n,
+                     frequencies_n_config = frequencies_n_config,
                      model_type_ = model_type_,
                      latency_period = latency_period,
                      dispersal_percentage = dispersal_percentage,
-                     overpopulation_config = overpopulation_config
+                     establishment_probability = establishment_probability,
+                     overpopulation_config = overpopulation_config,
+                     network_config = network_config,
+                     network_data_config = network_data_config
     )
 
   }