Add relocate

.Rbuildignore

@@ -15,3 +15,4 @@
 ^tidyterra\.Rcheck$
 ^tidyterra.*\.tar\.gz$
 ^tidyterra.*\.tgz$
+^cran-comments\.md$

.gitignore

@@ -24,3 +24,4 @@ tidyterra*.tgz
 CRAN-SUBMISSION
 .github/pkg.lock
 inst/doc
+cran-comments.md

NAMESPACE

@@ -11,6 +11,8 @@ S3method(mutate,SpatRaster)
 S3method(mutate,SpatVector)
 S3method(pull,SpatRaster)
 S3method(pull,SpatVector)
+S3method(relocate,SpatRaster)
+S3method(relocate,SpatVector)
 S3method(rename,SpatRaster)
 S3method(rename,SpatVector)
 S3method(rename_with,SpatRaster)
@@ -59,6 +61,7 @@ importFrom(dplyr,everything)
 importFrom(dplyr,filter)
 importFrom(dplyr,mutate)
 importFrom(dplyr,pull)
+importFrom(dplyr,relocate)
 importFrom(dplyr,rename)
 importFrom(dplyr,rename_with)
 importFrom(dplyr,select)

R/relocate.Spat.R

@@ -0,0 +1,90 @@
+#' Change layer/attribute order
+#'
+#' @description
+#'
+#' Use `relocate()` to change layer/attribute positions, using the same syntax
+#' as [select()] to make it easy to move blocks of layers/attributes at once.
+#'
+#' @export
+#' @rdname relocate
+#' @name relocate
+#'
+#' @inheritParams select
+#' @param ... [`tidy-select`][dplyr::relocate] layers/attributes to move.
+#'
+#' @param .before,.after [`tidy-select`][dplyr::relocate] Destination of
+#'   layers/attributes selected by `...`. Supplying neither will move
+#'   layers/attributes to the left-hand side; specifying both is an error.
+#'
+#' @return A Spat* object  of the same class than `.data`. See **Methods**.
+#'
+#' @seealso [dplyr::relocate()]
+#'
+#' @family dplyr.methods
+#'
+#' @importFrom dplyr relocate
+#'
+#' @section terra equivalent:
+#'
+#' `terra::subset(data, c("name_layer", "name_other_layer"))`
+#'
+#' @section Methods:
+#'
+#' Implementation of the **generic** [dplyr::relocate()] function.
+#'
+#' ## SpatRaster
+#'
+#' Relocate layers of a SpatRaster.
+#'
+#' ## SpatVector
+#'
+#' This method relies on the implementation of [dplyr::relocate()] method on the
+#' sf package. The result is a SpatVector with the attributes on a different
+#' order.
+#'
+#' @examples
+#'
+#' library(terra)
+#'
+#'
+#' f <- system.file("extdata/cyl_tile.tif", package = "tidyterra")
+#' spatrast <- rast(f) %>% mutate(aa = 1, bb = 2, cc = 3)
+#'
+#' names(spatrast)
+#'
+#'
+#' spatrast %>%
+#'   relocate(bb, .before = cyl_tile_3) %>%
+#'   relocate(cyl_tile_1, .after = last_col())
+#'
+relocate.SpatRaster <- function(.data, ..., .before = NULL, .after = NULL) {
+
+  # With template
+  df <- .data[1]
+
+  values_relocated <- dplyr::relocate(df, ...,
+    .before = {{ .before }},
+    .after = {{ .after }}
+  )
+
+
+  finalrast <- .data
+  finalrast <- terra::subset(finalrast, names(values_relocated))
+
+  return(finalrast)
+}
+
+
+#' @rdname relocate
+#' @export
+relocate.SpatVector <- function(.data, ..., .before = NULL, .after = NULL) {
+
+  # Use sf method
+  sf_obj <- sf::st_as_sf(.data)
+  relocated <- dplyr::relocate(sf_obj, ...,
+    .before = {{ .before }},
+    .after = {{ .after }}
+  )
+
+  return(terra::vect(relocated))
+}

README.Rmd

@@ -60,7 +60,7 @@ example, `as_tibble()` would return a tibble).
 Current methods and functions provided by {tidyterra} are:
 
 | tidyverse method      | SpatVector                             | SpatRaster                                                                                                     |
