tests/testthat/test-count-tally-SpatVector.R

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

# From dplyr
# count -------------------------------------------------------------------

test_that("informs if n column already present, unless overridden", {
  df1 <- data.frame(n = c(1, 1, 2, 2, 2))
  df1$lon <- df1$n
  df1$lat <- df1$n

  df1 <- terra::vect(df1)

  expect_message(out <- count(df1, n), "already present")
  expect_s4_class(out, "SpatVector")
  expect_named(out, c("n", "nn"))

  # not supported
  expect_error(count(df1, n, name = "n"))

  expect_message(out <- count(df1, n, name = "nn"), NA)
  expect_named(out, c("n", "nn"))

  df2 <- df1
  df2$nn <- 1:5

  expect_message(out <- count(df2, n), "already present")
  expect_s4_class(out, "SpatVector")
  expect_named(out, c("n", "nn"))

  expect_message(out <- count(df2, n, nn), "already present")
  expect_named(out, c("n", "nn", "nnn"))
})

test_that("name must be string", {
  df1 <- data.frame(x = c(1, 1, 2, 2, 2))
  df1$lon <- df1$x
  df1$lat <- df1$x
  df1 <- terra::vect(df1)

  expect_snapshot(error = TRUE, count(df1, x, name = 1))
  expect_snapshot(error = TRUE, count(df1, x, name = letters))
})

test_that("output preserves grouping", {
  df <- data.frame(g = c(1, 2, 2, 2))
  df$lon <- 1:4
  df$lat <- 1:4
  df <- terra::vect(df)
  exp <- data.frame(g = c(1, 2), n = c(1, 3))
  exp$lon <- 1:2
  exp$lat <- 1:2
  exp <- terra::vect(exp)

  expect_equal(
    df %>% count(g) %>% as_tibble(),
    exp %>% as_tibble()
  )

  expect_equal(
    df %>% group_by(g) %>% count() %>% as_tibble(),
    exp %>% group_by(g) %>% as_tibble()
  )
})

test_that("output preserves class & attributes where possible", {
  df <- data.frame(g = c(1, 2, 2, 2))
  df$lon <- 1:4
  df$lat <- 1:4
  df <- terra::vect(df, crs = "EPSG:4326")

  out <- df %>% count(g)
  expect_s4_class(out, "SpatVector")
  expect_identical(group_vars(out), group_vars(df))
  expect_identical(pull_crs(out), pull_crs(df))

  out <- df %>%
    group_by(g) %>%
    count()
  expect_s4_class(out, "SpatVector")
  expect_equal(group_vars(out), "g")
  expect_identical(pull_crs(out), pull_crs(df))
})

test_that("can only explicitly chain together multiple tallies", {
  expect_snapshot({
    df <- data.frame(g = c(1, 1, 2, 2), n = 1:4)
    df$lat <- 1:4
    df$lon <- 1:4
    df <- terra::vect(df, crs = "EPSG:3857")

    df %>% count(g)
    df %>%
      count(g) %>%
      count()
    df %>% count(n)
  })
})


# tally -------------------------------------------------------------------

test_that("tally can sort output", {
  gf <- group_by(data.frame(x = c(1, 1, 2, 2, 2)), x)
  gf$lon <- 1:5
  gf$lat <- 1:5
  gf <- as_spatvector(gf)
  expect_s4_class(gf, "SpatVector")
  expect_identical(group_vars(gf), "x")
  out <- tally(gf, sort = TRUE)
  expect_true(all(as_tibble(out) == data.frame(x = c(2, 1), n = c(3, 2))))
})

test_that("tally() drops last group", {
  df <- data.frame(x = 1, y = 2, z = 3)
  df <- terra::vect(df, c("x", "y"), keepgeom = TRUE)

  res <- expect_message(df %>% group_by(x, y) %>% tally(), NA)
  expect_equal(group_vars(res), "x")
})

test_that("count Check aggregation: POINTS", {
  v <- terra::vect(system.file("extdata/cyl.gpkg", package = "tidyterra"))
  v <- terra::centroids(v)
  v$gr <- rep_len(c("F", "B", "A", "B", "A"), 9)
  v$nn <- seq_len(nrow(v))

  expect_identical(terra::geomtype(v), "points")

  # Ungrouped
  # Dissolve
  v_ds <- count(v, .dissolve = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, dissolve = TRUE)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Non dissolved
  v_ds <- count(v, .dissolve = FALSE)
  # Terra method
  t_ds <- terra::aggregate(v, dissolve = FALSE)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Grouped
  # Dissolve
  v_ds <- count(v, gr, .dissolve = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = TRUE)

  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # No Dissolve
  v_ds <- count(v, gr, .dissolve = FALSE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = FALSE)

  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Sorted Dissolved
  v_ds <- count(v, gr, .dissolve = TRUE, sort = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = TRUE)
  t_ds <- t_ds[order(t_ds$agg_n, decreasing = TRUE), ]
  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Sorted Not Dissolved
  v_ds <- count(v, gr, .dissolve = FALSE, sort = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = FALSE)
  t_ds <- t_ds[order(t_ds$agg_n, decreasing = TRUE), ]
  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)
})

