From b35affa33948a1d3c62819933a2a18800d187b18 Mon Sep 17 00:00:00 2001 From: Anatolii Tsyplenkov Date: Thu, 9 Jan 2025 11:53:32 +1300 Subject: [PATCH] fix: removed methods for SpatRaster. Closes #2 --- DESCRIPTION | 2 +- R/terra.R | 137 ++++++++++++++++++++------------------------- R/zzz.R | 4 +- tests/test-setup.R | 10 ++-- 4 files changed, 70 insertions(+), 83 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ebcde88..431a794 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,10 +17,10 @@ Imports: grDevices, reticulate, S7 (>= 0.2.0), - terra (>= 1.7), stats, cli Suggests: + terra (>= 1.7), testthat (>= 3.0.0) Config/testthat/edition: 3 SystemRequirements: Python (>= 3.8.0), numpy, whitebox-workflows (>= v1.3.3) diff --git a/R/terra.R b/R/terra.R index c1f67db..88b9236 100644 --- a/R/terra.R +++ b/R/terra.R @@ -95,86 +95,73 @@ S7::method(as_rast, WhiteboxRaster) <- #' } #' @export as_wbw_raster <- - S7::new_generic( - name = "as_wbw_raster", - dispatch_args = "x", - fun = function(x) { - S7::S7_dispatch() - } - ) - -if (requireNamespace("terra", quietly = TRUE)) { - S7::method( - as_wbw_raster, - methods::getClass("SpatRaster", where = asNamespace("terra")) - ) <- - function(x) { - # Checks - checkmate::assert_class( - wbw, - classes = c( - "python.builtin.module", - "python.builtin.object" - ) - ) - checkmate::assert_true( - terra::nlyr(x) == 1 + function(x) { + # Checks + checkmate::assert_class(x, "SpatRaster") + checkmate::assert_class( + wbw, + classes = c( + "python.builtin.module", + "python.builtin.object" ) + ) + checkmate::assert_true( + terra::nlyr(x) == 1 + ) - # SpatRaster information - na_terra <- terra::NAflag(x) - nodata_value <- if (is.nan(na_terra)) { - -9999 - } else { - na_terra - } - res_terra <- terra::res(x) - name_terra <- names(x) - type_terra <- any(c( - terra::is.int(x), - terra::is.bool(x), - terra::is.factor(x) - )) - ext_terra <- terra::ext(x) - data_terra <- as.matrix(x, wide = TRUE) - data_terra[is.na(data_terra)] <- nodata_value + # SpatRaster information + na_terra <- terra::NAflag(x) + nodata_value <- if (is.nan(na_terra)) { + -9999 + } else { + na_terra + } + res_terra <- terra::res(x) + name_terra <- names(x) + type_terra <- any(c( + terra::is.int(x), + terra::is.bool(x), + terra::is.factor(x) + )) + ext_terra <- terra::ext(x) + data_terra <- as.matrix(x, wide = TRUE) + data_terra[is.na(data_terra)] <- nodata_value - # Create new RasterConfigs - new_config <- wbw$RasterConfigs() - new_config$title <- name_terra + # Create new RasterConfigs + new_config <- wbw$RasterConfigs() + new_config$title <- name_terra - # Dimensions - new_config$bands <- as.integer(terra::nlyr(x)) - new_config$columns <- as.integer(terra::ncol(x)) - new_config$rows <- as.integer(terra::nrow(x)) - new_config$west <- as.double(ext_terra[1]) - ## Note the differences in east and south between reading by - ## GDAL (i.e. terra) and WhiteboxTools - new_config$east <- as.double(ext_terra[2]) - res_terra[1] - new_config$south <- as.double(ext_terra[3]) + res_terra[2] - new_config$north <- as.double(ext_terra[4]) + # Dimensions + new_config$bands <- as.integer(terra::nlyr(x)) + new_config$columns <- as.integer(terra::ncol(x)) + new_config$rows <- as.integer(terra::nrow(x)) + new_config$west <- as.double(ext_terra[1]) + ## Note the differences in east and south between reading by + ## GDAL (i.e. terra) and WhiteboxTools + new_config$east <- as.double(ext_terra[2]) - res_terra[1] + new_config$south <- as.double(ext_terra[3]) + res_terra[2] + new_config$north <- as.double(ext_terra[4]) - # CRS - new_config$coordinate_ref_system_wkt <- terra::crs(x) - new_config$resolution_x <- res_terra[1] - new_config$resolution_y <- res_terra[2] + # CRS + new_config$coordinate_ref_system_wkt <- terra::crs(x) + new_config$resolution_x <- res_terra[1] + new_config$resolution_y <- res_terra[2] - # Data type - new_config$nodata <- nodata_value - new_config$data_type <- - if (type_terra) { - wbw$RasterDataType$I16 - } else { - wbw$RasterDataType$F32 - } + # Data type + new_config$nodata <- nodata_value + new_config$data_type <- + if (type_terra) { + wbw$RasterDataType$I16 + } else { + wbw$RasterDataType$F32 + } - # Create WhiteboxRaster - new_raster <- wbe$new_raster(new_config) - wbw_env$matrix_to_wbw(data_terra, new_raster) + # Create WhiteboxRaster + new_raster <- wbe$new_raster(new_config) + wbw_env$matrix_to_wbw(data_terra, new_raster) - WhiteboxRaster( - name = name_terra, - source = new_raster - ) - } -} + WhiteboxRaster( + name = name_terra, + source = new_raster + ) + } diff --git a/R/zzz.R b/R/zzz.R index d3b2167..a3d6593 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -172,7 +172,7 @@ wbw_version <- .onAttach <- function(libname, pkgname) { wbwv <- wbw_version() suppress <- - !grepl("suppress", Sys.getenv("wbw.message"), ignore.case = TRUE) + !grepl("suppressed", Sys.getenv("wbw.message"), ignore.case = TRUE) if (is.null(wbwv) && suppress && interactive()) { cli::cli_alert_warning(c( @@ -181,7 +181,7 @@ wbw_version <- )) } else if (!is.null(wbwv) && suppress) { cli::cli_alert_success(c( - "wbw v{wbwv} -- using whitebox-workflows v{wbwv}" + "wbw v{utils::packageVersion('wbw')} -- using whitebox-workflows v{wbwv}" )) } } diff --git a/tests/test-setup.R b/tests/test-setup.R index 519a527..0f54d8e 100644 --- a/tests/test-setup.R +++ b/tests/test-setup.R @@ -6,8 +6,8 @@ raster_path <- x <- wbw_read_raster(raster_path) # Path to terra's files -f <- system.file("ex/elev.tif", package = "terra") -# if (requireNamespace("terra", quietly = TRUE)) { -# library(terra) -# f <- system.file("ex/elev.tif", package = "terra") -# } +# f <- system.file("ex/elev.tif", package = "terra") +if (requireNamespace("terra", quietly = TRUE)) { + library(terra) + f <- system.file("ex/elev.tif", package = "terra") +}