Merge pull request #164 from dieghernan/combineLevels

Handling different levels on factor layers

CITATION.cff

@@ -255,7 +255,7 @@ references:
     orcid: https://orcid.org/0000-0001-5872-2872
   year: '2025'
   doi: 10.32614/CRAN.package.terra
-  version: '>= 1.5-12'
+  version: '>= 1.8-10'
 - type: software
   title: tibble
   abstract: 'tibble: Simple Data Frames'

DESCRIPTION

@@ -28,7 +28,7 @@ Imports:
     rlang,
     scales,
     sf (>= 1.0.0),
-    terra (>= 1.5-12),
+    terra (>= 1.8-10),
     tibble (>= 3.0.0),
     tidyr (>= 1.0.0)
 Suggests: 

NEWS.md

@@ -1,6 +1,10 @@
 # tidyterra (development version)
 
+-   Minimal version of **terra** required is `1.8-10`.
 -   Remove **metR** from Suggests.
+-   Improve handling of factors when several layers have different levels. This
+    is done using terra::combineLevels() (**terra** \>= `1.8-10`). See
+    <https://stackoverflow.com/questions/79340152>.
 
 # tidyterra 0.6.2
 

R/geom_spatraster.R

@@ -428,6 +428,15 @@ check_mixed_cols <- function(r, fn = "tidyterra::geom_spat*") {
 
   # If all the same class then do nothing
   if (length(unique(col_classes)) == 1) {
+    # If is factor use combineLevels (terra >= 1.8-10)
+    if (col_classes[1] == "factor") {
+      rend <- try(terra::combineLevels(r), silent = TRUE)
+      if (inherits(rend, "try-error")) {
+        return(r)
+      } else {
+        return(rend)
+      }
+    }
     return(r)
   }
 
@@ -444,6 +453,16 @@ check_mixed_cols <- function(r, fn = "tidyterra::geom_spat*") {
     "layer {.val {names(newr)}} of class {.cls {final}}"
   ))
 
+  # If is factor use combineLevels (terra >= 1.8-10)
+  if (final == "factor") {
+    rend <- try(terra::combineLevels(newr), silent = TRUE)
+    if (inherits(rend, "try-error")) {
+      return(newr)
+    } else {
+      return(rend)
+    }
+  }
+
   return(newr)
 }
 

codemeta.json

@@ -294,7 +294,7 @@
       "@type": "SoftwareApplication",
       "identifier": "terra",
       "name": "terra",
-      "version": ">= 1.5-12",
+      "version": ">= 1.8-10",
       "provider": {
         "@id": "https://cran.r-project.org",
         "@type": "Organization",
@@ -332,7 +332,7 @@
     "SystemRequirements": null
   },
   "keywords": ["r", "terra", "ggplot-extension", "r-spatial", "rspatial", "cran", "cran-r", "r-package", "rstats", "rstats-package"],
