Fix 65 (#66)

* updated calibration code to fix #65

* added tests to explicitly check for error found in #65

* removed rgdal and devtools from imports

* updated suggests

* update github workflows

* update github workflows

* updated calibrate

.github/workflows/R-CMD-check.yaml

@@ -56,16 +56,31 @@ jobs:
             libproj-dev
 
       - name: Install dependencies
+        if: runner.os == 'macOS'
+        run: |
+          install.packages(c("remotes", "rcmdcheck"))
+          remotes::install_deps(dependencies = TRUE, type = "binary")
+        shell: Rscript {0}
+
+      - name: Install dependencies
+        if: runner.os == 'Linux'
         run: |
           install.packages(c("remotes", "rcmdcheck"))
           remotes::install_deps(dependencies = TRUE)
         shell: Rscript {0}
 
-      - name: Install rgdal from source
-        if: runner.os == 'macOS'
-        run: install.packages("rgdal", type = "source")
+      - name: Install dependencies
+        if: runner.os == 'Windows'
+        run: |
+          install.packages(c("remotes", "rcmdcheck"))
+          remotes::install_deps(dependencies = TRUE)
         shell: Rscript {0}
 
+      # - name: Install rgdal from source
+      #   if: runner.os == 'macOS'
+      #   run: install.packages("rgdal", type = "source")
+      #   shell: Rscript {0}
+
       - name: Check
         run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--no-multiarch"), error_on = "warning")
         shell: Rscript {0}

.github/workflows/lintr.yaml

@@ -35,7 +35,7 @@ jobs:
       - name: Install dependencies
         run: |
           install.packages(c("remotes"))
-          remotes::install_deps(dependencies = TRUE)
+          remotes::install_deps(dependencies = TRUE, type = "binary")
           remotes::install_cran("lintr")
         shell: Rscript {0}
 

DESCRIPTION

@@ -12,10 +12,8 @@ Authors@R: c(
 Depends: R (>= 3.3.0)
 Imports: 
     raster,
-    rgdal,
     Rcpp (>= 0.12.19),
     stats,
-    devtools,
     foreach,
     parallel,
     doParallel,
@@ -26,7 +24,8 @@ Imports:
     sp,
     utils,
     MASS,
-    methods
+    methods,
+    rgdal
 License: GPL-3 | file LICENSE
 BugReports: https://github.com/ncsu-landscape-dynamics/rpops/issues
 URL: http://www.github.com/ncsu-landscape-dynamics/rpops
@@ -36,8 +35,7 @@ SystemRequirements:
     C++11,
     GNU make
 Suggests: 
-    testthat,
-    covr
+    testthat
 LinkingTo: 
     Rcpp
 RoxygenNote: 7.1.1

R/calibrate.R

@@ -306,9 +306,10 @@ calibrate <- function(infected_years_file,
     acceptance_rate <- 1
     acceptance_rates <- matrix(ncol = 1, nrow = config$number_of_generations)
     infected_checks <- matrix(ncol = 1, nrow = config$number_of_generations)
-    locs_checks <- matrix(ncol = 1, nrow = config$number_of_generations)
-    dist_checks <- matrix(ncol = 1, nrow = config$number_of_generations)
-    res_error_checks <- matrix(ncol = 1, nrow = config$number_of_generations)
+    location_checks <- matrix(ncol = 1, nrow = config$number_of_generations)
+    distance_checks <- matrix(ncol = 1, nrow = config$number_of_generations)
+    residual_error_checks <-
+      matrix(ncol = 1, nrow = config$number_of_generations)
 
     # calculate comparison metrics for input data (still need to add in
     # configuration metrics to this)
@@ -342,12 +343,12 @@ calibrate <- function(infected_years_file,
     }
     # assign thresholds for summary static values to be compared to the
     # difference between the observed and simulated data
-    locs_check <- config$checks[1] # number of locations
-    dist_check <- config$checks[2] # minimum spatial distance
-    res_error_check <- config$checks[3] # residual error used when observations
-    # are very accurate with very few areas not sampled
-    inf_check <- config$checks[4] # number of pests found (either infected trees
-    # or pests)
+    location_check <- config$checks[1] # number of locations
+    distance_check <- config$checks[2] # minimum spatial distance
+    residual_error_check <- config$checks[3] # residual error used when
+    # observations are very accurate with very few areas not sampled
+    infected_check <- config$checks[4] # number of pests found (either infected
+    # trees or pests)
 
     # create raster data structures for storing simulated data for comparison
     infected_sims <- config$infection_years
@@ -430,9 +431,10 @@ calibrate <- function(infected_years_file,
         infected_sim_points <-
           vector(mode = "list", length = config$number_of_outputs)
         dist <- vector(mode = "list", length = config$number_of_outputs)
-        dist_diffs <- vector(mode = "list", length = config$number_of_outputs)
-        residual_diffs <- c()
-        residual_diffs <- length(config$number_of_outputs)
+        distance_differences <-
+          vector(mode = "list", length = config$number_of_outputs)
+        residual_differences <- c()
+        residual_differences <- length(config$number_of_outputs)
 
         # calculate comparison metrics for simulation data for each time step in
         # the simulation
@@ -451,7 +453,7 @@ calibrate <- function(infected_years_file,
 
           # calculate residual error for each time step
           diff_raster <- config$infection_years[[y]] - infected_sim
-          residual_diffs[[y]] <- abs(sum(diff_raster[diff_raster != 0]))
+          residual_differences[[y]] <- sum(diff_raster[diff_raster != 0])
 
           # calculate number of infection in the simulation
           num_infected_simulated[[y]] <- sum(infected_sim[infected_sim > 0])
@@ -476,9 +478,9 @@ calibrate <- function(infected_years_file,
                             lonlat = FALSE
               )
             if (class(dist) == "matrix") {
-              dist_diffs[[y]] <- apply(dist[[y]], 2, min)
+              distance_differences[[y]] <- apply(dist[[y]], 2, min)
             } else {
-              dist_diffs[[y]] <- dist[[y]]
+              distance_differences[[y]] <- dist[[y]]
             }
           }
         }
@@ -489,43 +491,47 @@ calibrate <- function(infected_years_file,
               "number of locations, number of infections, and total distance"
             )
         ) {
-          all_distances <- function(dist_diffs) {
-            dist_diffs <- round(sqrt(sum(dist_diffs^2)), digits = 0)
-            return(dist_diffs)
+          all_distances <- function(distance_differences) {
+            distance_differences <-
+              round(sqrt(sum(distance_differences^2)), digits = 0)
+            return(distance_differences)
           }
-          dist_diffs <- lapply(dist_diffs, all_distances)
-          dist_diffs <- unlist(dist_diffs, recursive = TRUE, use.names = TRUE)
+          distance_differences <- lapply(distance_differences, all_distances)
+          distance_differences <-
+            unlist(distance_differences, recursive = TRUE, use.names = TRUE)
         } else {
-          dist_diffs <- 0
+          distance_differences <- 0
         }
 
-        num_differences <- sqrt((num_infected_data - num_infected_simulated)^2)
-        locs_diffs <- sqrt((num_locs_data - num_locs_simulated)^2)
+        number_infected_differences <- sqrt((num_infected_data - num_infected_simulated)^2)
+        location_differences <- sqrt((num_locs_data - num_locs_simulated)^2)
 
-        num_difference <- sum(num_differences)
-        locs_diff <- sum(locs_diffs)
-        residual_diff <- sum(residual_diffs)
-        dist_diff <- sum(dist_diffs)
+        number_infected_difference <- sum(number_infected_differences)
+        location_difference <- sum(location_differences)
+        residual_difference <- sum(residual_differences)
+        distance_difference <- sum(distance_differences)
 
         # Check
         diff_checks <- FALSE
         if (success_metric == "number of locations and total distance") {
-          if (locs_diff <= locs_check && dist_diff <= dist_check) {
+          if (location_difference <= location_check &&
+              distance_difference <= distance_check) {
             diff_checks <- TRUE
           }
         } else if (success_metric == "number of locations") {
-          if (locs_diff <= locs_check) {
+          if (location_difference <= location_check) {
             diff_checks <- TRUE
           }
         } else if (success_metric == "residual error") {
-          if (residual_diff <= res_error_check) {
+          if (residual_difference <= residual_error_check) {
             diff_checks <- TRUE
           }
         } else if (success_metric ==
                 "number of locations, number of infections, and total distance"
         ) {
-          if (locs_diff <= locs_check &&
-              dist_diff <= dist_check && num_difference <= inf_check) {
+          if (location_difference <= location_check &&
+              distance_difference <= distance_check &&
+              number_infected_difference <= infected_check) {
             diff_checks <- TRUE
           }
         } else {
@@ -542,10 +548,10 @@ calibrate <- function(infected_years_file,
               proposed_anthropogenic_distance_scale,
               proposed_natural_kappa,
               proposed_anthropogenic_kappa,
-              num_difference,
-              locs_diff,
-              dist_diff,
-              residual_diff
+              number_infected_difference,
+              location_difference,
+              distance_difference,
+              residual_difference
             )
           config$current_particles <- config$current_particles + 1
           config$total_particles <- config$total_particles + 1
@@ -569,51 +575,18 @@ calibrate <- function(infected_years_file,
         colMeans(parameters_kept[start_index:end_index, 1:6])
       config$parameter_cov_matrix <-
         cov(parameters_kept[start_index:end_index, 1:6])
-      reproductive_rate_generation <-
-        as.data.frame(table(parameters_kept[start_index:end_index, 1]))
-      natural_distance_scale_generation <-
-        as.data.frame(table(parameters_kept[start_index:end_index, 2]))
-      percent_natural_dispersal_generation <-
-        as.data.frame(table(parameters_kept[start_index:end_index, 3]))
-      anthro_dis_scale <- parameters_kept[start_index:end_index, 3:4]
-      anthro_dis_scale <- anthro_dis_scale[anthro_dis_scale[, 1] < 1.000, ]
-      anthropogenic_distance_scale_generation <-
-        as.data.frame(table(anthro_dis_scale[, 2]))
-      names(reproductive_rate_generation) <- c("var1", "freq")
-      names(natural_distance_scale_generation) <- c("var1", "freq")
-      names(percent_natural_dispersal_generation) <- c("var1", "freq")
-      names(anthropogenic_distance_scale_generation) <- c("var1", "freq")
-
-      reproductive_rate_generation$freq <-
-        reproductive_rate_generation$freq / generation_size
-      natural_distance_scale_generation$freq <-
-        natural_distance_scale_generation$freq / generation_size
-      percent_natural_dispersal_generation$freq <-
-        percent_natural_dispersal_generation$freq / generation_size
-      anthropogenic_distance_scale_generation$freq <-
-        anthropogenic_distance_scale_generation$freq /
-        nrow(anthro_dis_scale[anthro_dis_scale[, 1] < 1.000, ])
-
-      reproductive_rate_generation$var1 <-
-        as.numeric(as.character(reproductive_rate_generation$var1))
-      natural_distance_scale_generation$var1 <-
-        as.numeric(as.character(natural_distance_scale_generation$var1))
-      percent_natural_dispersal_generation$var1 <-
-        as.numeric(as.character(percent_natural_dispersal_generation$var1))
-      anthropogenic_distance_scale_generation$var1 <-
-        as.numeric(as.character(anthropogenic_distance_scale_generation$var1))
 
       config$current_particles <- 1
       config$proposed_particles <- 1
       acceptance_rates[config$current_bin] <- acceptance_rate
-      infected_checks[config$current_bin] <- inf_check
-      locs_checks[config$current_bin] <- locs_check
-      dist_checks[config$current_bin] <- dist_check
-      res_error_checks[config$current_bin] <- res_error_check
-      inf_check <- median(parameters_kept[start_index:end_index, 7])
-      locs_check <- median(parameters_kept[start_index:end_index, 8])
-      dist_check <- median(parameters_kept[start_index:end_index, 9])
-      res_error_check <- median(parameters_kept[start_index:end_index, 10])
+      infected_checks[config$current_bin] <- infected_check
+      location_checks[config$current_bin] <- location_check
+      distance_checks[config$current_bin] <- distance_check
+      residual_error_checks[config$current_bin] <- residual_error_check
+      infected_check <- median(parameters_kept[start_index:end_index, 7])
+      location_check <- median(parameters_kept[start_index:end_index, 8])
+      distance_check <- median(parameters_kept[start_index:end_index, 9])
+      residual_error_check <- median(parameters_kept[start_index:end_index, 10])
       config$current_bin <- config$current_bin + 1
     }
 

R/configuration.R

@@ -1,7 +1,7 @@
 #' PoPS (configuration
 #'
-#' Function for with a single input and output list for parsing, transforming, 
-#' and performing all checks for all functions to run the pops c++ model 
+#' Function for with a single input and output list for parsing, transforming,
+#' and performing all checks for all functions to run the pops c++ model
 #'
 #' @param config list of all data necessary used to set up c++ model
 #'
@@ -109,7 +109,7 @@ configuration <- function(config) {
 
   susceptible <- host - infected
   susceptible[susceptible < 0] <- 0
-  
+
   # check that temperature raster has the same crs, resolution, and extent
   if (config$use_lethal_temperature == TRUE) {
     temperature_check <- secondary_raster_checks(

tests/testthat.R

@@ -1,4 +1,5 @@
 library(testthat)
+library(raster)
 library(PoPS)
 
-test_check("PoPS")
+testthat::test_check("PoPS")