tests/testthat/test-crop_mask.R

In rasterpic: Create a Spatial Raster from Plain Images

test_that("Test crop", {
  img <- system.file("img/UK_flag.png", package = "rasterpic")
  x <- sf::st_read(system.file("gpkg/austria.gpkg", package = "rasterpic"),
    quiet = TRUE
  )

  x0 <- rasterpic_img(x, img, expand = 0, crop = TRUE)

  png_dim <- png::readPNG(img)
  expect_false(asp_ratio(x0) == dim(png_dim)[2] / dim(png_dim)[1])

  # Bboxes
  bbox_x <- as.double(sf::st_bbox(x))
  bbox_x0 <- as.vector(terra::ext(x0))

  # Tolerance limit
  min_length <- min(abs(bbox_x))

  diff <- max(abs(bbox_x - bbox_x0[c(1, 3, 2, 4)]))

  expect_true(diff / min_length < 0.0001)
})

test_that("Test mask", {
  img <- system.file("img/UK_flag.png", package = "rasterpic")
  x <- sf::st_read(system.file("gpkg/austria.gpkg", package = "rasterpic"),
    quiet = TRUE
  )

  raster <- rasterpic_img(x, img, mask = TRUE)

  png_dim <- png::readPNG(img)

  expect_true(asp_ratio(raster) == dim(png_dim)[2] / dim(png_dim)[1])


  # Same y coords
  expect_true(terra::ymin(raster) == sf::st_bbox(x)[2])
  expect_true(terra::ymax(raster) == sf::st_bbox(x)[4])

  # Different x coords
  expect_true(terra::xmin(raster) < sf::st_bbox(x)[1])
  expect_true(terra::xmax(raster) > sf::st_bbox(x)[3])

  # Expect NAs
  rws <- terra::ncell(raster)
  df <- as.data.frame(raster, na.rm = TRUE)
  expect_gt(rws, nrow(df))

  # Inverse
  raster_inv <- rasterpic_img(x, img, mask = TRUE, inverse = TRUE)

  expect_true(asp_ratio(raster_inv) == dim(png_dim)[2] / dim(png_dim)[1])


  # Same y coords
  expect_true(terra::ymin(raster_inv) == sf::st_bbox(x)[2])
  expect_true(terra::ymax(raster_inv) == sf::st_bbox(x)[4])

  # Different x coords
  expect_true(terra::xmin(raster_inv) < sf::st_bbox(x)[1])
  expect_true(terra::xmax(raster_inv) > sf::st_bbox(x)[3])

  # Expect NAs
  df2 <- as.data.frame(raster_inv, na.rm = TRUE)
  expect_gt(rws, nrow(df2))
  expect_gt(nrow(df2), nrow(df))
})

test_that("Test crop SpatVector", {
  img <- system.file("img/UK_flag.png", package = "rasterpic")
  x <- sf::st_read(system.file("gpkg/austria.gpkg", package = "rasterpic"),
    quiet = TRUE
  )

  x <- terra::vect(x)
  expect_s4_class(x, "SpatVector")

  x0 <- rasterpic_img(x, img, expand = 0, crop = TRUE)

  png_dim <- png::readPNG(img)
  expect_false(asp_ratio(x0) == dim(png_dim)[2] / dim(png_dim)[1])


  # Bboxes
  bbox_x <- as.double(sf::st_bbox(x))
  bbox_x0 <- as.vector(terra::ext(x0))

  # Tolerance limit
  min_length <- min(abs(bbox_x))

  diff <- max(abs(bbox_x - bbox_x0[c(1, 3, 2, 4)]))

  expect_true(diff / min_length < 0.0001)
})

