variograms to each continuous raster and finding the effective range of
spatial autocorrelation. Variogram is a fundamental geostatistical tool
for measuring spatial autocorrelation (O’Sullivan and Unwin, 2010).
-
+## Min. 1st Qu. Median Mean 3rd Qu. Max.
+## 1015264 1352302 1637589 5337128 5622415 17058071
+## layers range
+## 3 bio_4 1015264
+## 2 bio_15 1464648
+## 4 bio_5 1810530
+## 1 bio_12 17058071
library(automap)
diff --git a/inst/doc/tutorial_2.html b/inst/doc/tutorial_2.html
index 10f4921..d74e576 100644
--- a/inst/doc/tutorial_2.html
+++ b/inst/doc/tutorial_2.html
@@ -12,7 +12,7 @@
-
+
2. Block cross-validation for species distribution modelling
@@ -342,7 +342,7 @@ 2. Block cross-validation for species
distribution modelling
Roozbeh Valavi, Jane Elith, José Lahoz-Monfort and
Gurutzeta Guillera-Arroita
-2025-06-23
+2025-08-15
diff --git a/man/cv_similarity.Rd b/man/cv_similarity.Rd
index 00e7b19..2b00e5a 100644
--- a/man/cv_similarity.Rd
+++ b/man/cv_similarity.Rd
@@ -9,6 +9,8 @@ cv_similarity(
x,
r,
num_plot = seq_along(cv$folds_list),
+ method = "MESS",
+ num_sample = 10000L,
jitter_width = 0.1,
points_size = 2,
points_alpha = 0.7,
@@ -28,6 +30,10 @@ is used to calculate similarity between the training and testing points.}
\item{num_plot}{a vector of indices of folds.}
+\item{method}{the similarity method including: MESS, L1 and L2. Read the details section.}
+
+\item{num_sample}{number of random samples from raster to calculate similarity distances (only for L1 and L2).}
+
\item{jitter_width}{numeric; the width of jitter points.}
\item{points_size}{numeric; the size of points.}
@@ -42,11 +48,35 @@ is used to calculate similarity between the training and testing points.}
a ggplot object
}
\description{
-This function computes multivariate environmental similarity surface (MESS) as described
-in Elith et al. (2010). MESS represents how similar a point in a testing fold is to a training
-fold (as a reference set of points), with respect to a set of predictor variables in \code{r}.
+This function evaluates environmental similarity between training and testing folds,
+helping to detect potential extrapolation in the testing data. It supports three
+similarity measures: Multivariate Environmental Similarity Surface (MESS), Manhattan
+distance (L1), and Euclidean distance (L2).
+}
+\details{
+The MESS is calculated as described in Elith et al. (2010). MESS represents
+how similar a point in a testing fold is to a training fold (as a reference
+set of points), with respect to a set of predictor variables in \code{r}.
The negative values are the sites where at least one variable has a value that is outside
the range of environments over the reference set, so these are novel environments.
+
+When using the L1 (Manhattan) or L2 (Euclidean) distance options (experimental), the
+function performs the following steps for each test sample:
+
+\itemize{
+\item{1. Calculates the minimum distance between each test sample and all training samples
+ in the same fold using the selected metric (L1 or L2).}
+\item{2. Calculates a baseline distance: the average of the minimum distances between a set
+ of random background samples (defined by \code{num_sample}) from the raster and all training/test
+ samples combined.}
+\item{3. Computes a similarity score by subtracting the test sample’s minimum distance from
+ the baseline average. A higher score indicates the test sample is more similar to
+ the training data, while lower or negative scores indicate novelty.}
+}
+
+This provides a simple, distance-based novelty metric, useful for assessing
+extrapolation or dissimilarity in prediction scenarios. Note that this approach is
+experimental.
}
\examples{
\donttest{
@@ -74,3 +104,9 @@ cv_similarity(cv = sb, r = covars, x = pa_data)
}
}
+\references{
+Elith, J., Kearney, M., & Phillips, S. (2010). The art of modelling range-shifting species: The art of modelling range-shifting species. Methods in Ecology and Evolution, 1(4), 330–342.
+}
+\seealso{
+\code{\link{cv_spatial}}, \code{\link{cv_cluster}}, \code{\link{cv_buffer}}, and \code{\link{cv_nndm}}
+}
diff --git a/src/Lightweight_matrix.h b/src/Lightweight_matrix.h
new file mode 100644
index 0000000..eda7103
--- /dev/null
+++ b/src/Lightweight_matrix.h
@@ -0,0 +1,80 @@
+#ifndef IGHTWEIGHT_MATRIX_H
+#define IGHTWEIGHT_MATRIX_H
+
+#include
+#include
+
+// A light weight matrix class for faster calculation with row-major opertaions
+template
+class Lightweight_matrix {
+private:
+ using MatrixType = std::vector;
+public:
+
+ explicit Lightweight_matrix(int rows, int columns):
+ rows_(rows), columns_(columns), matrix_(rows * columns) {}
+
+ template
+ explicit Lightweight_matrix(Matrix matrix):
+ rows_(matrix.nrow()), columns_(matrix.ncol()), matrix_(matrix.nrow() * matrix.ncol()) {
+ for(int i = 0; i < rows_; ++i) {
+ for(int j = 0; j < columns_; ++j) {
+ operator()(i, j) = static_cast(matrix(i, j));
+ }
+ }
+ }
+
+ T operator()(int i, int j) const {
+ return matrix_[i * columns_ + j];
+ }
+
+ T& operator()(int i, int j) {
+ return matrix_[i * columns_ + j];
+ }
+
+ int ncol() const {
+ return columns_;
+ }
+
+ int nrow() const {
+ return rows_;
+ }
+
+ T* data() {
+ return matrix_.data();
+ }
+
+ const T* data() const {
+ return matrix_.data();
+ }
+
+private:
+ int rows_;
+ int columns_;
+ MatrixType matrix_;
+};
+
+
+// rbind implementation for Lightweight_matrix
+template
+Lightweight_matrix rbind(const Lightweight_matrix& A, const Lightweight_matrix& B)
+{
+ const int ncol = A.ncol();
+ const int nrow_A = A.nrow();
+ const int nrow_B = B.nrow();
+
+ if (ncol != B.ncol())
+ {
+ throw std::invalid_argument("Matrices must have the same number of columns");
+ }
+
+ const int total_rows = nrow_A + nrow_B;
+ Lightweight_matrix result(total_rows, ncol);
+
+ std::copy(A.data(), A.data() + nrow_A * ncol, result.data());
+ std::copy(B.data(), B.data() + nrow_B * ncol, result.data() + nrow_A * ncol);
+
+ return result;
+}
+
+#endif /* IGHTWEIGHT_MATRIX_H */
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
index bc58e07..1efdc4b 100644
--- a/src/RcppExports.cpp
+++ b/src/RcppExports.cpp
@@ -24,9 +24,24 @@ BEGIN_RCPP
return rcpp_result_gen;
END_RCPP
}
+// similarity_cpp
+Rcpp::NumericVector similarity_cpp(const Rcpp::NumericMatrix& train_mat, const Rcpp::NumericMatrix& test_mat, const Rcpp::NumericMatrix& rand_mat, bool L1);
+RcppExport SEXP _blockCV_similarity_cpp(SEXP train_matSEXP, SEXP test_matSEXP, SEXP rand_matSEXP, SEXP L1SEXP) {
+BEGIN_RCPP
+ Rcpp::RObject rcpp_result_gen;
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< const Rcpp::NumericMatrix& >::type train_mat(train_matSEXP);
+ Rcpp::traits::input_parameter< const Rcpp::NumericMatrix& >::type test_mat(test_matSEXP);
+ Rcpp::traits::input_parameter< const Rcpp::NumericMatrix& >::type rand_mat(rand_matSEXP);
+ Rcpp::traits::input_parameter< bool >::type L1(L1SEXP);
+ rcpp_result_gen = Rcpp::wrap(similarity_cpp(train_mat, test_mat, rand_mat, L1));
+ return rcpp_result_gen;
+END_RCPP
+}
static const R_CallMethodDef CallEntries[] = {
{"_blockCV_nndm_cpp", (DL_FUNC) &_blockCV_nndm_cpp, 4},
+ {"_blockCV_similarity_cpp", (DL_FUNC) &_blockCV_similarity_cpp, 4},
{NULL, NULL, 0}
};
diff --git a/src/nndm.cpp b/src/nndm.cpp
index 618d92e..36f460b 100644
--- a/src/nndm.cpp
+++ b/src/nndm.cpp
@@ -1,49 +1,7 @@
#include
-
#include
#include
-
-template
-class Lightweight_matrix {
-private:
- using MatrixType = std::vector;
-public:
-
- explicit Lightweight_matrix(int rows, int columns):
- rows_(rows), columns_(columns), matrix_(rows * columns) {}
-
- template
- explicit Lightweight_matrix(Matrix matrix):
- rows_(matrix.nrow()), columns_(matrix.ncol()), matrix_(matrix.nrow() * matrix.ncol()) {
- for(int i(0); i < rows_; ++i) {
- for(int j(0); j < columns_; ++j) {
- operator()(i, j) = static_cast(matrix(i, j));
- }
- }
- }
-
- T operator()(int i, int j) const {
- return matrix_[i * columns_ + j];
- }
-
- T& operator()(int i, int j) {
- return matrix_[i * columns_ + j];
- }
-
- int ncol() const {
- return columns_;
- }
-
- int nrow() const {
- return rows_;
- }
-
-private:
- int rows_;
- int columns_;
- MatrixType matrix_;
-};
-
+#include "Lightweight_matrix.h"
// [[Rcpp::export]]
Rcpp::NumericMatrix nndm_cpp(Rcpp::NumericMatrix X,
@@ -51,111 +9,122 @@ Rcpp::NumericMatrix nndm_cpp(Rcpp::NumericMatrix X,
double phi,
double min_train){
- // Value representing NAs (NA_REAL does not work well with custom structures)
- const double na_value(-1.);
-
- // C++ representation of Gij
- const std::vector Gij_vec(Rcpp::as >(Gij));
-
- // C++ representation of X
- Lightweight_matrix X_cpp(X);
- for(int i=0; i Gjstar_indices(X.ncol());
- double rmin = std::numeric_limits::infinity();
- int imin = 0;
- for(int i=0; i::infinity();
- for(int j=0; j Gij_vec(Rcpp::as >(Gij));
- // Number of entries of Gjstar that are less than rmin
- int Gjstar_less_than_rmin(0);
- for(std::size_t i = 0; i < Gjstar_indices.size(); i++){
- if(X_cpp(i, Gjstar_indices[i]) <= rmin){
- ++Gjstar_less_than_rmin;
- }
+ // C++ representation of X
+ Lightweight_matrix X_cpp(X);
+ for (int i=0; i(Gij_less_than_rmin) / static_cast(Gij_vec.size());
- const double tcdf = static_cast(Gjstar_less_than_rmin - 1) / static_cast(Gjstar_indices.size());
-
- // Number of non-NA values in X[imin, ]
- int X_non_na(0);
- for(int j=0; j Gjstar_indices(X.ncol());
+ double rmin = std::numeric_limits::infinity();
+ int imin = 0;
+ for (int i=0; i::infinity();
+ for (int j=0; j(X_non_na) / static_cast(X_cpp.ncol()) > min_train;
-
- // Will end up containing the updated rmin value
- double new_rmin = std::numeric_limits::infinity();
-
- if( (tcdf >= pcdf) && in_prop ) {
- // Signal that the current element is NA
- X_cpp(imin, Gjstar_indices[imin]) = na_value;
-
- double running_minimum = std::numeric_limits::infinity();
- for(int j=0; j= rmin && X_cpp(i, Gjstar_indices[i]) < new_rmin) {
- new_rmin = X_cpp(i, Gjstar_indices[i]);
- imin = i;
+ // Number of entries of Gij that are less than rmin
+ int Gij_less_than_rmin(0);
+ for (std::size_t i = 0; i < Gij_vec.size(); i++)
+ {
+ if(Gij_vec[i] <= rmin){
+ ++Gij_less_than_rmin;
+ }
}
- }
- } else if( static_cast(Gjstar_indices.size()) == Gjstar_less_than_rmin ){
- break;
- } else {
- for(std::size_t i = 0; i rmin && X_cpp(i, Gjstar_indices[i]) < new_rmin) {
- new_rmin = X_cpp(i, Gjstar_indices[i]);
- imin = i;
+ const double pcdf = static_cast(Gij_less_than_rmin) / static_cast(Gij_vec.size());
+ const double tcdf = static_cast(Gjstar_less_than_rmin - 1) / static_cast(Gjstar_indices.size());
+
+ // Number of non-NA values in X[imin, ]
+ int X_non_na(0);
+ for (int j=0; j(X_non_na) / static_cast(X_cpp.ncol()) > min_train;
+
+ // Will end up containing the updated rmin value
+ double new_rmin = std::numeric_limits::infinity();
+
+ if ((tcdf >= pcdf) && in_prop ) {
+ // Signal that the current element is NA
+ X_cpp(imin, Gjstar_indices[imin]) = na_value;
+
+ double running_minimum = std::numeric_limits::infinity();
+ for (int j=0; j= rmin && X_cpp(i, Gjstar_indices[i]) < new_rmin) {
+ new_rmin = X_cpp(i, Gjstar_indices[i]);
+ imin = i;
+ }
+ }
+ } else if( static_cast(Gjstar_indices.size()) == Gjstar_less_than_rmin ){
+ break;
+ } else {
+ for (std::size_t i=0; i rmin && X_cpp(i, Gjstar_indices[i]) < new_rmin) {
+ new_rmin = X_cpp(i, Gjstar_indices[i]);
+ imin = i;
+ }
+ }
+ }
- // Update X before returning, since we were working on C++ object
- for(int i=0; i
+#include
+#include
+#include
+#include "Lightweight_matrix.h"
+
+
+// a function to calculate L1 or L2 distances
+inline double distance(Lightweight_matrix &x, Lightweight_matrix &y, int i, int ii, bool L1)
+{
+ int nc = x.ncol();
+ double dist = 0.0;
+
+ if (L1)
+ {
+ // could be faster by avoiding () operator and accessing data directly, and
+ // vectorised operations but potentially won't be necessary here..
+ for (int j = 0; j < nc; j++)
+ {
+ dist += std::abs(x(i, j) - y(ii, j)); // Manhattan distance
+ }
+ }
+ else
+ {
+ for (int j = 0; j < nc; j++)
+ {
+ double diff = x(i, j) - y(ii, j);
+ dist += diff * diff;
+ }
+ dist = std::sqrt(dist); // Euclidean distance
+ }
+
+ return dist;
+}
+
+
+// [[Rcpp::export]]
+Rcpp::NumericVector similarity_cpp(
+ const Rcpp::NumericMatrix &train_mat,
+ const Rcpp::NumericMatrix &test_mat,
+ const Rcpp::NumericMatrix &rand_mat,
+ bool L1 = true
+) {
+
+ Lightweight_matrix train(train_mat);
+ Lightweight_matrix test(test_mat);
+ Lightweight_matrix rand(rand_mat);
+ // rbind train and test matrices for baseline calc
+ Lightweight_matrix full_mat = rbind(train, test);
+
+ // check for possible errors.
+ if (train.ncol() != test.ncol()) Rcpp::stop("Number of columns in train and test are different!");
+ if (train.ncol() != rand.ncol()) Rcpp::stop("Number of columns in train and raster layers are different!");
+
+ int nr_test = test.nrow();
+ int nr_train = train.nrow();
+ int nr_rand = rand.nrow();
+
+ // output vector
+ std::vector output(nr_test, 0.0);
+
+ // loop over the random samples
+ double sum_dist = 0.0;
+ for (int i = 0; i < nr_rand; i++)
+ {
+ double min_dist(std::numeric_limits::infinity());
+ // loop over the training samples
+ for (int row = 0; row < full_mat.nrow(); row++)
+ {
+ // calcualte L1/L2 distance
+ double dist_rand = distance(full_mat, rand, row, i, L1);
+ // get the min distance
+ if (dist_rand < min_dist)
+ {
+ min_dist = dist_rand;
+ }
+ }
+ sum_dist += min_dist;
+ }
+ // average min distance of a random sample to training samples
+ const double base_dist = sum_dist / static_cast(nr_rand);
+
+ // loop over the test samples
+ for (int i = 0; i < nr_test; i++)
+ {
+ double min_test(std::numeric_limits::infinity());
+ // loop over the training samples to get the min distance
+ for (int row = 0; row < nr_train; row++)
+ {
+ // calcualte L1/L2 distance
+ double dist = distance(train, test, row, i, L1);
+ // get the min distance
+ if (dist < min_test)
+ {
+ min_test = dist;
+ }
+ }
+ // expected distance - test distance
+ double test_dist = base_dist - min_test;
+
+ output[i] = test_dist;
+ }
+
+ return Rcpp::wrap(output);
+}
+
diff --git a/tests/testthat/test-cv_buffer.R b/tests/testthat/test-cv_buffer.R
index bd9a53f..e412099 100644
--- a/tests/testthat/test-cv_buffer.R
+++ b/tests/testthat/test-cv_buffer.R
@@ -9,120 +9,120 @@ expect_names <- c(
pa_data <- read.csv(system.file("extdata/", "species.csv", package = "blockCV")) |>
- sf::st_as_sf(coords = c("x", "y"), crs = 7845)
+ sf::st_as_sf(coords = c("x", "y"), crs = 7845)
pa_data <- pa_data[1:200, ]
test_that("test that cv_buffer function works properly with presence-absence data",
{
- bloo <- cv_buffer(
- x = pa_data,
- column = "occ",
- size = 250000,
- presence_bg = FALSE,
- progress = TRUE
- )
-
- expect_true(exists("bloo"))
- expect_s3_class(bloo, "cv_buffer")
- expect_equal(names(bloo), expect_names)
- expect_equal(length(bloo$folds), nrow(pa_data))
- expect_type(bloo$folds, "list")
- expect_type(bloo$k, "integer")
- expect_type(bloo$column, "character")
- expect_type(bloo$size, "double")
- expect_equal(bloo$presence_bg, FALSE)
- expect_equal(dim(bloo$records), c(nrow(pa_data), 4))
- expect_true(!all(bloo$records == 0))
-
-})
+ bloo <- cv_buffer(
+ x = pa_data,
+ column = "occ",
+ size = 250000,
+ presence_bg = FALSE,
+ progress = TRUE
+ )
+
+ expect_true(exists("bloo"))
+ expect_s3_class(bloo, "cv_buffer")
+ expect_equal(names(bloo), expect_names)
+ expect_equal(length(bloo$folds), nrow(pa_data))
+ expect_type(bloo$folds, "list")
+ expect_type(bloo$k, "integer")
+ expect_type(bloo$column, "character")
+ expect_type(bloo$size, "double")
+ expect_equal(bloo$presence_bg, FALSE)
+ expect_equal(dim(bloo$records), c(nrow(pa_data), 4))
+ expect_true(!all(bloo$records == 0))
+
+ })
test_that("test that cv_buffer function works properly with presence-background data",
{
- bloo <- cv_buffer(
- x = pa_data,
- column = "occ",
- size = 250000,
- presence_bg = TRUE,
- progress = FALSE
- )
-
- expect_true(exists("bloo"))
- expect_s3_class(bloo, "cv_buffer")
- expect_equal(names(bloo), expect_names)
- expect_equal(length(bloo$folds), sum(pa_data$occ))
- expect_type(bloo$folds, "list")
- expect_type(bloo$k, "integer")
- expect_type(bloo$column, "character")
- expect_type(bloo$size, "double")
- expect_equal(bloo$presence_bg, TRUE)
- expect_equal(dim(bloo$records), c(sum(pa_data$occ), 4))
- expect_true(!all(bloo$records == 0))
-
-})
+ bloo <- cv_buffer(
+ x = pa_data,
+ column = "occ",
+ size = 250000,
+ presence_bg = TRUE,
+ progress = FALSE
+ )
+
+ expect_true(exists("bloo"))
+ expect_s3_class(bloo, "cv_buffer")
+ expect_equal(names(bloo), expect_names)
+ expect_equal(length(bloo$folds), sum(pa_data$occ))
+ expect_type(bloo$folds, "list")
+ expect_type(bloo$k, "integer")
+ expect_type(bloo$column, "character")
+ expect_type(bloo$size, "double")
+ expect_equal(bloo$presence_bg, TRUE)
+ expect_equal(dim(bloo$records), c(sum(pa_data$occ), 4))
+ expect_true(!all(bloo$records == 0))
+
+ })
test_that("test that cv_buffer function works properly with no species specified",
{
- bloo <- cv_buffer(
- x = pa_data,
- size = 250000
- )
-
- expect_true(exists("bloo"))
- expect_s3_class(bloo, "cv_buffer")
- expect_equal(names(bloo), expect_names)
- expect_equal(length(bloo$folds), nrow(pa_data))
- expect_type(bloo$folds, "list")
- expect_type(bloo$k, "integer")
- expect_null(bloo$species)
- expect_type(bloo$size, "double")
- expect_equal(bloo$presence_bg, FALSE)
- expect_equal(dim(bloo$records), c(nrow(pa_data), 2))
- expect_true(!all(bloo$records == 0))
-
- expect_equal(print(bloo), "cv_buffer")
- expect_output(summary(bloo))
+ bloo <- cv_buffer(
+ x = pa_data,
+ size = 250000
+ )
-})
+ expect_true(exists("bloo"))
+ expect_s3_class(bloo, "cv_buffer")
+ expect_equal(names(bloo), expect_names)
+ expect_equal(length(bloo$folds), nrow(pa_data))
+ expect_type(bloo$folds, "list")
+ expect_type(bloo$k, "integer")
+ expect_null(bloo$species)
+ expect_type(bloo$size, "double")
+ expect_equal(bloo$presence_bg, FALSE)
+ expect_equal(dim(bloo$records), c(nrow(pa_data), 2))
+ expect_true(!all(bloo$records == 0))
+
+ expect_equal(print(bloo), "cv_buffer")
+ expect_output(summary(bloo))
+
+ })
test_that("test cv_buffer function with no matching species column", {
- expect_warning(
- bloo <- cv_buffer(
- x = pa_data,
- column = "response",
- size = 250000,
- presence_bg = FALSE,
- progress = TRUE
+ expect_warning(
+ bloo <- cv_buffer(
+ x = pa_data,
+ column = "response",
+ size = 250000,
+ presence_bg = FALSE,
+ progress = TRUE
+ )
)
- )
- expect_true(exists("bloo"))
- expect_equal(dim(bloo$records), c(nrow(pa_data), 2))
- expect_true(!all(bloo$records == 0))
+ expect_true(exists("bloo"))
+ expect_equal(dim(bloo$records), c(nrow(pa_data), 2))
+ expect_true(!all(bloo$records == 0))
})
test_that("test cv_buffer function with no spatial column data", {
- expect_error(
- cv_buffer(
- x = "pa_data",
- size = 250000
+ expect_error(
+ cv_buffer(
+ x = "pa_data",
+ size = 250000
+ )
)
- )
})
test_that("test cv_buffer function to have sptial points with no CRS", {
- sf::st_crs(pa_data) <- NA
-
- expect_error(
- cv_buffer(
- x = pa_data,
- column = "occ",
- size = 250000
+ sf::st_crs(pa_data) <- NA
+
+ expect_error(
+ cv_buffer(
+ x = pa_data,
+ column = "occ",
+ size = 250000
+ )
)
- )
})
diff --git a/tests/testthat/test-cv_cluster.R b/tests/testthat/test-cv_cluster.R
index 99091af..f969dce 100644
--- a/tests/testthat/test-cv_cluster.R
+++ b/tests/testthat/test-cv_cluster.R
@@ -1,119 +1,109 @@
-expect_names <- c(
- "folds_list",
- "folds_ids",
- "biomod_table",
- "k",
- "column",
- "type",
- "records"
-)
+expect_names <- c("folds_list",
+ "folds_ids",
+ "biomod_table",
+ "k",
+ "column",
+ "type",
+ "records")
aus <- system.file("extdata/au/", package = "blockCV") |>
- list.files(full.names = TRUE) |>
- terra::rast()
+ list.files(full.names = TRUE) |>
+ terra::rast()
pa_data <- read.csv(system.file("extdata/", "species.csv", package = "blockCV")) |>
- sf::st_as_sf(coords = c("x", "y"), crs = 7845)
+ sf::st_as_sf(coords = c("x", "y"), crs = 7845)
test_that("test that environmental cluster function with raster_cluster", {
-
- # environmental clustering
- set.seed(42)
- eb <- cv_cluster(x = pa_data,
- column = "occ",
- r = aus,
- k = 3,
- scale = TRUE,
- raster_cluster = TRUE)
-
- expect_true(exists("eb"))
- expect_s3_class(eb, "cv_cluster")
- expect_equal(names(eb), expect_names)
- expect_equal(length(eb$folds_list), 3)
- expect_type(eb$folds_list, "list")
- expect_equal(eb$k, 3)
- expect_type(eb$column, "character")
- expect_equal(dim(eb$records), c(3, 4))
- expect_true(
- !all(eb$records == 0)
- )
+ # environmental clustering
+ set.seed(42)
+ eb <- cv_cluster(
+ x = pa_data,
+ column = "occ",
+ r = aus,
+ k = 3,
+ scale = TRUE,
+ raster_cluster = TRUE
+ )
+
+ expect_true(exists("eb"))
+ expect_s3_class(eb, "cv_cluster")
+ expect_equal(names(eb), expect_names)
+ expect_equal(length(eb$folds_list), 3)
+ expect_type(eb$folds_list, "list")
+ expect_equal(eb$k, 3)
+ expect_type(eb$column, "character")
+ expect_equal(dim(eb$records), c(3, 4))
+ expect_true(!all(eb$records == 0))
})
test_that("test that spacial cluster function with no column", {
-
- # spatial clustering
- set.seed(42)
- eb <- cv_cluster(x = pa_data,
- k = 5,
- biomod2 = FALSE)
-
- expect_true(exists("eb"))
- expect_s3_class(eb, "cv_cluster")
- expect_equal(names(eb), expect_names)
- expect_equal(length(eb$folds_list), 5)
- expect_type(eb$folds_list, "list")
- expect_equal(eb$k, 5)
- expect_null(eb$column)
- expect_equal(dim(eb$records), c(5, 2))
- expect_true(
- !all(eb$records == 0)
- )
-
- expect_equal(print(eb), "cv_cluster")
- expect_output(summary(eb))
+ # spatial clustering
+ set.seed(42)
+ eb <- cv_cluster(x = pa_data, k = 5, biomod2 = FALSE)
+
+ expect_true(exists("eb"))
+ expect_s3_class(eb, "cv_cluster")
+ expect_equal(names(eb), expect_names)
+ expect_equal(length(eb$folds_list), 5)
+ expect_type(eb$folds_list, "list")
+ expect_equal(eb$k, 5)
+ expect_null(eb$column)
+ expect_equal(dim(eb$records), c(5, 2))
+ expect_true(!all(eb$records == 0))
+
+ expect_equal(print(eb), "cv_cluster")
+ expect_output(summary(eb))
})
test_that("test that environmental cluster with no scale and wrong column", {
-
- set.seed(42)
- expect_warning(
- eb <- cv_cluster(x = pa_data,
- column = "response", # wrong column name
- r = aus,
- k = 5,
- scale = FALSE,
- raster_cluster = TRUE,
- algorithm = "MacQueen")
- )
-
- expect_true(exists("eb"))
- expect_s3_class(eb, "cv_cluster")
- expect_equal(names(eb), expect_names)
- expect_equal(length(eb$folds_list), 5)
- expect_type(eb$folds_list, "list")
- expect_equal(eb$k, 5)
- expect_equal(dim(eb$records), c(5, 2))
- expect_true(
- !all(eb$records == 0)
- )
+ set.seed(42)
+ expect_warning(
+ eb <- cv_cluster(
+ x = pa_data,
+ column = "response",
+ # wrong column name
+ r = aus,
+ k = 5,
+ scale = FALSE,
+ raster_cluster = TRUE,
+ algorithm = "MacQueen"
+ )
+ )
+
+ expect_true(exists("eb"))
+ expect_s3_class(eb, "cv_cluster")
+ expect_equal(names(eb), expect_names)
+ expect_equal(length(eb$folds_list), 5)
+ expect_type(eb$folds_list, "list")
+ expect_equal(eb$k, 5)
+ expect_equal(dim(eb$records), c(5, 2))
+ expect_true(!all(eb$records == 0))
})
test_that("test environmental cluster with no spatial or sf object", {
-
- expect_error(
- cv_cluster(x = aus, # no spatial or sf object
- r = aus,
- k = 5,
- scale = TRUE,
- raster_cluster = FALSE)
-
- )
+ expect_error(cv_cluster(
+ x = aus,
+ # no spatial or sf object
+ r = aus,
+ k = 5,
+ scale = TRUE,
+ raster_cluster = FALSE
+ ))
})
test_that("test environmental cluster with no raster data", {
- expect_error(
- cv_cluster(r = data.frame(x = 1), # no raster data
- x = pa_data)
-
- )
+ expect_error(cv_cluster(
+ r = data.frame(x = 1),
+ # no raster data
+ x = pa_data
+ ))
})
-
diff --git a/tests/testthat/test-cv_nndm.R b/tests/testthat/test-cv_nndm.R
index 35d9058..dd33f57 100644
--- a/tests/testthat/test-cv_nndm.R
+++ b/tests/testthat/test-cv_nndm.R
@@ -10,131 +10,131 @@ expect_names <- c(
aus <- system.file("extdata/au/", package = "blockCV") |>
- list.files(full.names = TRUE) |>
- terra::rast()
+ list.files(full.names = TRUE) |>
+ terra::rast()
pa_data <- read.csv(system.file("extdata/", "species.csv", package = "blockCV")) |>
- sf::st_as_sf(coords = c("x", "y"), crs = 7845)
+ sf::st_as_sf(coords = c("x", "y"), crs = 7845)
pa_data <- pa_data[1:100, ]
test_that("test that cv_nndm function works properly with presence-absence data",
{
- bloo <- cv_nndm(
- x = pa_data,
- column = "occ",
- r = aus,
- size = 250000,
- num_sample = 3000,
- presence_bg = FALSE
- )
-
- expect_true(exists("bloo"))
- expect_s3_class(bloo, "cv_nndm")
- expect_equal(names(bloo), expect_names)
- expect_equal(length(bloo$folds), nrow(pa_data))
- expect_type(bloo$folds, "list")
- expect_type(bloo$k, "integer")
- expect_type(bloo$column, "character")
- expect_type(bloo$size, "double")
- expect_equal(bloo$presence_bg, FALSE)
- expect_equal(dim(bloo$records), c(nrow(pa_data), 4))
- expect_true(!all(bloo$records == 0))
+ bloo <- cv_nndm(
+ x = pa_data,
+ column = "occ",
+ r = aus,
+ size = 250000,
+ num_sample = 3000,
+ presence_bg = FALSE
+ )
+
+ expect_true(exists("bloo"))
+ expect_s3_class(bloo, "cv_nndm")
+ expect_equal(names(bloo), expect_names)
+ expect_equal(length(bloo$folds), nrow(pa_data))
+ expect_type(bloo$folds, "list")
+ expect_type(bloo$k, "integer")
+ expect_type(bloo$column, "character")
+ expect_type(bloo$size, "double")
+ expect_equal(bloo$presence_bg, FALSE)
+ expect_equal(dim(bloo$records), c(nrow(pa_data), 4))
+ expect_true(!all(bloo$records == 0))
})
test_that("test that cv_nndm function works properly with presence-background data",
{
- bloo <- cv_nndm(
- x = pa_data,
- column = "occ",
- r = aus,
- size = 250000,
- sampling = "regular",
- presence_bg = TRUE
- )
-
- expect_true(exists("bloo"))
- expect_s3_class(bloo, "cv_nndm")
- expect_equal(names(bloo), expect_names)
- expect_equal(length(bloo$folds), sum(pa_data$occ))
- expect_type(bloo$folds, "list")
- expect_type(bloo$k, "integer")
- expect_type(bloo$column, "character")
- expect_type(bloo$size, "double")
- expect_equal(bloo$presence_bg, TRUE)
- expect_equal(dim(bloo$records), c(sum(pa_data$occ), 4))
- expect_true(!all(bloo$records == 0))
+ bloo <- cv_nndm(
+ x = pa_data,
+ column = "occ",
+ r = aus,
+ size = 250000,
+ sampling = "regular",
+ presence_bg = TRUE
+ )
+
+ expect_true(exists("bloo"))
+ expect_s3_class(bloo, "cv_nndm")
+ expect_equal(names(bloo), expect_names)
+ expect_equal(length(bloo$folds), sum(pa_data$occ))
+ expect_type(bloo$folds, "list")
+ expect_type(bloo$k, "integer")
+ expect_type(bloo$column, "character")
+ expect_type(bloo$size, "double")
+ expect_equal(bloo$presence_bg, TRUE)
+ expect_equal(dim(bloo$records), c(sum(pa_data$occ), 4))
+ expect_true(!all(bloo$records == 0))
})
test_that("test that cv_nndm function works properly with no species specified",
{
- bloo <- cv_nndm(
- x = sf::as_Spatial(pa_data),
- r = aus,
- size = 250000,
- num_sample = 3000,
- plot = FALSE
- )
-
- expect_true(exists("bloo"))
- expect_s3_class(bloo, "cv_nndm")
- expect_equal(names(bloo), expect_names)
- expect_equal(length(bloo$folds), nrow(pa_data))
- expect_type(bloo$folds, "list")
- expect_type(bloo$k, "integer")
- expect_null(bloo$species)
- expect_type(bloo$size, "double")
- expect_equal(bloo$presence_bg, FALSE)
- expect_equal(dim(bloo$records), c(nrow(pa_data), 2))
- expect_true(!all(bloo$records == 0))
-
- expect_equal(print(bloo), "cv_nndm")
- expect_output(summary(bloo))
+ bloo <- cv_nndm(
+ x = sf::as_Spatial(pa_data),
+ r = aus,
+ size = 250000,
+ num_sample = 3000,
+ plot = FALSE
+ )
+
+ expect_true(exists("bloo"))
+ expect_s3_class(bloo, "cv_nndm")
+ expect_equal(names(bloo), expect_names)
+ expect_equal(length(bloo$folds), nrow(pa_data))
+ expect_type(bloo$folds, "list")
+ expect_type(bloo$k, "integer")
+ expect_null(bloo$species)
+ expect_type(bloo$size, "double")
+ expect_equal(bloo$presence_bg, FALSE)
+ expect_equal(dim(bloo$records), c(nrow(pa_data), 2))
+ expect_true(!all(bloo$records == 0))
+
+ expect_equal(print(bloo), "cv_nndm")
+ expect_output(summary(bloo))
})
test_that("test cv_nndm function with no matching species column", {
- expect_warning(
- bloo <- cv_nndm(
- x = pa_data,
- column = "response",
- r = aus,
- size = 250000,
- num_sample = 3000,
- presence_bg = FALSE
+ expect_warning(
+ bloo <- cv_nndm(
+ x = pa_data,
+ column = "response",
+ r = aus,
+ size = 250000,
+ num_sample = 3000,
+ presence_bg = FALSE
+ )
)
- )
- expect_true(exists("bloo"))
- expect_equal(dim(bloo$records), c(nrow(pa_data), 2))
- expect_true(!all(bloo$records == 0))
+ expect_true(exists("bloo"))
+ expect_equal(dim(bloo$records), c(nrow(pa_data), 2))
+ expect_true(!all(bloo$records == 0))
})
test_that("test cv_nndm function with no spatial column data", {
- expect_error(
- cv_nndm(
- x = "pa_data",
- r = aus,
- size = 250000
+ expect_error(
+ cv_nndm(
+ x = "pa_data",
+ r = aus,
+ size = 250000
+ )
)
- )
})
test_that("test cv_nndm function to have sptial points with no CRS", {
- sf::st_crs(pa_data) <- NA
-
- expect_error(
- cv_nndm(
- x = pa_data,
- column = "occ",
- r = aus,
- size = 250000
+ sf::st_crs(pa_data) <- NA
+
+ expect_error(
+ cv_nndm(
+ x = pa_data,
+ column = "occ",
+ r = aus,
+ size = 250000
+ )
)
- )
})
diff --git a/tests/testthat/test-cv_plot.R b/tests/testthat/test-cv_plot.R
index addcf45..e2c300d 100644
--- a/tests/testthat/test-cv_plot.R
+++ b/tests/testthat/test-cv_plot.R
@@ -1,21 +1,22 @@
pa_data <- read.csv(system.file("extdata/", "species.csv", package = "blockCV")) |>
- sf::st_as_sf(coords = c("x", "y"), crs = 7845)
+ sf::st_as_sf(coords = c("x", "y"), crs = 7845)
-test_that("test that cv_plot function works",
- {
- scv <- cv_spatial(x = pa_data,
- size = 450000,
- k = 5,
- selection = "random",
- iteration = 1,
- biomod2 = FALSE,
- plot = FALSE,
- progress = FALSE)
+test_that("test that cv_plot function works", {
+ scv <- cv_spatial(
+ x = pa_data,
+ size = 450000,
+ k = 5,
+ selection = "random",
+ iteration = 1,
+ biomod2 = FALSE,
+ plot = FALSE,
+ progress = FALSE
+ )
- plt <- cv_plot(cv = scv, x = pa_data)
+ plt <- cv_plot(cv = scv, x = pa_data)
- expect_true(exists("plt"))
- expect_true(ggplot2::is_ggplot(plt))
+ expect_true(exists("plt"))
+ expect_true(ggplot2::is_ggplot(plt))
})
diff --git a/tests/testthat/test-cv_similarity.R b/tests/testthat/test-cv_similarity.R
index a634fac..4fdf3d5 100644
--- a/tests/testthat/test-cv_similarity.R
+++ b/tests/testthat/test-cv_similarity.R
@@ -1,39 +1,62 @@
aus <- system.file("extdata/au/", package = "blockCV") |>
- list.files(full.names = TRUE) |>
- terra::rast()
+ list.files(full.names = TRUE) |>
+ terra::rast()
pa_data <- read.csv(system.file("extdata/", "species.csv", package = "blockCV")) |>
- sf::st_as_sf(coords = c("x", "y"), crs = 7845)
+ sf::st_as_sf(coords = c("x", "y"), crs = 7845)
pa_data <- pa_data[1:200, ]
-test_that("test that cv_similarity function works with cv_spatil",
- {
- scv <- cv_spatial(x = pa_data,
- selection = "random",
- iteration = 1,
- biomod2 = FALSE,
- plot = FALSE,
- report = FALSE,
- progress = FALSE)
+scv <- cv_spatial(
+ x = pa_data,
+ selection = "random",
+ iteration = 1,
+ biomod2 = FALSE,
+ plot = FALSE,
+ report = FALSE,
+ progress = FALSE
+)
- plt <- cv_similarity(cv = scv, x = pa_data, r = aus)
- expect_true(exists("plt"))
- expect_true(ggplot2::is_ggplot(plt))
+test_that("test that cv_similarity function works with cv_spatil and MESS", {
+
+ plt <- cv_similarity(cv = scv, x = pa_data, r = aus, method = "MESS")
+
+ expect_true(exists("plt"))
+ expect_true(ggplot2::is_ggplot(plt))
})
+test_that("test that cv_similarity function works with cv_spatil and L1", {
-test_that("test that cv_similarity function works with cv_buffer",
- {
- bloo <- cv_buffer(x = pa_data,
- size = 250000,
- progress = FALSE,
- report = FALSE)
+ plt <- cv_similarity(cv = scv, x = pa_data, r = aus, method = "L1")
- plt <- cv_similarity(cv = bloo, x = pa_data, r = aus)
+ expect_true(exists("plt"))
+ expect_true(ggplot2::is_ggplot(plt))
+
+})
- expect_true(exists("plt"))
- expect_true(ggplot2::is_ggplot(plt))
+test_that("test that cv_similarity function works with cv_spatil and L2", {
+
+ plt <- cv_similarity(cv = scv, x = pa_data, r = aus, , method = "L2")
+
+ expect_true(exists("plt"))
+ expect_true(ggplot2::is_ggplot(plt))
})
+
+
+test_that("test that cv_similarity function works with cv_buffer", {
+ bloo <- cv_buffer(
+ x = pa_data,
+ size = 250000,
+ progress = FALSE,
+ report = FALSE
+ )
+
+ plt <- cv_similarity(cv = bloo, x = pa_data, r = aus)
+
+ expect_true(exists("plt"))
+ expect_true(ggplot2::is_ggplot(plt))
+
+})
+
diff --git a/tests/testthat/test-cv_spatial.R b/tests/testthat/test-cv_spatial.R
index a0f314f..d55a27a 100644
--- a/tests/testthat/test-cv_spatial.R
+++ b/tests/testthat/test-cv_spatial.R
@@ -8,226 +8,245 @@ expect_names <- c("folds_list",
"records")
aus <- system.file("extdata/au/", package = "blockCV") |>
- list.files(full.names = TRUE) |>
- terra::rast()
+ list.files(full.names = TRUE) |>
+ terra::rast()
pa_data <- read.csv(system.file("extdata/", "species.csv", package = "blockCV")) |>
- sf::st_as_sf(coords = c("x", "y"), crs = 7845)
+ sf::st_as_sf(coords = c("x", "y"), crs = 7845)
pa_data <- pa_data[1:200, ]
test_that("test cv_spatial function with random assingment and raster file", {
- set.seed(1000)
- scv <- cv_spatial(x = pa_data,
- column = "occ",
- r = aus,
- size = 450000,
- k = 5,
- selection = "random",
- iteration = 5,
- biomod2 = TRUE,
- offset = c(0.3, 0.2),
- plot = FALSE,
- progress = TRUE)
-
- expect_true(exists("scv"))
- expect_s3_class(scv, "cv_spatial")
- expect_equal(names(scv), expect_names)
- expect_equal(length(scv$folds_list), 5)
- expect_type(scv$folds_list, "list")
- expect_type(scv$biomod_table, "logical")
- expect_equal(dim(scv$biomod_table), c(nrow(pa_data), 5))
- expect_equal(scv$k, 5)
- expect_s3_class(scv$blocks, "sf")
- expect_type(scv$column, "character")
- expect_type(scv$size, "double")
- expect_equal(dim(scv$records), c(5, 4))
- expect_true(
- !all(scv$records == 0)
- )
+ set.seed(1000)
+ scv <- cv_spatial(
+ x = pa_data,
+ column = "occ",
+ r = aus,
+ size = 450000,
+ k = 5,
+ selection = "random",
+ iteration = 5,
+ biomod2 = TRUE,
+ offset = c(0.3, 0.2),
+ plot = FALSE,
+ progress = TRUE
+ )
+
+ expect_true(exists("scv"))
+ expect_s3_class(scv, "cv_spatial")
+ expect_equal(names(scv), expect_names)
+ expect_equal(length(scv$folds_list), 5)
+ expect_type(scv$folds_list, "list")
+ expect_type(scv$biomod_table, "logical")
+ expect_equal(dim(scv$biomod_table), c(nrow(pa_data), 5))
+ expect_equal(scv$k, 5)
+ expect_s3_class(scv$blocks, "sf")
+ expect_type(scv$column, "character")
+ expect_type(scv$size, "double")
+ expect_equal(dim(scv$records), c(5, 4))
+ expect_true(
+ !all(scv$records == 0)
+ )
})
test_that("test cv_spatial function with systematic assingment and no raster file", {
- scv <- cv_spatial(x = sf::as_Spatial(pa_data),
- rows_cols = c(10, 10),
- k = 5,
- selection = "systematic",
- biomod2 = FALSE,
- plot = TRUE)
-
- expect_true(exists("scv"))
- expect_s3_class(scv, "cv_spatial")
- expect_equal(names(scv), expect_names)
- expect_equal(length(scv$folds_list), 5)
- expect_type(scv$folds_list, "list")
- expect_null(scv$biomod_table, "matrix")
- expect_equal(scv$k, 5)
- expect_s3_class(scv$blocks, "sf")
- expect_null(scv$column)
- expect_null(scv$size)
- expect_equal(dim(scv$records), c(5, 2))
- expect_true(
- !all(scv$records == 0)
- )
-
- expect_equal(print(scv), "cv_spatial")
- expect_message(plot(scv))
- expect_output(summary(scv))
+ scv <- cv_spatial(
+ x = sf::as_Spatial(pa_data),
+ rows_cols = c(10, 10),
+ k = 5,
+ selection = "systematic",
+ biomod2 = FALSE,
+ plot = TRUE
+ )
+
+ expect_true(exists("scv"))
+ expect_s3_class(scv, "cv_spatial")
+ expect_equal(names(scv), expect_names)
+ expect_equal(length(scv$folds_list), 5)
+ expect_type(scv$folds_list, "list")
+ expect_null(scv$biomod_table, "matrix")
+ expect_equal(scv$k, 5)
+ expect_s3_class(scv$blocks, "sf")
+ expect_null(scv$column)
+ expect_null(scv$size)
+ expect_equal(dim(scv$records), c(5, 2))
+ expect_true(
+ !all(scv$records == 0)
+ )
+
+ expect_equal(print(scv), "cv_spatial")
+ expect_message(plot(scv))
+ expect_output(summary(scv))
})
test_that("test cv_spatial function with non-numeric iteration", {
- scv <- cv_spatial(x = pa_data,
- hexagon = FALSE,
- k = 5,
- selection = "random",
- iteration = "2", # not numeric
- biomod2 = FALSE,
- plot = FALSE)
-
- expect_true(exists("scv"))
- expect_s3_class(scv, "cv_spatial")
- expect_equal(names(scv), expect_names)
- expect_equal(length(scv$folds_list), 5)
- expect_type(scv$folds_list, "list")
- expect_null(scv$biomod_table, "matrix")
- expect_equal(scv$k, 5)
- expect_s3_class(scv$blocks, "sf")
- expect_null(scv$column)
- expect_null(scv$size)
- expect_equal(dim(scv$records), c(5, 2))
- expect_true(
- !all(scv$records == 0)
- )
-
- expect_equal(print(scv), "cv_spatial")
- expect_message(plot(scv))
- expect_output(summary(scv))
+ scv <- cv_spatial(
+ x = pa_data,
+ hexagon = FALSE,
+ k = 5,
+ selection = "random",
+ iteration = "2", # not numeric
+ biomod2 = FALSE,
+ plot = FALSE
+ )
+
+ expect_true(exists("scv"))
+ expect_s3_class(scv, "cv_spatial")
+ expect_equal(names(scv), expect_names)
+ expect_equal(length(scv$folds_list), 5)
+ expect_type(scv$folds_list, "list")
+ expect_null(scv$biomod_table, "matrix")
+ expect_equal(scv$k, 5)
+ expect_s3_class(scv$blocks, "sf")
+ expect_null(scv$column)
+ expect_null(scv$size)
+ expect_equal(dim(scv$records), c(5, 2))
+ expect_true(
+ !all(scv$records == 0)
+ )
+
+ expect_equal(print(scv), "cv_spatial")
+ expect_message(plot(scv))
+ expect_output(summary(scv))
})
test_that("test cv_spatial with checkerboard assingment and only row blocks", {
- scv <- cv_spatial(x = sf::as_Spatial(pa_data),
- hexagon = FALSE,
- rows_cols = c(5, 1),
- selection = "checkerboard",
- biomod2 = FALSE,
- plot = TRUE)
-
- expect_true(exists("scv"))
- expect_s3_class(scv, "cv_spatial")
- expect_equal(names(scv), expect_names)
- expect_equal(length(scv$folds_list), 2)
- expect_type(scv$folds_list, "list")
- expect_null(scv$biomod_table)
- expect_equal(scv$k, 2)
- expect_s3_class(scv$blocks, "sf")
- expect_null(scv$column)
- expect_null(scv$size)
- expect_equal(dim(scv$records), c(2, 2))
- expect_true(
- !all(scv$records == 0)
- )
-
- expect_equal(print(scv), "cv_spatial")
- expect_message(plot(scv))
- expect_output(summary(scv))
+ scv <- cv_spatial(
+ x = sf::as_Spatial(pa_data),
+ hexagon = FALSE,
+ rows_cols = c(5, 1),
+ selection = "checkerboard",
+ biomod2 = FALSE,
+ plot = TRUE
+ )
+
+ expect_true(exists("scv"))
+ expect_s3_class(scv, "cv_spatial")
+ expect_equal(names(scv), expect_names)
+ expect_equal(length(scv$folds_list), 2)
+ expect_type(scv$folds_list, "list")
+ expect_null(scv$biomod_table)
+ expect_equal(scv$k, 2)
+ expect_s3_class(scv$blocks, "sf")
+ expect_null(scv$column)
+ expect_null(scv$size)
+ expect_equal(dim(scv$records), c(2, 2))
+ expect_true(
+ !all(scv$records == 0)
+ )
+
+ expect_equal(print(scv), "cv_spatial")
+ expect_message(plot(scv))
+ expect_output(summary(scv))
})
test_that("test cv_spatial with user-defined blocks", {
- # make a spatial block polygon
- user_poly <- .make_blocks(x_obj = pa_data, blocksize = 450000)
-
- scv <- cv_spatial(x = pa_data,
- user_blocks = user_poly,
- selection = "random",
- iteration = 5,
- biomod2 = FALSE,
- progress = FALSE,
- plot = FALSE)
-
- expect_true(exists("scv"))
- expect_s3_class(scv, "cv_spatial")
- expect_equal(names(scv), expect_names)
- expect_equal(length(scv$folds_list), 5)
- expect_type(scv$folds_list, "list")
- expect_null(scv$biomod_table)
- expect_equal(scv$k, 5)
- expect_s3_class(scv$blocks, "sf")
- expect_null(scv$column)
- expect_null(scv$size)
- expect_equal(dim(scv$records), c(5, 2))
- expect_true(
- !all(scv$records == 0)
- )
-
- expect_equal(print(scv), "cv_spatial")
- expect_message(plot(scv))
- expect_output(summary(scv))
+ # make a spatial block polygon
+ user_poly <- .make_blocks(x_obj = pa_data, blocksize = 450000)
+
+ scv <- cv_spatial(
+ x = pa_data,
+ user_blocks = user_poly,
+ selection = "random",
+ iteration = 5,
+ biomod2 = FALSE,
+ progress = FALSE,
+ plot = FALSE
+ )
+
+ expect_true(exists("scv"))
+ expect_s3_class(scv, "cv_spatial")
+ expect_equal(names(scv), expect_names)
+ expect_equal(length(scv$folds_list), 5)
+ expect_type(scv$folds_list, "list")
+ expect_null(scv$biomod_table)
+ expect_equal(scv$k, 5)
+ expect_s3_class(scv$blocks, "sf")
+ expect_null(scv$column)
+ expect_null(scv$size)
+ expect_equal(dim(scv$records), c(5, 2))
+ expect_true(
+ !all(scv$records == 0)
+ )
+
+ expect_equal(print(scv), "cv_spatial")
+ expect_message(plot(scv))
+ expect_output(summary(scv))
})
test_that("test cv_spatial failur: number of blocks, wrong selection", {
- expect_error(cv_spatial(x = pa_data,
- rows_cols = c(2, 2),
- hexagon = FALSE,
- k = 15, # very high k
- selection = "random"))
+ expect_error(cv_spatial(
+ x = pa_data,
+ rows_cols = c(2, 2),
+ hexagon = FALSE,
+ k = 15,
+ # very high k
+ selection = "random"
+ ))
- expect_error(cv_spatial(x = pa_data,
- k = 1, # very low k
- selection = "random"))
+ expect_error(cv_spatial(
+ x = pa_data,
+ k = 1,
+ # very low k
+ selection = "random"
+ ))
- expect_error(cv_spatial(x = pa_data,
- k = 5,
- selection = "chance")) # wrong selection
+ expect_error(cv_spatial(x = pa_data, k = 5, selection = "chance")) # wrong selection
})
test_that("test cv_spatial failur: wrong user-defined blocks", {
- expect_error(
- cv_spatial(x = pa_data, # wrong user-defined blocks
- column = "occ",
- r = aus,
- user_blocks = data.frame(a = 1),
- size = 450000,
- k = 5)
- )
+ expect_error(
+ cv_spatial(
+ x = pa_data,
+ # wrong user-defined blocks
+ column = "occ",
+ r = aus,
+ user_blocks = data.frame(a = 1),
+ size = 450000,
+ k = 5
+ )
+ )
})
test_that("test cv_spatial with no speceis column match", {
- expect_warning(
- scv <- cv_spatial(x = pa_data,
- column = "response", # wrong response
- r = aus,
- size = 450000,
- k = 5)
- )
-
- expect_true(exists("scv"))
- expect_s3_class(scv, "cv_spatial")
- expect_equal(names(scv), expect_names)
- expect_equal(length(scv$folds_list), 5)
- expect_equal(scv$k, 5)
- expect_equal(dim(scv$records), c(5, 2))
- expect_true(
- !all(scv$records == 0)
- )
+
+ expect_warning(scv <- cv_spatial(
+ x = pa_data,
+ column = "response",
+ # wrong response
+ r = aus,
+ size = 450000,
+ k = 5
+ ))
+
+ expect_true(exists("scv"))
+ expect_s3_class(scv, "cv_spatial")
+ expect_equal(names(scv), expect_names)
+ expect_equal(length(scv$folds_list), 5)
+ expect_equal(scv$k, 5)
+ expect_equal(dim(scv$records), c(5, 2))
+ expect_true(
+ !all(scv$records == 0)
+ )
})
diff --git a/tests/testthat/test-v2-functions.R b/tests/testthat/test-v2-functions.R
index 1310efb..843f8c7 100644
--- a/tests/testthat/test-v2-functions.R
+++ b/tests/testthat/test-v2-functions.R
@@ -20,9 +20,11 @@ expect_names <- c(
test_that("test spatialAutoRange function works", {
# skip_on_cran()
- range1 <- spatialAutoRange(rasterLayer = aus,
- sampleNumber = 1000,
- showPlots = TRUE)
+ range1 <- spatialAutoRange(
+ rasterLayer = aus,
+ sampleNumber = 1000,
+ showPlots = TRUE
+ )
expect_true(exists("range1"))
expect_s3_class(range1, "SpatialAutoRange")
@@ -52,10 +54,12 @@ test_that("test spatialAutoRange function works", {
test_that("test spatialAutoRange function with x", {
# skip_on_cran()
- range3 <- spatialAutoRange(rasterLayer = aus,
- speciesData = pa_data,
- progress = FALSE,
- showPlots = TRUE)
+ range3 <- spatialAutoRange(
+ rasterLayer = aus,
+ speciesData = pa_data,
+ progress = FALSE,
+ showPlots = TRUE
+ )
expect_true(exists("range3"))
expect_s3_class(range3, "SpatialAutoRange")
@@ -89,16 +93,18 @@ test_that("test spatiaBlock function works", {
# skip_on_cran()
set.seed(1000)
- sb1 <- spatialBlock(speciesData = pa_data,
- species = "occ",
- rasterLayer = aus,
- theRange = 450000,
- k = 5,
- selection = "random",
- iteration = 5,
- biomod2Format = TRUE,
- showBlocks = TRUE,
- progress = TRUE)
+ sb1 <- spatialBlock(
+ speciesData = pa_data,
+ species = "occ",
+ rasterLayer = aus,
+ theRange = 450000,
+ k = 5,
+ selection = "random",
+ iteration = 5,
+ biomod2Format = TRUE,
+ showBlocks = TRUE,
+ progress = TRUE
+ )
expect_true(exists("sb1"))
expect_s3_class(sb1, "SpatialBlock")
@@ -137,11 +143,13 @@ expect_names <- c(
test_that("test buffering function works", {
# skip_on_cran()
- bf1 <- buffering(speciesData= pa_data,
- species= "occ",
- theRange= 450000,
- spDataType = "PA",
- progress = TRUE)
+ bf1 <- buffering(
+ speciesData= pa_data,
+ species= "occ",
+ theRange= 450000,
+ spDataType = "PA",
+ progress = TRUE
+ )
expect_true(exists("bf1"))
expect_s3_class(bf1, "BufferedBlock")
@@ -176,12 +184,14 @@ expect_names <- c(
test_that("test that environmental blocking function works", {
# skip_on_cran()
- eb <- envBlock(rasterLayer = aus,
- speciesData = pa_data,
- species = "occ",
- k = 5,
- standardization = "standard",
- rasterBlock = FALSE)
+ eb <- envBlock(
+ rasterLayer = aus,
+ speciesData = pa_data,
+ species = "occ",
+ k = 5,
+ standardization = "standard",
+ rasterBlock = FALSE
+ )
expect_true(exists("eb"))
expect_s3_class(eb, "EnvironmentalBlock")
diff --git a/vignettes/tutorial_1.Rmd b/vignettes/tutorial_1.Rmd
index 6037169..46e1ac1 100644
--- a/vignettes/tutorial_1.Rmd
+++ b/vignettes/tutorial_1.Rmd
@@ -296,12 +296,14 @@ cv_plot(cv = sb1,
## Check similarity
-The `cv_similarity` function can check for environmental similarity between the training and testing folds and thus possible extrapolation in the testing folds. It computes multivariate environmental similarity surface (MESS) as described in Elith et al. (2010). MESS represents how similar a point in a testing fold is to a training fold (as a reference set of points), with respect to a set of predictor variables in `r`. The negative values are the sites where at least one variable has a value that is outside the range of environments over the reference set, so these are novel environments.
+The `cv_similarity` function evaluates environmental similarity between training and testing folds, helping to detect potential extrapolation in the testing data. It supports three similarity measures: Multivariate Environmental Similarity Surface (MESS), Manhattan distance (L1), and Euclidean distance (L2). Negative values indicate potential environmental novelty.
+
```{r fig.height=4, fig.width=6}
cv_similarity(cv = ecv, # the environmental clustering
x = pa_data,
r = rasters,
+ method = "MESS",
progress = FALSE)
```
@@ -313,8 +315,7 @@ To support a first choice of block size, prior to any model fitting, package `bl
When only `r` is supplied, the `cv_spatial_autocor` function works by automatically fitting variograms to each continuous raster and finding the effective range of spatial autocorrelation. Variogram is a fundamental geostatistical tool for measuring spatial autocorrelation (O’Sullivan and Unwin, 2010).
```{r, results='hide', fig.keep='all', warning=FALSE, message=FALSE, fig.height=5, fig.width=7.2}
-sac1 <- cv_spatial_autocor(r = rasters,
- num_sample = 5000)
+sac1 <- cv_spatial_autocor(r = rasters, num_sample = 5000)
```
