diff --git a/DESCRIPTION b/DESCRIPTION index fb40cf1..4970437 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,7 +30,8 @@ LinkingTo: RcppArmadillo, Rcpp License: GPL (>= 2) Encoding: UTF-8 LazyLoad: yes -Suggests: sp, +Suggests: terra, + sp, knitr, rmarkdown, testthat @@ -46,5 +47,6 @@ Collate: 'clhs.R' 'clhs-sf.R' 'clhs-sp.R' + 'clhs-terra.R' 'plot.R' 'similarity.R' diff --git a/NAMESPACE b/NAMESPACE index 56b1828..febb3a7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,8 @@ # Generated by roxygen2: do not edit by hand S3method(clhs,Raster) +S3method(clhs,SpatRaster) +S3method(clhs,SpatVector) S3method(clhs,SpatialPointsDataFrame) S3method(clhs,data.frame) S3method(clhs,sf) diff --git a/R/clhs-terra.R b/R/clhs-terra.R new file mode 100644 index 0000000..7a4b261 --- /dev/null +++ b/R/clhs-terra.R @@ -0,0 +1,65 @@ +#' @include clhs-data.frame.R +#' @rdname clhs +#' @export +#' @noRd +clhs.SpatRaster <- function( + x, # data + ..., + use.coords = FALSE +){ + + if (!requireNamespace("terra")) { + stop("package 'terra' is required to convert SpatRaster objects to data.frame") + } + + if (use.coords) { + df <- terra::as.data.frame(x, xy = TRUE) + } else { + df <- terra::as.data.frame(x) + } + + spl <- clhs.data.frame(x = df, ...) + + if (is(spl, "cLHS_result")) { + spl$initial_object <- x # replacing the data.frame by the Spat* object + spl$sampled_data <- x[spl$index_samples, ] + } + + spl +} + +#' @include clhs-data.frame.R +#' @rdname clhs +#' @export +#' @noRd +clhs.SpatVector <- function( + x, # data + ..., + use.coords = FALSE +){ + + if (!requireNamespace("terra")) { + stop("package 'terra' is required to convert SpatVector objects to data.frame") + } + + if (use.coords) { + if (!terra::is.points(x)) { + stop("When `use.coords` is set to TRUE, only POINT geometries are supported", + call. = FALSE) + } + df <- terra::as.data.frame(x, geom = "XY") + } else { + + df <- terra::as.data.frame(x) + } + + spl <- clhs.data.frame(x = df, ...) + + if (is(spl, "cLHS_result")) { + spl$initial_object <- x # replacing the data.frame by the Spat* object + spl$sampled_data <- x[spl$index_samples, ] + } + + spl +} + diff --git a/tests/testthat/test-terra.R b/tests/testthat/test-terra.R new file mode 100644 index 0000000..241d846 --- /dev/null +++ b/tests/testthat/test-terra.R @@ -0,0 +1,30 @@ +context("clhs-terra") + +test_that("terra SpatRaster and SpatVector methods work", { + + skip_if_not_installed("terra") + + suppressWarnings(RNGversion("3.5.0")) + + x <- terra::rast(system.file("ex", "elev.tif", package = "terra")) + + # without cpp + set.seed(1) + res1 <- clhs(x, size = 100, iter = 100, use.cpp = FALSE) + + set.seed(1) + res2 <- clhs(terra::as.points(x), size = 100, iter = 100, use.cpp = FALSE) + + # with cpp + set.seed(1) + res3 <- clhs(x, size = 100, simple = FALSE) + + set.seed(1) + res4 <- clhs(terra::as.points(x), size = 100) + + expect_equal(lengths(list(res1, res2, res3$index_samples, res4)), rep(100, 4)) + + expect_equal(res1, res2) + expect_equal(res3$index_samples, res4) + +})