From 5f5d2e067905a0a144e7706a8fa4a4466edbce79 Mon Sep 17 00:00:00 2001 From: Jeffrey Hanson Date: Tue, 2 Nov 2021 16:07:56 +1300 Subject: [PATCH] fix issue when upper elev < lower elev --- R/format_spp_data.R | 12 ++++ tests/testthat/test_create_spp_aoh_data.R | 71 +++++++++++++++++++++++ 2 files changed, 83 insertions(+) diff --git a/R/format_spp_data.R b/R/format_spp_data.R index b9b047e6..276124c5 100644 --- a/R/format_spp_data.R +++ b/R/format_spp_data.R @@ -90,6 +90,18 @@ format_spp_data <- function(x, spp_summary_data$elevation_lower[idx] <- -Inf idx <- is.na(spp_summary_data$elevation_upper) spp_summary_data$elevation_upper[idx] <- Inf + ## ensure that lower elevation limit is <= upper elevation limit + idx <- which( + is.finite(spp_summary_data$elevation_lower) & + is.finite(spp_summary_data$elevation_upper) + ) + if (length(idx) > 0) { + l <- spp_summary_data$elevation_lower[idx] + u <- spp_summary_data$elevation_upper[idx] + spp_summary_data$elevation_lower[idx] <- pmin(l, u) + spp_summary_data$elevation_upper[idx] <- pmax(l, u) + rm(l, u) + } ## extract relevant columns nms <- c("id_no", "elevation_lower", "elevation_upper") spp_summary_data <- spp_summary_data[, nms, drop = FALSE] diff --git a/tests/testthat/test_create_spp_aoh_data.R b/tests/testthat/test_create_spp_aoh_data.R index c1a41feb..c2e4aed4 100644 --- a/tests/testthat/test_create_spp_aoh_data.R +++ b/tests/testthat/test_create_spp_aoh_data.R @@ -134,6 +134,77 @@ test_that("some species missing habitat data", { unlink(output_dir2, recursive = TRUE) }) +test_that("species with reversed elevation limits", { + # skip if needed + skip_on_cran() + # specify file path + f <- system.file("testdata", "SIMULATED_SPECIES.zip", package = "aoh") + elevation_data <- terra::rast( + system.file("testdata", "sim_elevation_data.tif", package = "aoh") + ) + habitat_data <- terra::rast( + system.file("testdata", "sim_habitat_data.tif", package = "aoh") + ) + spp_habitat_data <- read.csv( + system.file("testdata", "sim_spp_habitat_data.csv", package = "aoh"), + sep = ",", header = TRUE + ) + spp_summary_data <- read.csv( + system.file("testdata", "sim_spp_summary_data.csv", package = "aoh"), + sep = ",", header = TRUE + ) + # load data + d <- read_spp_range_data(f) + # create copy of spp_summary_data with reversed elevation data + spp_summary_data_alt <- spp_summary_data + spp_summary_data_alt$elevation_lower <- spp_summary_data$elevation_upper + spp_summary_data_alt$elevation_upper <- spp_summary_data$elevation_lower + # create output dirs + output_dir1 <- tempfile() + output_dir2 <- tempfile() + dir.create(output_dir1, showWarnings = FALSE, recursive = TRUE) + dir.create(output_dir2, showWarnings = FALSE, recursive = TRUE) + # create objects + x1 <- create_spp_aoh_data( + x = d, + output_dir = output_dir1, + habitat_data = habitat_data, + elevation_data = elevation_data, + spp_habitat_data = spp_habitat_data, + spp_summary_data = spp_summary_data, + force = TRUE, + verbose = FALSE + ) + x2 <- create_spp_aoh_data( + x = d, + output_dir = output_dir2, + habitat_data = habitat_data, + elevation_data = elevation_data, + spp_habitat_data = spp_habitat_data, + spp_summary_data = spp_summary_data_alt, + force = TRUE, + verbose = FALSE + ) + # tests + expect_equal( + dplyr::select(x1, -path), + dplyr::select(x2, -path) + ) + expect_equal( + lapply( + x1$path, + function(x) terra::values(terra::rast(x)) + ), + lapply( + x2$path, + function(x) terra::values(terra::rast(x)) + ) + ) + # clean up + unlink(output_dir1, recursive = TRUE) + unlink(output_dir2, recursive = TRUE) +}) + test_that("GDAL processing", { # skip if needed skip_on_cran()