Skip to content

Commit 4c4c735

Browse files
ChrisJones687ChrisJones687
committed
updates to pops and config based on new yaml and testing
1 parent 47ec18f commit 4c4c735

File tree

2 files changed

+69
-78
lines changed

2 files changed

+69
-78
lines changed

‎R/configuration.R‎

Lines changed: 65 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,10 @@ configuration <- function(config_file, testing = FALSE) {
3535
config$rclmat <- matrix(config$rcl, ncol = 3, byrow = TRUE)
3636

3737
if (is.null(config$random_seed)) {
38-
config$random_seed_list <- as.integer(sample.int(1e9, config$number_of_iterations, replace = FALSE))
38+
config$random_seed_list <-
39+
as.integer(sample.int(1e9, config$number_of_iterations, replace = FALSE))
40+
} else {
41+
config$random_seed_list <- rep(config$random_seed, config$number_of_iterations)
3942
}
4043

4144
set.seed(config$random_seed_list[[1]])
@@ -206,13 +209,11 @@ configuration <- function(config_file, testing = FALSE) {
206209
if (config$start_with_soil_populations) {
207210
if (config$use_s3) {
208211
soils_check <-
209-
secondary_raster_checks(
210-
file_return(config$soil_starting_pest_file),
211-
total_populations, config$use_s3, config$bucket)
212+
secondary_raster_checks(file_return(config$soil_starting_pest_file),
213+
total_populations, config$use_s3, config$bucket)
212214
} else {
213215
soils_check <-
214-
secondary_raster_checks(file_return(config$soil_starting_pest_file),
215-
total_populations)
216+
secondary_raster_checks(file_return(config$soil_starting_pest_file), total_populations)
216217
}
217218
if (soils_check$checks_passed) {
218219
soil_pests <- soils_check$raster
@@ -241,8 +242,8 @@ configuration <- function(config_file, testing = FALSE) {
241242
total_populations, config$use_s3, config$bucket)
242243
} else {
243244
survival_rate_check <-
244-
secondary_raster_checks(file.path(config$input_path,
245-
config$overwinter_survival_rates_file), total_populations)
245+
secondary_raster_checks(file_return(config$overwinter_survival_rates_file),
246+
total_populations)
246247
}
247248
if (survival_rate_check$checks_passed) {
248249
survival_rates_stack <- survival_rate_check$raster
@@ -275,8 +276,7 @@ configuration <- function(config_file, testing = FALSE) {
275276
total_populations, config$use_s3, config$bucket)
276277
} else {
277278
temperature_check <-
278-
secondary_raster_checks(file_return(config$lethal_temperature_file),
279-
total_populations)
279+
secondary_raster_checks(file_return(config$lethal_temperature_file), total_populations)
280280
}
281281
if (temperature_check$checks_passed) {
282282
temperature_stack <- temperature_check$raster
@@ -309,18 +309,16 @@ configuration <- function(config_file, testing = FALSE) {
309309
total_populations, config$use_s3, config$bucket)
310310
if (config$weather_type == "probabilistic") {
311311
temperature_coefficient_sd_check <-
312-
secondary_raster_checks(
313-
file_return(config$temperature_coefficient_sd_file),
314-
total_populations, config$use_s3, config$bucket)
312+
secondary_raster_checks(file_return(config$temperature_coefficient_sd_file),
313+
total_populations, config$use_s3, config$bucket)
315314
}
316315
} else {
317316
temperature_coefficient_check <-
318-
secondary_raster_checks(file_return(config$temperature_coefficient_file),
319-
total_populations)
317+
secondary_raster_checks(file_return(config$temperature_coefficient_file), total_populations)
320318
if (config$weather_type == "probabilistic") {
321319
temperature_coefficient_sd_check <-
322-
secondary_raster_checks(
323-
file_return(config$temperature_coefficient_sd_file), total_populations)
320+
secondary_raster_checks(file_return(config$temperature_coefficient_sd_file),
321+
total_populations)
324322
}
325323
}
326324

@@ -361,13 +359,11 @@ configuration <- function(config_file, testing = FALSE) {
361359
if (config$use_precipitation == TRUE) {
362360
if (config$use_s3) {
363361
precipitation_coefficient_check <-
364-
secondary_raster_checks(
365-
file_return(config$precipitation_coefficient_file),
362+
secondary_raster_checks(file_return(config$precipitation_coefficient_file),
366363
total_populations, config$use_s3, config$bucket)
367364
if (config$weather_type == "probabilistic") {
368365
precipitation_coefficient_sd_check <-
369-
secondary_raster_checks(
370-
file_return(config$precipitation_coefficient_sd_file),
366+
secondary_raster_checks(file_return(config$precipitation_coefficient_sd_file),
371367
total_populations, config$use_s3, config$bucket)
372368
}
373369

@@ -378,8 +374,7 @@ configuration <- function(config_file, testing = FALSE) {
378374
if (config$weather_type == "probabilistic") {
379375
precipitation_coefficient_sd_check <-
380376
secondary_raster_checks(
381-
file_return(config$precipitation_coefficient_sd_file),
382-
total_populations)
377+
file_return(config$precipitation_coefficient_sd_file), total_populations)
383378
}
384379
}
385380

@@ -389,8 +384,7 @@ configuration <- function(config_file, testing = FALSE) {
389384
config$failure <- precipitation_coefficient_check$failed_check
390385
if (config$failure == file_exists_error) {
391386
config$failure <-
392-
detailed_file_exists_error(
393-
file_return(config$precipitation_coefficient_file))
387+
detailed_file_exists_error(file_return(config$precipitation_coefficient_file))
394388
}
395389
print(config$failure)
396390
return(config)
@@ -403,8 +397,7 @@ configuration <- function(config_file, testing = FALSE) {
403397
config$failure <- precipitation_coefficient_sd_check$failed_check
404398
if (config$failure == file_exists_error) {
405399
config$failure <-
406-
detailed_file_exists_error(
407-
file_return(config$precipitation_coefficient_sd_file))
400+
detailed_file_exists_error(file_return(config$precipitation_coefficient_sd_file))
408401
}
409402
print(config$failure)
410403
return(config)
@@ -422,23 +415,20 @@ configuration <- function(config_file, testing = FALSE) {
422415
} else if (config$use_precipitation == TRUE) {
423416
if (config$use_s3) {
424417
precipitation_coefficient_check <-
425-
secondary_raster_checks(
426-
file_return(config$precipitation_coefficient_file),
418+
secondary_raster_checks(file_return(config$precipitation_coefficient_file),
427419
total_populations, config$use_s3, config$bucket)
428420
if (config$weather_type == "probabilistic") {
429421
precipitation_coefficient_sd_check <-
430-
secondary_raster_checks(
431-
file_return(config$precipitation_coefficient_sd_file),
422+
secondary_raster_checks(file_return(config$precipitation_coefficient_sd_file),
432423
total_populations, config$use_s3, config$bucket)
433424
}
434425
} else {
435426
precipitation_coefficient_check <-
436-
secondary_raster_checks(
437-
file_return(config$precipitation_coefficient_file), total_populations)
427+
secondary_raster_checks(file_return(config$precipitation_coefficient_file),
428+
total_populations)
438429
if (config$weather_type == "probabilistic") {
439430
precipitation_coefficient_sd_check <-
440-
secondary_raster_checks(
441-
file_return(config$precipitation_coefficient_sd_file),
431+
secondary_raster_checks(file_return(config$precipitation_coefficient_sd_file),
442432
total_populations)
443433
}
444434
}
@@ -449,8 +439,7 @@ configuration <- function(config_file, testing = FALSE) {
449439
config$failure <- precipitation_coefficient_check$failed_check
450440
if (config$failure == file_exists_error) {
451441
config$failure <-
452-
detailed_file_exists_error(
453-
file_return(config$precipitation_coefficient_file))
442+
detailed_file_exists_error(file_return(config$precipitation_coefficient_file))
454443
}
455444
print(config$failure)
456445
return(config)
@@ -463,8 +452,7 @@ configuration <- function(config_file, testing = FALSE) {
463452
config$failure <- precipitation_coefficient_sd_check$failed_check
464453
if (config$failure == file_exists_error) {
465454
config$failure <-
466-
detailed_file_exists_error(
467-
file_return(config$precipitation_coefficient_sd_file))
455+
detailed_file_exists_error(file_return(config$precipitation_coefficient_sd_file))
468456
}
469457
print(config$failure)
470458
return(config)
@@ -494,14 +482,13 @@ configuration <- function(config_file, testing = FALSE) {
494482
current_month <- i %% 12
495483
current_month <- ifelse(current_month == 0, 12, current_month)
496484

497-
if (current_month >= config$season_month_start && current_month
498-
<= config$season_month_end) {
499-
config$weather_coefficient[[i]] <- terra::as.matrix(weather_coefficient_stack[[i]],
500-
wide = TRUE)
501-
} else {
502-
config$weather_coefficient[[i]] <- matrix(0, 2, 2)
503-
}
485+
if (current_month >= config$season_month_start && current_month <= config$season_month_end) {
486+
config$weather_coefficient[[i]] <-
487+
terra::as.matrix(weather_coefficient_stack[[i]], wide = TRUE)
488+
} else {
489+
config$weather_coefficient[[i]] <- matrix(0, 2, 2)
504490
}
491+
}
505492

506493
if (config$weather_type == "probabilistic") {
507494
if (config$number_annual_time_steps > config$weather_size) {
@@ -522,33 +509,34 @@ configuration <- function(config_file, testing = FALSE) {
522509
current_month <- ifelse(current_month == 0, 12, current_month)
523510

524511
if (current_month >= config$season_month_start && current_month
525-
<= config$season_month_end) {
526-
config$weather_coefficient_sd[[i]] <- terra::as.matrix(weather_coefficient_sd_stack[[i]],
527-
wide = TRUE)
528-
} else {
529-
config$weather_coefficient_sd[[i]] <- matrix(0, 2, 2)
530-
}
531-
}
532-
} else {
533-
config$weather_coefficient_sd <- list(zero_matrix)
512+
<= config$season_month_end) {
513+
config$weather_coefficient_sd[[i]] <-
514+
terra::as.matrix(weather_coefficient_sd_stack[[i]], wide = TRUE)
515+
} else {
516+
config$weather_coefficient_sd[[i]] <- matrix(0, 2, 2)
534517
}
518+
}
535519
} else {
536-
config$weather_size <- 1
537-
config$weather_type <- "None"
538-
config$weather_coefficient <- list(one_matrix)
539520
config$weather_coefficient_sd <- list(zero_matrix)
540-
config$weather_type <- "none"
541521
}
522+
} else {
523+
config$weather_size <- 1
524+
config$weather_type <- "None"
525+
config$weather_coefficient <- list(one_matrix)
526+
config$weather_coefficient_sd <- list(zero_matrix)
527+
config$weather_type <- "none"
528+
}
542529

543530
rm(one_matrix)
544531

545532
if (config$use_treatment == TRUE) {
546533
if (config$use_s3) {
547534
treatments_check <-
548-
secondary_raster_checks(config$treatments_file, total_populations, config$use_s3,
549-
config$bucket)
535+
secondary_raster_checks(file_return(config$treatments_file),
536+
total_populations, config$use_s3, config$bucket)
550537
} else {
551-
treatments_check <- secondary_raster_checks(config$treatments_file, total_populations)
538+
treatments_check <-
539+
secondary_raster_checks(file_return(config$treatments_file), total_populations)
552540
}
553541

554542
if (treatments_check$checks_passed) {
@@ -583,14 +571,15 @@ configuration <- function(config_file, testing = FALSE) {
583571
# setup up movements to be used in the model converts from lat/long to i/j
584572
if (config$use_movements) {
585573
movements_check <-
586-
movement_checks(config$movements_file, total_populations, config$start_date, config$end_date)
574+
movement_checks(file_return(config$movements_file),
575+
total_populations, config$start_date, config$end_date)
587576
if (movements_check$checks_passed) {
588577
config$movements <- movements_check$movements
589578
config$movements_dates <- movements_check$movements_dates
590579
} else {
591580
config$failure <- movements_check$failed_check
592581
if (config$failure == file_exists_error) {
593-
config$failure <- detailed_file_exists_error(config$movements_file)
582+
config$failure <- detailed_file_exists_error(file_return(config$movements_file))
594583
}
595584
print(config$failure)
596585
return(config)
@@ -622,17 +611,15 @@ configuration <- function(config_file, testing = FALSE) {
622611
total_populations, config$use_s3, config$bucket)
623612
} else {
624613
host_check <-
625-
secondary_raster_checks(file_return(config$host_files)[i],
626-
total_populations)
614+
secondary_raster_checks(file_return(config$host_files)[i], total_populations)
627615
}
628616
if (host_check$checks_passed) {
629617
host <- host_check$raster
630618
config$host <- host
631619
} else {
632620
config$failure <- host_check$failed_check
633621
if (config$failure == file_exists_error) {
634-
config$failure <-
635-
detailed_file_exists_error(file_return(config$host_files)[i])
622+
config$failure <- detailed_file_exists_error(file_return(config$host_files)[i])
636623
}
637624
print(config$failure)
638625
return(config)
@@ -676,8 +663,7 @@ configuration <- function(config_file, testing = FALSE) {
676663
total_populations, config$use_s3, config$bucket)
677664
} else {
678665
infected_check <-
679-
secondary_raster_checks(file_return(config$starting_infected_files)[i],
680-
total_populations)
666+
secondary_raster_checks(file_return(config$starting_infected_files)[i], total_populations)
681667
}
682668
if (infected_check$checks_passed) {
683669
infected <- infected_check$raster
@@ -763,8 +749,7 @@ configuration <- function(config_file, testing = FALSE) {
763749
} else {
764750
config$failure <- exposed_check$failed_check
765751
if (config$failure == file_exists_error) {
766-
config$failure <-
767-
detailed_file_exists_error(file_return(config$exposed_files)[i])
752+
config$failure <- detailed_file_exists_error(file_return(config$exposed_files)[i])
768753
}
769754
print(config$failure)
770755
return(config)
@@ -889,6 +874,7 @@ configuration <- function(config_file, testing = FALSE) {
889874
config$rows_cols <- rows_cols
890875

891876
# check that network parameters are of the same length and correct type
877+
config$network_files <- file_return(config$network_files)
892878
if (config$anthropogenic_kernel_type == "network") {
893879
if (length(config$network_min_distances) != length(config$network_files)) {
894880
config$failure <- network_length_error
@@ -903,7 +889,6 @@ configuration <- function(config_file, testing = FALSE) {
903889
config$failure <- network_length_error
904890
}
905891

906-
907892
if (any(config$network_min_distances < config$res$ew_res / 2)) {
908893
config$failure <- network_min_distance_small_error
909894
print(config$failure)
@@ -943,9 +928,10 @@ configuration <- function(config_file, testing = FALSE) {
943928

944929
if (!is.null(config$mask)) {
945930
if (config$use_s3) {
946-
mask_check <- secondary_raster_checks(config$mask, infected, config$use_s3, config$bucket)
931+
mask_check <- secondary_raster_checks(file_return(config$mask), infected,
932+
config$use_s3, config$bucket)
947933
} else {
948-
mask_check <- secondary_raster_checks(config$mask, infected)
934+
mask_check <- secondary_raster_checks(file_return(config$mask), infected)
949935
}
950936
if (mask_check$checks_passed) {
951937
mask <- mask_check$raster
@@ -976,9 +962,11 @@ configuration <- function(config_file, testing = FALSE) {
976962
if (config$use_quarantine) {
977963
if (config$use_s3) {
978964
quarantine_check <-
979-
secondary_raster_checks(config$quarantine_areas_file, host, config$use_s3, config$bucket)
965+
secondary_raster_checks(file_return(config$quarantine_areas_file),
966+
host, config$use_s3, config$bucket)
980967
} else {
981-
quarantine_check <- secondary_raster_checks(config$quarantine_areas_file, host)
968+
quarantine_check <-
969+
secondary_raster_checks(file_return(config$quarantine_areas_file), host)
982970
}
983971

984972
if (quarantine_check$checks_passed) {

‎R/pops.r‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
#' forecast spread of the pest/pathogen into the future. This function performs
88
#' a single stochastic realization of the model and is predominantly used for
99
#' automated tests of model features.
10-
#' @param config_rds_file Path to config file produced when calling `configuration`.
10+
#' @param config Path to config file produced when calling `configuration`.
1111
#' The config file includes all data necessary used to set up c++ PoPS model
1212
#'
1313
#' @useDynLib PoPS, .registration = TRUE
@@ -24,6 +24,9 @@
2424

2525
pops <- function(config) {
2626

27+
if (!is.null(config$failure)) {
28+
stop(config$failure)
29+
}
2730
set.seed(config$random_seed_list[[1]])
2831
config <- draw_parameters(config) # draws parameter set for the run
2932
config <- host_pool_setup(config)

0 commit comments

Comments
 (0)