test_that("count Check aggregation: POLYGONS", {
  v <- terra::vect(system.file("extdata/cyl.gpkg", package = "tidyterra"))
  v$gr <- rep_len(c("F", "B", "A", "B", "A"), 9)
  v$nn <- seq_len(nrow(v))
  expect_identical(terra::geomtype(v), "polygons")


  # Ungrouped
  # Dissolve
  v_ds <- count(v, .dissolve = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, dissolve = TRUE)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Non dissolved
  v_ds <- count(v, .dissolve = FALSE)
  # Terra method
  t_ds <- terra::aggregate(v, dissolve = FALSE)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Grouped
  # Dissolve
  v_ds <- count(v, gr, .dissolve = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = TRUE)

  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # No Dissolve
  v_ds <- count(v, gr, .dissolve = FALSE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = FALSE)

  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Sorted Dissolved
  v_ds <- count(v, gr, .dissolve = TRUE, sort = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = TRUE)
  t_ds <- t_ds[order(t_ds$agg_n, decreasing = TRUE), ]
  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Sorted Not Dissolved
  v_ds <- count(v, gr, .dissolve = FALSE, sort = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = FALSE)
  t_ds <- t_ds[order(t_ds$agg_n, decreasing = TRUE), ]
  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)
})


test_that("count Check aggregation: LINES", {
  v <- terra::vect(system.file("extdata/cyl.gpkg", package = "tidyterra"))
  v$gr <- rep_len(c("F", "B", "A", "B", "A"), 9)
  v$nn <- seq_len(nrow(v))

  v <- terra::as.lines(v)

  expect_identical(terra::geomtype(v), "lines")


  # Ungrouped
  # Dissolve
  v_ds <- count(v, .dissolve = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, dissolve = TRUE)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Non dissolved
  v_ds <- count(v, .dissolve = FALSE)
  # Terra method
  t_ds <- terra::aggregate(v, dissolve = FALSE)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Grouped
  # Dissolve
  v_ds <- count(v, gr, .dissolve = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = TRUE)

  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # No Dissolve
  v_ds <- count(v, gr, .dissolve = FALSE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = FALSE)

  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Sorted Dissolved
  v_ds <- count(v, gr, .dissolve = TRUE, sort = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = TRUE)
  t_ds <- t_ds[order(t_ds$agg_n, decreasing = TRUE), ]
  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Sorted Not Dissolved
  v_ds <- count(v, gr, .dissolve = FALSE, sort = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = FALSE)
  t_ds <- t_ds[order(t_ds$agg_n, decreasing = TRUE), ]
  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)
})


test_that("tally Check aggregation: POINTS", {
  v <- terra::vect(system.file("extdata/cyl.gpkg", package = "tidyterra"))
  v <- terra::centroids(v)
  v$gr <- rep_len(c("F", "B", "A", "B", "A"), 9)
  v$nn <- seq_len(nrow(v))

  expect_identical(terra::geomtype(v), "points")

  # Ungrouped
  v_ds <- tally(v)
  # Terra method
  t_ds <- terra::aggregate(v, dissolve = FALSE)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Grouped
  v_ds <- tally(group_by(v, gr))
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = FALSE)

  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Sorted
  v_ds <- tally(group_by(v, gr), sort = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = FALSE)
  t_ds <- t_ds[order(t_ds$agg_n, decreasing = TRUE), ]
  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)
})

test_that("tally Check aggregation: POLYGONS", {
  v <- terra::vect(system.file("extdata/cyl.gpkg", package = "tidyterra"))
  v$gr <- rep_len(c("F", "B", "A", "B", "A"), 9)
  v$nn <- seq_len(nrow(v))
  expect_identical(terra::geomtype(v), "polygons")


  # Ungrouped
  v_ds <- tally(v)
  # Terra method
  t_ds <- terra::aggregate(v, dissolve = FALSE)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Grouped
  v_ds <- tally(group_by(v, gr))
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = FALSE)

  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Sorted
  v_ds <- tally(group_by(v, gr), sort = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = FALSE)
  t_ds <- t_ds[order(t_ds$agg_n, decreasing = TRUE), ]
  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)
})


test_that("tally Check aggregation: LINES", {
  v <- terra::vect(system.file("extdata/cyl.gpkg", package = "tidyterra"))
  v$gr <- rep_len(c("F", "B", "A", "B", "A"), 9)
  v$nn <- seq_len(nrow(v))

  v <- terra::as.lines(v)

  expect_identical(terra::geomtype(v), "lines")

  # Ungrouped
  v_ds <- tally(v)
  # Terra method
  t_ds <- terra::aggregate(v, dissolve = FALSE)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Grouped
  v_ds <- tally(group_by(v, gr))
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = FALSE)

  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)

  # Sorted
  v_ds <- tally(group_by(v, gr), sort = TRUE)
  # Terra method
  t_ds <- terra::aggregate(v, "gr", dissolve = FALSE)
  t_ds <- t_ds[order(t_ds$agg_n, decreasing = TRUE), ]
  expect_equal(nrow(v_ds), 3)
  expect_equal(nrow(t_ds), 3)

  g_wkt <- terra::geom(v_ds, wkt = TRUE)
  t_wkt <- terra::geom(t_ds, wkt = TRUE)
  expect_identical(g_wkt, t_wkt)
})