tests/testthat/test-grd.R

In wk: Lightweight Well-Known Geometry Parsing

test_that("grd_rct() works", {
  grid <- grd_rct(volcano)
  expect_s3_class(grid, "wk_grd_rct")
  expect_s3_class(grid, "wk_grd")
  expect_identical(as_grd_rct(grid), grid)
  expect_null(wk_crs(grid))
  expect_identical(wk_bbox(grid), rct(0, 0, 61, 87))

  expect_match(format(grid), "wk_grd_rct")
  expect_output(print(grid), "wk_grd_rct")

  grid_crs <- wk_set_crs(grid, 1234)
  expect_match(format(grid_crs), "wk_grd_rct")
  expect_output(print(grid_crs), "wk_grd_rct")
})

test_that("grd_rct() works for an empty grid", {
  empty <- grd_rct(matrix(nrow = 0, ncol = 0))
  expect_identical(wk_bbox(empty), wk_bbox(xy(crs = NULL)))
})

test_that("grd_xy() works for an empty grid", {
  empty <- grd_xy(matrix(nrow = 0, ncol = 0))
  expect_identical(wk_bbox(empty), wk_bbox(xy(crs = NULL)))
})

test_that("grd_xy() works for h/v lines", {
  hline <- grd_xy(matrix(nrow = 10, ncol = 1), rct(0, 0, 0, 1))
  expect_identical(wk_bbox(hline), rct(0, 0, 0, 1))
  vline <- grd_xy(matrix(nrow = 1, ncol = 10), rct(0, 0, 1, 0))
  expect_identical(wk_bbox(vline), rct(0, 0, 1, 0))
})

test_that("grd_xy() works", {
  grid <- grd_xy(volcano)
  expect_s3_class(grid, "wk_grd_xy")
  expect_s3_class(grid, "wk_grd")
  expect_identical(as_grd_xy(grid), grid)
  expect_null(wk_crs(grid))
  expect_identical(wk_bbox(grid), rct(0, 0, 60, 86))

  expect_match(format(grid), "wk_grd_xy")
  expect_output(print(grid), "wk_grd_xy")

  grid_crs <- wk_set_crs(grid, 1234)
  expect_match(format(grid_crs), "wk_grd_xy")
  expect_output(print(grid_crs), "wk_grd_xy")
})

test_that("grd_xy <-> grd_rct converters work", {
  grid <- grd_rct(volcano)
  expect_identical(as_grd_rct(as_grd_xy(grid)), grid)

  empty <- grd_rct(matrix(nrow = 0, ncol = 0))
  expect_identical(as_grd_rct(as_grd_xy(empty)), empty)

  # make sure x/y value don't get lost for a single row/col
  expect_identical(
    wk_bbox(as_grd_rct(as_grd_xy(grd(nx = 10, ny = 1)))),
    rct(0, 0.5, 10, 0.5)
  )
  expect_identical(
    wk_bbox(as_grd_rct(as_grd_xy(grd(nx = 1, ny = 10)))),
    rct(0.5, 0, 0.5, 10)
  )
})

test_that("grd() works", {
  grid_bbox <- grd(
    bbox = xy(c(0, 10), c(0, 20)),
    nx = 10, ny = 20, type = "polygons"
  )
  expect_identical(dim(grid_bbox$data), c(20L, 10L, 0L))
  expect_identical(wk_bbox(grid_bbox), rct(0, 0, 10, 20))

  grid_nxny <- grd(nx = 10, ny = 20, type = "polygons")
  expect_identical(dim(grid_nxny$data), c(20L, 10L, 0L))
  expect_identical(wk_bbox(grid_nxny), rct(0, 0, 10, 20))

  grid_dxdy <- grd(rct(0, 0, 10, 20), dx = 1, dy = 4)
  expect_identical(dim(grid_dxdy$data), c(5L, 10L, 0L))
  expect_identical(wk_bbox(grid_dxdy), rct(0, 0, 10, 20))

  center_nxny <- grd(nx = 10, ny = 20, type = "centers")
  expect_identical(dim(center_nxny$data), c(20L, 10L, 0L))
  expect_identical(wk_bbox(center_nxny), rct(0.5, 0.5, 9.5, 19.5))

  center_dxdy <- grd(rct(0, 0, 10, 20), dx = 1, dy = 4, type = "centers")
  expect_identical(dim(center_dxdy$data), c(5L, 10L, 0L))
  expect_identical(wk_bbox(center_dxdy), rct(0.5, 2, 9.5, 18))

  corner_nxny <- grd(nx = 10, ny = 20, type = "corners")
  expect_identical(dim(corner_nxny$data), c(21L, 11L, 0L))
  expect_identical(wk_bbox(corner_nxny), rct(0, 0, 10, 20))

  corner_dxdy <- grd(rct(0, 0, 10, 20), dx = 1, dy = 4, type = "corners")
  expect_identical(dim(corner_dxdy$data), c(6L, 11L, 0L))
  expect_identical(wk_bbox(corner_dxdy), rct(0, 0, 10, 20))

  expect_error(grd(), "Must specify")
})

test_that("grd matrix interface works", {
  grid <- grd_rct(array(1:24, dim = c(2, 3, 4)))
  expect_identical(grid[1, 1, ], grd_subset(grid, 1, 1))
  expect_identical(grid[, , 1], grd_rct(grid$data[, , 1, drop = FALSE]))
  expect_identical(dim(grid)[1], 2L)
  expect_identical(dim(grid)[2], 3L)

  # rct subsetting
  expect_identical(grid[rct(0.1, 1.1, 0.9, 1.9), ], grd_subset(grid, 1, 1))
  expect_equal(unname(dim(grid[rct(0.1, 1.1, 0.9, 1.9), 1])), c(1L, 1L, 1L))
  grid$data <- grid$data[, , 1, drop = TRUE]
  expect_identical(grid[rct(0.1, 1.1, 0.9, 1.9), ], grd_subset(grid, 1, 1))
})

test_that("grd[[]]<- interface works", {
  grid <- grd_rct(array(1:24, dim = c(2, 3, 4)))

  grid[["bbox"]] <- rct(0, 0, 1, 1)
  expect_identical(wk_bbox(grid), rct(0, 0, 1, 1))

  # make sure this is normalized/converted
  grid[["bbox"]] <- rct(1, 1, 0, 0)
  expect_identical(wk_bbox(grid), rct(0, 0, 1, 1))

  grid[["bbox"]] <- as_wkb(rct(1, 1, 0, 0))
  expect_identical(wk_bbox(grid), rct(0, 0, 1, 1))

  expect_error(grid[["bbox"]] <- rct(NA, 1, 0, 0), "Can't set missing")

  grid[["data"]] <- matrix()
  expect_identical(grid, grd_rct(matrix(), rct(0, 0, 1, 1)))

  expect_error(grid[["not_data_or_bbox"]] <- NULL, "Can't set element")
})

test_that("grd$<- interface works", {
  grid <- grd_rct(array(1:24, dim = c(2, 3, 4)))

  grid$bbox <- rct(0, 0, 1, 1)
  expect_identical(wk_bbox(grid), rct(0, 0, 1, 1))

  grid$data <- matrix()
  expect_identical(grid, grd_rct(matrix(), rct(0, 0, 1, 1)))

  expect_error(grid$not_data_or_bbox <- NULL, "Can't set element")
})