-|----------------------|-----------------|----------------------------------------------|
+|--------------------|-------------------|-----------------------------------------|
 | `tibble::as_tibble()` | :heavy_check_mark:                     | :heavy_check_mark:                                                                                             |
 | `dplyr::select()`     | :heavy_check_mark:                     | :heavy_check_mark: Select layers                                                                               |
 | `dplyr::mutate()`     | :heavy_check_mark:                     | :heavy_check_mark: Create /modify layers                                                                       |
@@ -69,6 +69,7 @@ Current methods and functions provided by {tidyterra} are:
 | `dplyr::slice()`      | :heavy_check_mark:                     | :heavy_check_mark: Additional methods for slicing by row and column.                                           |
 | `dplyr::pull()`       | :heavy_check_mark:                     | :heavy_check_mark:                                                                                             |
 | `dplyr::rename()`     | :heavy_check_mark:                     | :heavy_check_mark:                                                                                             |
+| `dplyr::relocate()`   | :heavy_check_mark:                     | :heavy_check_mark:                                                                                             |
 | `tidyr::drop_na()`    | :heavy_check_mark:                     | :heavy_check_mark: Remove cell values with `NA` on any layer. Additionally, outer cells with `NA` are removed. |
 | `tidyr::replace_na()` | :heavy_check_mark:                     | :heavy_check_mark:                                                                                             |
 | `ggplot2::geom_*()`   | :heavy_check_mark: `geom_spatvector()` | :heavy_check_mark: `geom_spatraster()` and `geom_spatraster_rgb()`.                                            |

README.md

@@ -54,6 +54,7 @@ Current methods and functions provided by {tidyterra} are:
 | `dplyr::slice()`      | :heavy_check_mark:                     | :heavy_check_mark: Additional methods for slicing by row and column.                                           |
 | `dplyr::pull()`       | :heavy_check_mark:                     | :heavy_check_mark:                                                                                             |
 | `dplyr::rename()`     | :heavy_check_mark:                     | :heavy_check_mark:                                                                                             |
+| `dplyr::relocate()`   | :heavy_check_mark:                     | :heavy_check_mark:                                                                                             |
 | `tidyr::drop_na()`    | :heavy_check_mark:                     | :heavy_check_mark: Remove cell values with `NA` on any layer. Additionally, outer cells with `NA` are removed. |
 | `tidyr::replace_na()` | :heavy_check_mark:                     | :heavy_check_mark:                                                                                             |
 | `ggplot2::geom_*()`   | :heavy_check_mark: `geom_spatvector()` | :heavy_check_mark: `geom_spatraster()` and `geom_spatraster_rgb()`.                                            |

codemeta.json

@@ -282,7 +282,7 @@
     },
     "SystemRequirements": null
   },
-  "fileSize": "1422.909KB",
+  "fileSize": "1431.952KB",
   "citation": [
     {
       "@type": "SoftwareSourceCode",

tests/testthat/test-relocate-Spat.R

@@ -0,0 +1,49 @@
+test_that("SpatRaster", {
+  f <- system.file("extdata/cyl_temp.tif", package = "tidyterra")
+  spatrast <- terra::rast(f)
+
+  mod <- spatrast %>%
+    mutate(exp_lyr1 = exp(tavg_04 / 10)) %>%
+    relocate(exp_lyr1, .before = 1)
+
+  expect_true(all(names(mod) == c("exp_lyr1", names(spatrast))))
+
+  expect_true(compare_spatrasters(spatrast, mod))
+
+  mod2 <- mod %>% relocate(tavg_05, .after = dplyr::last_col())
+
+  expect_true(compare_spatrasters(spatrast, mod2))
+
+  col_pos <- which(names(mod) == "tavg_05")
+
+  expect_true(
+    all(c(names(mod2)[-col_pos], names(mod2)[col_pos]) == names(mod))
+  )
+})
+
+
+test_that("SpatVector", {
+
+  # SpatVector method
+  f <- system.file("extdata/cyl.gpkg", package = "tidyterra")
+  v <- terra::vect(f)
+
+  mod <- v %>%
+    mutate(exp_attr = "a") %>%
+    relocate(exp_attr, .before = 1)
+
+  expect_s4_class(mod, "SpatVector")
+
+  expect_true(all(names(mod) == c("exp_attr", names(v))))
+
+
+  mod2 <- mod %>% relocate(cpro, .after = dplyr::last_col())
+
+  expect_s4_class(mod2, "SpatVector")
+
+  col_pos <- which(names(mod) == "cpro")
+
+  expect_true(
+    all(c(names(mod2)[-col_pos], names(mod2)[col_pos]) == names(mod))
+  )
+})