tests/testthat/test-fortify-Spat.R

In dieghernan/tidyterra: 'tidyverse' Methods and 'ggplot2' Helpers for 'terra' Objects

test_that("Fortify SpatVectors", {
  v <- terra::vect(system.file("extdata/cyl.gpkg", package = "tidyterra"))

  fort <- fortify(v)

  # Compare
  asf <- sf::st_as_sf(v)
  # We added new classes
  class(asf) <- class(fort)

  expect_identical(fort, asf)


  # Try ggplot
  v_t <- ggplot2::ggplot(v) +
    geom_spatvector()
  build_terra <- ggplot2::layer_data(v_t)

  v_sf <- ggplot2::ggplot(asf) +
    ggplot2::geom_sf()

  build_sf <- ggplot2::layer_data(v_sf)


  expect_identical(build_terra, build_sf)
})


test_that("Fortify SpatRasters", {
  r <- terra::rast(system.file("extdata/volcano2.tif", package = "tidyterra"))

  fort <- fortify(r)

  # Compare
  tbl <- as_tibble(r, xy = TRUE)
  expect_identical(fort, tbl)

  # Can go back to SpatRaster

  back <- as_spatraster(fort)

  expect_true(compare_spatrasters(r, back))
  expect_identical(names(r), names(back))


  # What about with no CRS?

  r_no <- r

  terra::crs(r_no) <- ""

  fort_no <- ggplot2::fortify(r_no)
  tbl_no <- as_tibble(r_no, xy = TRUE)

  expect_identical(fort_no, tbl_no)

  # Back!
  back_no <- as_spatraster(fort_no)
  expect_true(compare_spatrasters(r_no, back_no))


  # Try resample
  fort_res <- ggplot2::fortify(r, maxcell = 10)

  expect_lt(nrow(fort_res), nrow(fort))

  # Try ggplot
  v_t <- ggplot2::ggplot(r, maxcell = 10) +
    ggplot2::geom_point(aes(x, y))
  build_terra <- ggplot2::ggplot_build(v_t)

  v_point <- ggplot2::ggplot(fort_res) +
    ggplot2::geom_point(aes(x, y))

  build_point <- ggplot2::ggplot_build(v_point)

  # ignore layout
  build_terra$plot$layout <- NULL
  build_point$plot$layout <- NULL
  build_terra$layout <- NULL
  build_point$layout <- NULL

  expect_identical(build_terra, build_point)
})

test_that("Fortify SpatRasters pivot", {
  r <- terra::rast(system.file("extdata/cyl_temp.tif",
    package = "tidyterra"
  ))

  fort <- fortify(r, pivot = TRUE)

  expect_equal(ncol(fort), 4)
  expect_equal(names(fort), c("x", "y", "lyr", "value"))

  # Can go back to SpatRaster
  back <- as_spatraster(fort)

  expect_true(compare_spatrasters(r, back))
  expect_identical(names(r), names(back))

  # Complain on mixed
  fort2 <- dplyr::mutate(back, char = "a")
  expect_snapshot(aa <- fortify(fort2, pivot = TRUE))

  expect_identical(unique(aa$lyr), names(back))

  # No complain in double and integer (treated all as numeric)
  # https://stackoverflow.com/questions/79292989

  m <- matrix(c(1:24, NA), nrow = 5, ncol = 5)
  n <- matrix(rep(5, time = 25), nrow = 5, ncol = 5)

  db_int <- terra::rast(c(A = terra::rast(m), B = terra::rast(n)))
  expect_identical(terra::is.int(db_int), c(TRUE, FALSE))
  expect_silent(db_int_f <- fortify(db_int, pivot = TRUE))

  expect_equal(nrow(db_int_f), terra::ncell(db_int) * terra::nlyr(db_int))
  expect_identical(unique(db_int_f$lyr), names(db_int))

  # What about with no CRS?

  r_no <- r

  terra::crs(r_no) <- ""

  fort_no <- ggplot2::fortify(r_no, pivot = TRUE)
  # Back!
  back_no <- as_spatraster(fort_no)
  expect_true(compare_spatrasters(r_no, back_no))


  # Try resample
  fort_res <- ggplot2::fortify(r, maxcell = 10, pivot = TRUE)

  expect_lt(nrow(fort_res), nrow(fort))

  # Try ggplot
  v_t <- ggplot2::ggplot(r, maxcell = 10, pivot = TRUE) +
    ggplot2::geom_point(aes(x, y)) +
    ggplot2::facet_wrap(~lyr)

  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()

  fort <- fortify(v)

  # Compare
  asf <- sf::st_as_sf(terra::vect(v))
  # We added new classes
  class(asf) <- class(fort)

  expect_identical(fort, asf)


  # Try ggplot
  v_t <- ggplot2::ggplot(v) +
    geom_spatvector()
  build_terra <- ggplot2::layer_data(v_t)

  v_sf <- ggplot2::ggplot(asf) +
    ggplot2::geom_sf()

  build_sf <- ggplot2::layer_data(v_sf)


  expect_identical(build_terra, build_sf)
})