add soil activation

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, 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, 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, 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)
 }
 
 # Register entry points for exported C++ functions

R/calibrate.R

@@ -396,6 +396,7 @@ calibrate <- function(infected_years_file,
         reproductive_rate = reproductive_rate,
         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,
@@ -440,8 +441,8 @@ calibrate <- function(infected_years_file,
         network_movement = config$network_movement,
         weather_size = config$weather_size,
         weather_type = config$weather_type,
-        dispersers_to_soils_percentage = config$dispersers_to_soils_percentage
-      )
+        dispersers_to_soils_percentage = config$dispersers_to_soils_percentage,
+        use_soils = config$use_soils)
       return(data)
     }
 

R/configuration.R

@@ -150,9 +150,9 @@ configuration <- function(config) {
     return(config)
   }
 
-  zero_matrix <- infected[[1]]
-  terra::values(zero_matrix) <- 0
-  zero_matrix <- terra::as.matrix(zero_matrix, wide = TRUE)
+  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
@@ -194,6 +194,11 @@ configuration <- function(config) {
 
   # check that soils raster has the same crs, resolutin, and extent.
   if (config$use_soils) {
+    config$soil_survival_steps <- ceiling(1 / config$dispersers_to_soils_percentage)
+    soil_reservoirs <- list(zero_matrix)
+    for (sr in 2:(config$soil_survival_steps)) {
+      soil_reservoirs[[sr]] <- zero_matrix
+    }
     if (config$start_with_soil_populations) {
       if (config$function_name %in% aws_bucket_list) {
         soils_check <-
@@ -204,19 +209,18 @@ configuration <- function(config) {
       }
       if (soils_check$checks_passed) {
         soil_pests <- soils_check$raster
-        config$soil_pests <- terra::as.matrix(soil_pests, wide = TRUE)
+        soil_reservoirs[[config$soil_survival_steps]] <- terra::as.matrix(soil_pests, wide = TRUE)
       } else {
         config$failure <- soils_check$failed_check
         if (config$failure == file_exists_error) {
           config$failure <- detailed_file_exists_error(config$soil_starting_pest_file)
         }
         return(config)
       }
-    } else {
-      config$soil_pests <- zero_matrix
     }
+    config$soil_reservoirs <- soil_reservoirs
   } else {
-    config$soil_pests <- zero_matrix
+    config$soil_reservoirs <- list(zero_matrix)
   }
 
   # check that survival_rates raster has the same crs, resolution, and extent

R/pops.r

@@ -438,6 +438,7 @@ pops <- function(infected_file,
                      reproductive_rate = config$reproductive_rate[1],
                      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,
@@ -482,7 +483,8 @@ pops <- function(infected_file,
                      network_movement = config$network_movement,
                      weather_size = config$weather_size,
                      weather_type = config$weather_type,
-                     dispersers_to_soils_percentage = config$dispersers_to_soils_percentage)
+                     dispersers_to_soils_percentage = config$dispersers_to_soils_percentage,
+                     use_soils = config$use_soils)
 
   return(data)
 }

R/pops_model.R

@@ -79,6 +79,7 @@
 #' series ("deterministic")
 #' @param dispersers_to_soils_percentage range from 0 to 1 representing the percentage
 #' of dispersers that fall to the soil and survive.
+#' @param soil_reservoirs list of matrices with soil pests created from soil_pest_file.
 #'
 #' @return list of vector matrices of infected and susceptible hosts per
 #' simulated year and associated statistics (e.g. spread rate)
@@ -124,6 +125,7 @@ pops_model <-
            reproductive_rate,
            spatial_indices,
            season_month_start_end,
+           soil_reservoirs,
            mortality_rate = 0.0,
            mortality_time_lag = 2,
            start_date = "2018-01-01",
@@ -168,7 +170,8 @@ pops_model <-
            network_movement = "walk",
            weather_size = 0,
            weather_type = "deterministic",
-           dispersers_to_soils_percentage = 0) {
+           dispersers_to_soils_percentage = 0,
+           use_soils = FALSE) {
 
     # List of overpopulation parameters of type double
     overpopulation_config <- c()
@@ -220,6 +223,7 @@ pops_model <-
     bool_config$dispersal_stochasticity <- dispersal_stochasticity
     bool_config$use_overpopulation_movements <- use_overpopulation_movements
     bool_config$use_survival_rate <- use_survival_rates
+    bool_config$use_soils <- use_soils
 
 
     data <-
@@ -251,6 +255,7 @@ pops_model <-
                      bbox = bbox,
                      res = res,
                      rows_cols = rows_cols,
+                     soil_reservoirs = soil_reservoirs,
                      reproductive_rate = reproductive_rate,
                      spatial_indices = spatial_indices,
                      season_month_start_end = season_month_start_end,

R/pops_multirun.R

@@ -288,6 +288,7 @@ pops_multirun <- function(infected_file,
         reproductive_rate = config$reproductive_rate,
         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,
@@ -332,7 +333,8 @@ pops_multirun <- function(infected_file,
         network_movement = config$network_movement,
         weather_size = config$weather_size,
         weather_type = config$weather_type,
-        dispersers_to_soils_percentage = config$dispersers_to_soils_percentage)
+        dispersers_to_soils_percentage = config$dispersers_to_soils_percentage,
+        use_soils = config$use_soils)
 
       run <- c()
       run$single_run <- data$infected

R/validate.R

@@ -306,6 +306,7 @@ validate <- function(infected_years_file,
         reproductive_rate = config$reproductive_rate,
         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,
@@ -350,8 +351,8 @@ validate <- function(infected_years_file,
         network_movement = config$network_movement,
         weather_size = config$weather_size,
         weather_type = config$weather_type,
-        dispersers_to_soils_percentage = config$dispersers_to_soils_percentage
-      )
+        dispersers_to_soils_percentage = config$dispersers_to_soils_percentage,
+        use_soils = config$use_soils)
 
 
       all_disagreement <-