-  "fileSize": "2399.291KB",
+  "fileSize": "2403.245KB",
   "citation": [
     {
       "@type": "ScholarlyArticle",

tests/testthat/_snaps/fortify-Spat.md

@@ -8,3 +8,13 @@
     Message
       ! Plotting only layer "tavg_04", "tavg_05", and "tavg_06" of class <numeric>
 
+# Fortify SpatRasters pivot factor
+
+    Code
+      end <- check_mixed_cols(s_r_f_mix)
+    Condition
+      Warning:
+      Mixed layer classes found in `tidyterra::geom_spat*()`.
+    Message
+      ! Plotting only layer "r1/r1", "r1/r2", "r2/r1", and "r2/r2" of class <factor>
+

tests/testthat/test-fortify-Spat.R

@@ -129,6 +129,86 @@ test_that("Fortify SpatRasters pivot", {
   build_terra <- ggplot2::ggplot_build(v_t)
 })
 
+test_that("Fortify SpatRasters pivot factor", {
+  # https://stackoverflow.com/questions/79340152/
+  r1 <- terra::rast(
+    nrows = 10, ncols = 10, xmin = 0, xmax = 10,
+    ymin = 0, ymax = 10
+  )
+  r1[] <- runif(terra::ncell(r1), min = 1, max = 5)
+
+  r2 <- terra::rast(
+    nrows = 10, ncols = 10, xmin = 0, xmax = 10,
+    ymin = 0, ymax = 10
+  )
+  r2[] <- runif(terra::ncell(r2), min = 1, max = 5)
+
+  # Combine rasters into a stack
+  s <- c(r1 / r1, r1 / r2, r2 / r1, r2 / r2)
+  names(s) <- c("r1/r1", "r1/r2", "r2/r1", "r2/r2")
+
+  # Reclassify the raster stack
+  # Define reclassification matrix
+  m_rc <- matrix(
+    c(
+      0, 0.5, 1,
+      0.5, 0.9, 2,
+      0.9, 1.1, 3,
+      1.1, 2, 4,
+      2, max(terra::global(s, max, na.rm = TRUE)$max), 5
+    ),
+    ncol = 3, byrow = TRUE
+  )
+
+  # Apply reclassification
+  s_r <- terra::classify(s, m_rc)
+  s_r_f <- terra::as.factor(s_r)
+
+  # Levls are not the same on origin
+  levs_ko <- terra::levels(s_r_f)
+
+  # lapply values
+  levs_ko <- lapply(levs_ko, function(x) {
+    as.character(x[, 2])
+  })
+  expect_false(identical(levs_ko[[1]], as.character(seq(1, 5))))
+  expect_false(identical(levs_ko[[1]], levs_ko[[2]]))
+  expect_false(identical(levs_ko[[1]], levs_ko[[3]]))
+  expect_true(identical(levs_ko[[1]], levs_ko[[4]]))
+  expect_true(identical(levs_ko[[2]], levs_ko[[3]]))
+  expect_false(identical(levs_ko[[2]], levs_ko[[4]]))
+  expect_false(identical(levs_ko[[3]], levs_ko[[4]]))
+
+  # All levels now should be the same on all layers
+  s_r_ok <- check_mixed_cols(s_r_f)
+
+  levs_ok <- terra::levels(s_r_ok)
+
+  levs_ok <- lapply(levs_ok, function(x) {
+    as.character(x[, 2])
+  })
+
+  # Keep order
+  expect_identical(levs_ok[[1]], as.character(seq(1, 5)))
+
+  expect_identical(levs_ok[[1]], levs_ok[[2]])
+  expect_identical(levs_ok[[1]], levs_ok[[3]])
+  expect_identical(levs_ok[[1]], levs_ok[[4]])
+  expect_identical(levs_ok[[2]], levs_ok[[3]])
+  expect_identical(levs_ok[[2]], levs_ok[[4]])
+  expect_identical(levs_ok[[3]], levs_ok[[4]])
+
+  # In fortify is ok as well
+  lev_ok <- fortify(s_r_f, pivot = TRUE)
+  expect_identical(levels(lev_ok$value), as.character(seq(1, 5)))
+
+  # And we still remove things
+  rchar <- select(terra::rast(s_r_f), 1)
+  rchar[] <- rep(c(1, 2, 3, 4), 25)
+  s_r_f_mix <- c(s_r_f, rchar)
+  expect_snapshot(end <- check_mixed_cols(s_r_f_mix))
+})
+
 test_that("Fortify SpatGraticule", {
   skip_if_not_installed("terra", minimum_version = "1.8.5")
   v <- terra::graticule()

tests/testthat/test-geom_spatraster_3lyr.R

@@ -224,6 +224,52 @@ test_that("geom_spatraster several layer with CRS", {
     "crs_15: stat works",
     st1
   )
+
+  # Check factors
+
+  set.seed(1234)
+  # https://stackoverflow.com/questions/79340152/
+  r1 <- terra::rast(
+    nrows = 10, ncols = 10, xmin = 0, xmax = 10,
+    ymin = 0, ymax = 10
+  )
+  r1[] <- runif(terra::ncell(r1), min = 1, max = 5)
+
+  r2 <- terra::rast(
+    nrows = 10, ncols = 10, xmin = 0, xmax = 10,
+    ymin = 0, ymax = 10
+  )
+  r2[] <- runif(terra::ncell(r2), min = 1, max = 5)
+
+  # Combine rasters into a stack
+  s <- c(r1 / r1, r1 / r2, r2 / r1, r2 / r2)
+  names(s) <- c("r1/r1", "r1/r2", "r2/r1", "r2/r2")
+
+  # Reclassify the raster stack
+  # Define reclassification matrix
+  m_rc <- matrix(
+    c(
+      0, 0.5, 1,
+      0.5, 0.9, 2,
+      0.9, 1.1, 3,
+      1.1, 2, 4,
+      2, max(terra::global(s, max, na.rm = TRUE)$max), 5
+    ),
+    ncol = 3, byrow = TRUE
+  )
+
+  # Apply reclassification
+  s_r <- terra::classify(s, m_rc)
+  s_r_f <- terra::as.factor(s_r)
+
+  fcts <- ggplot() +
+    geom_spatraster(data = s_r_f) +
+    facet_wrap(~lyr)
+  vdiffr::expect_doppelganger(
+    "crs_16: Combine levels",
+    fcts
+  )
+  set.seed(NULL)
 })
 
 

tidyterra.Rproj

@@ -1,5 +1,5 @@
 Version: 1.0
-ProjectId: 8ad0d16e-d664-4c5a-bd91-de9a9d580511
+ProjectId: f9bbfc7f-498e-4f6d-883f-38dda3810dfd
 
 RestoreWorkspace: No
 SaveWorkspace: No