From 652c5f41caa7acb6c13884e9b9ae7993f787b11d Mon Sep 17 00:00:00 2001 From: "@stangandaho" Date: Tue, 23 Apr 2024 14:18:51 +0200 Subject: [PATCH] action & coverage --- .github/workflows/R-CMD-check.yaml | 6 +- .github/workflows/test-coverage.yaml | 2 +- R/nm_boyce.R | 3 +- man/nm_boyce.Rd | 7 +- tests/testthat/test-nm_find_hcv.R | 16 +- tests/testthat/test-nm_match_raster.R | 27 +- tests/testthat/test-nm_predict.R | 383 +++++++++++++++++++++++++- 7 files changed, 426 insertions(+), 18 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 16ff6c4..daecbdc 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -18,7 +18,7 @@ jobs: config: - {os: macos-latest, r: 'release'} - {os: windows-latest, r: 'release'} - - {os: ubuntu-latest, r: 'release'} + #- {os: ubuntu-latest, r: 'release'} #- {os: windows-latest, r: '3.6'} #- {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} #- {os: ubuntu-latest, r: 'oldrel-1'} @@ -29,7 +29,7 @@ jobs: CRAN: ${{ matrix.config.rspm }} steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-r@v2 with: @@ -38,7 +38,7 @@ jobs: - uses: r-lib/actions/setup-pandoc@v2 - name: Cache R packages - uses: actions/cache@v2 + uses: actions/cache@v4 with: path: ${{ env.R_LIBS_USER }} key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 13abd28..980da4c 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -14,7 +14,7 @@ jobs: env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v3 + - uses: actions/checkout@v4 - uses: r-lib/actions/setup-r@v2 with: diff --git a/R/nm_boyce.R b/R/nm_boyce.R index 4889e23..e065160 100644 --- a/R/nm_boyce.R +++ b/R/nm_boyce.R @@ -32,7 +32,6 @@ #' presence_predicted <- sqrt(runif(100)) #' contrast <- runif(1000) #' nm_boyce(presence_predicted, contrast) -#' contBoyce2x(presence_predicted, contrast) #' presence_weight <- c(rep(1, 10), rep(0.5, 90)) #' nm_boyce(presence_predicted, contrast, presence_weight=presence_weight) #' @@ -40,7 +39,7 @@ nm_boyce <- function( presence_predicted, contrast, - numBins = 101, + num_bins = 101, bin_width = 0.1, presence_weight = rep(1, length(presence_predicted)), contrast_weight = rep(1, length(contrast)), diff --git a/man/nm_boyce.Rd b/man/nm_boyce.Rd index 8787a19..5fc79ec 100644 --- a/man/nm_boyce.Rd +++ b/man/nm_boyce.Rd @@ -7,7 +7,7 @@ nm_boyce( presence_predicted, contrast, - numBins = 101, + num_bins = 101, bin_width = 0.1, presence_weight = rep(1, length(presence_predicted)), contrast_weight = rep(1, length(contrast)), @@ -26,6 +26,8 @@ nm_boyce( \item{contrast}{Numeric vector. Predicted values at background sites.} +\item{num_bins}{Positive integer. Number of (overlapping) bins into which to divide predictions.} + \item{bin_width}{Positive numeric value < 1. Size of a bin. Each bin will be \code{bin_width * (max - min)}. If \code{autoWindow} is \code{FALSE} (the default) then \code{min} is 0 and \code{max} is 1. If \code{autoWindow} is \code{TRUE} then \code{min} and \code{max} are the maximum and minimum value of all predictions in the background and presence sets (i.e., not necessarily 0 and 1).} \item{presence_weight}{Numeric vector same length as \code{presence_predicted}. Relative weights of presence sites. The default is to assign each presence a weight of 1.} @@ -47,8 +49,6 @@ nm_boyce( \item{bg_weight}{Same as \code{contrast_weight}. Included for backwards compatibility. Ignored if \code{contrast_weight} is not \code{NULL}.} \item{...}{Other arguments (not used).} - -\item{num_bins}{Positive integer. Number of (overlapping) bins into which to divide predictions.} } \value{ Numeric value. @@ -65,7 +65,6 @@ set.seed(123) presence_predicted <- sqrt(runif(100)) contrast <- runif(1000) nm_boyce(presence_predicted, contrast) -contBoyce2x(presence_predicted, contrast) presence_weight <- c(rep(1, 10), rep(0.5, 90)) nm_boyce(presence_predicted, contrast, presence_weight=presence_weight) diff --git a/tests/testthat/test-nm_find_hcv.R b/tests/testthat/test-nm_find_hcv.R index a4b92ec..c262b05 100644 --- a/tests/testthat/test-nm_find_hcv.R +++ b/tests/testthat/test-nm_find_hcv.R @@ -6,9 +6,19 @@ testthat::test_that("Test find highly correlated variables", { weigth <- abs(rnorm(150, 56.2, 11.4)) glucose_rate <- runif(150, .2, .6) - test_data <- data.frame(age, heigth, weigth, glucose_rate) %>% - cor() + samp_data <- data.frame(age, heigth, weigth, glucose_rate) + test_cor <- samp_data%>% cor() # highly correlated variables - testthat::expect_equal(class(nm_find_hcv(x = test_data)), "character") + testthat::expect_equal(class(nm_find_hcv(x = test_cor)), "character") + testthat::expect_equal(class(nm_find_hcv(x = test_cor, verbose = TRUE)), "character") + + + samp_data$na_v <- sample(x = rep(c(1, NA, 5, 2, 5,9), 200), size = 150) + test_cor <- samp_data%>% cor() + + expect_error(nm_find_hcv(x = test_cor)) + expect_error(nm_find_hcv(x = c(12, 45, 6))) + + rm(samp_data, test_cor) }) diff --git a/tests/testthat/test-nm_match_raster.R b/tests/testthat/test-nm_match_raster.R index 4186954..e1846ee 100644 --- a/tests/testthat/test-nm_match_raster.R +++ b/tests/testthat/test-nm_match_raster.R @@ -2,18 +2,37 @@ test_that("test for nm_match_raster", { library(terra) env_layers_path <- paste0(system.file("extdata", package = "nimo"), "/env_layers") - env_layers_path <- list.files(env_layers_path, full.names = TRUE)[1:2] + env_layers_path <- list.files(env_layers_path, pattern = ".tif$", full.names = TRUE)[1:2] target <- terra::rast(env_layers_path[1]) # reference raster to get properties from to_match <- terra::rast(env_layers_path[2]) # raster that will inherit properties - + # new_dnw <- nm_match_raster(to_match = to_match, target = target) - expect_true(class(new_dnw) == "SpatRaster") expect_error( nm_match_raster(to_match = to_match, target = target, method = "linear") ) + expect_error( + nm_match_raster(to_match = to_match, target = "", method = "linear") + ) + + # + new_dnw <- nm_match_raster(to_match = to_match, target = target, + save_file = T, file_name = "test.tif") + expect_true(file.exists(paste0(getwd(), "/test.tif"))) + unlink(paste0(getwd(), "/test.tif"), recursive = T) + + # + new_dnw <- nm_match_raster(to_match = to_match, target = target, + save_file = T) + save_path <- paste0( + dirname(terra::sources(to_match)), "/", + gsub("\\..*$", "", basename(terra::sources(to_match))), "_matched.tif" + ) + expect_true(file.exists(save_path)) + unlink(save_path, recursive = T) + - rm(env_layers_path, target, to_match, new_dnw) + rm(env_layers_path, target, to_match, new_dnw, save_path) }) diff --git a/tests/testthat/test-nm_predict.R b/tests/testthat/test-nm_predict.R index 8c5d67d..4a45243 100644 --- a/tests/testthat/test-nm_predict.R +++ b/tests/testthat/test-nm_predict.R @@ -31,7 +31,7 @@ test_that("test for fit_ function family", { ) - # gam + # bioclim bioc <- nm_fit_bioclim( data = spp_, response = "pr_ab", @@ -40,6 +40,7 @@ test_that("test for fit_ function family", { thr = c("max_sens_spec") ) + p <- nm_predict( models = bioc, pred = somevar, @@ -50,4 +51,384 @@ test_that("test for fit_ function family", { expect_true(class(p[[1]]) == "SpatRaster") expect_equal(terra::nlyr(p[[1]]), 1) rm(p) + + + # gau + gau <- fit_gau( + data = spp_, + response = "pr_ab", + predictors = c("CFP_1", "CFP_2", "CFP_3", "CFP_4"), + predictors_f = "category", + partition = ".part", + thr = c("max_sens_spec") + ) + + p <- nm_predict( + models = gau, + pred = somevar, + thr = NULL, + con_thr = FALSE + ) + expect_true(class(p[[1]]) == "SpatRaster") + rm(p) + + # gbm + gbm <- fit_gbm( + data = spp_, + response = "pr_ab", + predictors = c("CFP_1", "CFP_2", "CFP_3", "CFP_4"), + predictors_f = "category", + partition = ".part", + thr = c("max_sens_spec") + ) + + p <- nm_predict( + models = gbm, + pred = somevar, + thr = NULL, + con_thr = FALSE + ) + expect_true(class(p[[1]]) == "SpatRaster") + rm(p) + + # glm + glm <- fit_glm( + data = spp_, + response = "pr_ab", + predictors = c("CFP_1", "CFP_2", "CFP_3", "CFP_4"), + predictors_f = "category", + partition = ".part", + thr = c("max_sens_spec") + ) + + p <- nm_predict( + models = glm, + pred = somevar, + thr = NULL, + con_thr = FALSE + ) + expect_true(class(p[[1]]) == "SpatRaster") + rm(p) + + # max + max <- fit_max( + data = spp_, + response = "pr_ab", + predictors = c("CFP_1", "CFP_2", "CFP_3", "CFP_4"), + predictors_f = "category", + partition = ".part", + thr = c("max_sens_spec") + ) + + p <- nm_predict( + models = max, + pred = somevar, + thr = NULL, + con_thr = FALSE, + clamp = TRUE, + pred_type = "cloglog" + ) + expect_true(class(p[[1]]) == "SpatRaster") + rm(p) + + # net + net <- fit_net( + data = spp_, + response = "pr_ab", + predictors = c("CFP_1", "CFP_2"), + predictors_f = "category", + partition = ".part", + thr = c("max_sens_spec"), + size = 1 + ) + + p <- nm_predict( + models = net, + pred = somevar, + thr = NULL, + con_thr = FALSE + ) + expect_true(class(p[[1]]) == "SpatRaster") + rm(p) + + # net with two factors + net2 <- fit_net( + data = spp_ %>% dplyr::mutate(category2 = category), + response = "pr_ab", + predictors = c("CFP_1", "CFP_2", "CFP_3", "CFP_4"), + predictors_f = c("category", "category2"), + partition = ".part", + thr = c("max_sens_spec"), + size = 1 + ) + + p <- nm_predict( + models = net2, + pred = somevar2, + thr = NULL, + con_thr = FALSE + ) + expect_true(class(p[[1]]) == "SpatRaster") + rm(p) + + # raf + raf <- fit_raf( + data = spp_, + response = "pr_ab", + predictors = c("CFP_1", "CFP_2", "CFP_3", "CFP_4"), + predictors_f = "category", + partition = ".part", + thr = c("max_sens_spec") + ) + + p <- nm_predict( + models = raf, + pred = somevar, + thr = NULL, + con_thr = FALSE + ) + expect_true(class(p[[1]]) == "SpatRaster") + rm(p) + + # raf with two factors + raf2 <- fit_raf( + data = spp_ %>% dplyr::mutate(category2 = category), + response = "pr_ab", + predictors = c("CFP_1", "CFP_2", "CFP_3", "CFP_4"), + predictors_f = c("category", "category2"), + partition = ".part", + thr = c("max_sens_spec") + ) + + p <- nm_predict( + models = raf2, + pred = somevar2, + thr = NULL, + con_thr = FALSE + ) + expect_true(class(p[[1]]) == "SpatRaster") + rm(p) + rm(somevar2) + + # svm + svm <- fit_svm( + data = spp_, + response = "pr_ab", + predictors = c("CFP_1", "CFP_2", "CFP_3", "CFP_4"), + predictors_f = "category", + partition = ".part", + thr = c("max_sens_spec") + ) + + p <- nm_predict( + models = svm, + pred = somevar, + thr = NULL, + con_thr = FALSE + ) + expect_true(class(p[[1]]) == "SpatRaster") + rm(p) + + # Predict list of individual models + p <- nm_predict( + models = list(svm, raf), + pred = somevar, + thr = NULL, + con_thr = FALSE + ) + expect_true(length(p) == 2) + expect_equal(names(p), c("svm", "raf")) + rm(p) + +}) + + + +test_that("test for ensemble, mask, and suit. values above threshold", { + # Environmental variables + somevar <- system.file("external/somevar.tif", package = "flexsdm") %>% terra::rast() + regions <- system.file("external/regions.tif", package = "flexsdm") %>% terra::rast() + # levels(regions) <- c(unique(regions)) + somevar <- terra::rast(x = list(regions, somevar)) + rm(regions) + + + # Species occurrences + data("spp") + set.seed(1) + spp_ <- spp %>% + dplyr::filter(species == "sp2") %>% + sdm_extract( + data = ., + x = "x", + y = "y", + env_layer = somevar, + variables = names(somevar), + filter_na = TRUE + ) %>% + part_random( + data = ., + pr_ab = "pr_ab", + method = c(method = "kfold", folds = 3) + ) + + ca <- calib_area(data = spp_, "x", "y", method = "mcp", crs=crs(somevar)) + + # gau + gau <- fit_gau( + data = spp_, + response = "pr_ab", + predictors = c("CFP_1", "CFP_2", "CFP_3", "CFP_4"), + predictors_f = "category", + partition = ".part" + ) + + # gbm + gbm <- fit_gbm( + data = spp_, + response = "pr_ab", + predictors = c("CFP_1", "CFP_2", "CFP_3", "CFP_4"), + predictors_f = "category", + partition = ".part" + ) + + # glm + glm <- fit_glm( + data = spp_, + response = "pr_ab", + predictors = c("CFP_1", "CFP_2", "CFP_3", "CFP_4"), + predictors_f = "category", + partition = ".part" + ) + + enm <- + fit_ensemble( + models = list(gau, gbm, glm), + ens_method = c("mean", "meanw", "meansup", "meanthr", "median"), + metric = "TSS", + thr_model = "equal_sens_spec" + ) + + # Test predict ensemble and with predict_area + p <- nm_predict( + models = enm, + pred = somevar, + thr = NULL, + con_thr = FALSE, + predict_area = ca + ) + + expect_true(class(p[[1]]) == "SpatRaster") + expect_true(length(p) == 5) + expect_false(terra::ext(p[[1]]) == ext(somevar)) + + # Test predict ensemble and with predict_area and con_thr = TRUE + p <- nm_predict( + models = enm, + pred = somevar, + thr = "max_sens_spec", + predict_area = ca, + con_thr = TRUE + ) + + expect_true(nrow(unique(p[[1]][[2]])) > 100) + expect_false(terra::ext(p[[1]]) == ext(somevar)) +}) + +test_that("test for all threshold", { + require(dplyr) + require(terra) + + # Environmental variables + somevar <- system.file("external/somevar.tif", package = "flexsdm") + somevar <- terra::rast(somevar) + + # Species occurrences + data("spp") + set.seed(1) + spp_ <- spp %>% + dplyr::filter(species == "sp2") %>% + sdm_extract( + data = ., + x = "x", + y = "y", + env_layer = somevar, + variables = names(somevar), + filter_na = TRUE + ) %>% + part_random( + data = ., + pr_ab = "pr_ab", + method = c(method = "kfold", folds = 3) + ) + + ca <- calib_area(data = spp_, "x", "y", method = "mcp", crs=crs(somevar)) + + gam <- fit_gam( + data = spp_, + response = "pr_ab", + predictors = c("CFP_1", "CFP_2", "CFP_3", "CFP_4"), + partition = ".part" + ) + + p <- nm_predict( + models = gam, + pred = somevar, + thr = "all", + predict_area = ca, + con_thr = TRUE + ) + + expect_equal(terra::nlyr(p[[1]]), 8) +}) + + +test_that("test for prdicting ensemble of small models", { + require(dplyr) + require(terra) + + # Environmental variables + somevar <- system.file("external/somevar.tif", package = "flexsdm") %>% terra::rast() + regions <- system.file("external/regions.tif", package = "flexsdm") %>% terra::rast() + somevar <- terra::rast(x = list(regions, somevar)) + rm(regions) + + # Species occurrences + data("spp") + set.seed(1) + spp_ <- spp %>% + dplyr::filter(species == "sp2") %>% + sdm_extract( + data = ., + x = "x", + y = "y", + env_layer = somevar, + variables = names(somevar), + filter_na = TRUE + ) %>% + part_random( + data = ., + pr_ab = "pr_ab", + method = c(method = "kfold", folds = 3) + ) + + ca <- calib_area(data = spp_, "x", "y", method = "mcp", crs=crs(somevar)) + + gam <- esm_gam( + data = spp_, + response = "pr_ab", + predictors = c("CFP_1", "CFP_2", "CFP_3", "CFP_4"), + partition = ".part", + k=3 + ) + + p <- nm_predict( + models = gam, + pred = somevar, + thr = NULL, + predict_area = ca, + con_thr = TRUE + ) + + expect_equal(terra::nlyr(p[[1]]), 1) })