test_that("Test mask SpatVector", {
  img <- system.file("img/UK_flag.png", package = "rasterpic")
  x <- sf::st_read(system.file("gpkg/austria.gpkg", package = "rasterpic"),
    quiet = TRUE
  )

  x <- terra::vect(x)
  expect_s4_class(x, "SpatVector")

  raster <- rasterpic_img(x, img, mask = TRUE)

  png_dim <- png::readPNG(img)

  expect_true(asp_ratio(raster) == dim(png_dim)[2] / dim(png_dim)[1])


  # Same y coords
  expect_true(terra::ymin(raster) == sf::st_bbox(x)[2])
  expect_true(terra::ymax(raster) == sf::st_bbox(x)[4])

  # Different x coords
  expect_true(terra::xmin(raster) < sf::st_bbox(x)[1])
  expect_true(terra::xmax(raster) > sf::st_bbox(x)[3])

  # Expect NAs
  rws <- terra::ncell(raster)
  df <- as.data.frame(raster, na.rm = TRUE)
  expect_gt(rws, nrow(df))

  # Inverse
  raster_inv <- rasterpic_img(x, img, mask = TRUE, inverse = TRUE)

  expect_true(asp_ratio(raster_inv) == dim(png_dim)[2] / dim(png_dim)[1])


  # Same y coords
  expect_true(terra::ymin(raster_inv) == sf::st_bbox(x)[2])
  expect_true(terra::ymax(raster_inv) == sf::st_bbox(x)[4])

  # Different x coords
  expect_true(terra::xmin(raster_inv) < sf::st_bbox(x)[1])
  expect_true(terra::xmax(raster_inv) > sf::st_bbox(x)[3])

  # Expect NAs
  df2 <- as.data.frame(raster_inv, na.rm = TRUE)
  expect_gt(rws, nrow(df2))
  expect_gt(nrow(df2), nrow(df))
})


test_that("Test crop sfg", {
  img <- system.file("img/UK_flag.png", package = "rasterpic")
  x <- sf::st_read(system.file("gpkg/austria.gpkg", package = "rasterpic"),
    quiet = TRUE
  )

  x_a <- sf::st_transform(x, 25830)
  crs_wkt_sf <- sf::st_crs(x_a)$wkt

  # Create an sfg

  f <- sf::st_coordinates(sf::st_geometry(x))

  # Extract a polygon
  x <- sf::st_polygon(list(as.matrix(f[f[, 4] == 1, 1:2], ncol = 2)))

  expect_s3_class(x, "sfg")

  x0 <- rasterpic_img(x, img, expand = 0, crop = TRUE, crs = crs_wkt_sf)

  png_dim <- png::readPNG(img)
  expect_false(asp_ratio(x0) == dim(png_dim)[2] / dim(png_dim)[1])


  # Bboxes
  bbox_x <- as.double(sf::st_bbox(x))
  bbox_x0 <- as.vector(terra::ext(x0))

  # Tolerance limit
  min_length <- min(abs(bbox_x))

  diff <- max(abs(bbox_x - bbox_x0[c(1, 3, 2, 4)]))

  expect_true(diff / min_length < 0.0001)
})

test_that("Test mask sfg", {
  img <- system.file("img/UK_flag.png", package = "rasterpic")
  x <- sf::st_read(system.file("gpkg/austria.gpkg", package = "rasterpic"),
    quiet = TRUE
  )

  x_a <- sf::st_transform(x, 25830)
  crs_wkt_sf <- sf::st_crs(x_a)$wkt

  # Create an sfg

  f <- sf::st_coordinates(sf::st_geometry(x))

  # Extract a polygon
  x <- sf::st_polygon(list(as.matrix(f[f[, 4] == 1, 1:2], ncol = 2)))

  expect_s3_class(x, "sfg")

  raster <- rasterpic_img(x, img, mask = TRUE, crs = crs_wkt_sf)

  png_dim <- png::readPNG(img)

  expect_true(asp_ratio(raster) == dim(png_dim)[2] / dim(png_dim)[1])


  # Same y coords
  expect_true(terra::ymin(raster) == sf::st_bbox(x)[2])
  expect_true(terra::ymax(raster) == sf::st_bbox(x)[4])

  # Different x coords
  expect_true(terra::xmin(raster) < sf::st_bbox(x)[1])
  expect_true(terra::xmax(raster) > sf::st_bbox(x)[3])

  # Expect NAs
  rws <- terra::ncell(raster)
  df <- as.data.frame(raster, na.rm = TRUE)
  expect_gt(rws, nrow(df))

  # Inverse
  raster_inv <- rasterpic_img(x, img, mask = TRUE, inverse = TRUE)

  expect_true(asp_ratio(raster_inv) == dim(png_dim)[2] / dim(png_dim)[1])


  # Same y coords
  expect_true(terra::ymin(raster_inv) == sf::st_bbox(x)[2])
  expect_true(terra::ymax(raster_inv) == sf::st_bbox(x)[4])

  # Different x coords
  expect_true(terra::xmin(raster_inv) < sf::st_bbox(x)[1])
  expect_true(terra::xmax(raster_inv) > sf::st_bbox(x)[3])

  # Expect NAs
  df2 <- as.data.frame(raster_inv, na.rm = TRUE)
  expect_gt(rws, nrow(df2))
  expect_gt(nrow(df2), nrow(df))
})