tests/testthat/test-cellnumbers.R

library(raster)
library(dplyr)
library(spex)  ## devtools::install_github("mdsumner/spex")
# repeater <- rep(seq_len(nrow(quakes)), 2)
# qk_mx <- jitter(as.matrix(quakes[,2:1])[repeater, ], 135)
# #qk_mx <- data.matrix(quakes[,2:1])
# hres_ras <- raster(spex::buffer_extent(extent(qk_mx), 1), res = 1, crs = "+init=epsg:4326")
# 
# library(tibble)
# cells <- tibble(cell_ = cellFromXY(hres_ras, qk_mx)) %>% 
#   mutate(mag = quakes$mag[repeater]) %>% 
#   group_by(cell_) %>% 
#   summarize(n_quakes = n(), mean_mag = mean(mag))
# 
# ## raster to polygon (one poly per pixel via indexed quadmesh)
# library(sf)
# poly <- spex::qm_rasterToPolygons(hres_ras)
# poly$n_quakes <- poly$mean_mag <- NA_real_
# poly$layer <- NULL
# poly$n_quakes[cells$cell_] <- cells$n_quakes
# poly$mean_mag[cells$cell_] <- cells$mean_mag
# 
# library(mapview)
# mapview(poly %>% filter(!is.na(n_quakes)), zcol="n_quakes", na.color="gray")
# 

context("cellnumbers")

sfc <- structure(list(structure(cbind(1, 1), class = c("XY", "POINT", "sfg"))), precision = 0, bbox = structure(c(xmin = 1, ymin = 1, xmax = 1, ymax = 1), class = "bbox"),
                 crs = structure(list(epsg = NA_integer_, proj4string = NA_character_), class = "crs"),
                 n_empty = 0L, class = "sfc")

test_that("cell numbers for points works", {
  qk_mx <- as.matrix(quakes[,2:1])
  hres_ras <- raster(spex::buffer_extent(extent(qk_mx), 1), res = 1, crs = "+init=epsg:4326")
  raster_tib <- tibble(cell_ = cellFromXY(hres_ras, qk_mx))
  expect_warning(tabula_tib <- cellnumbers(hres_ras, qk_mx), "projections not the same")
  expect_identical(raster_tib$cell_, tabula_tib$cell_)
  expect_warning(aa <- cellnumbers(ghrsst, sfc)$cell_, "projections not the same")
  expect_equal(aa, NA_integer_)
})

sfc2 <- structure(list(structure(cbind(147, -45), class = c("XY", "POINT", "sfg"))), precision = 0, bbox = structure(c(xmin = 1, ymin = 1, xmax = 1, ymax = 1), class = "bbox"),
                 crs = structure(list(epsg = NA_integer_, proj4string = NA_character_), class = "crs"),
                 n_empty = 0L, class = "sfc")

test_that("extract sf works", {
    expect_warning(e <- extract.sf(ghrsst, sfc2), "projections not the same")
  expect_true(e - 1 < 13)
}
          
)
r-gris/tabularaster documentation built on June 7, 2019, 8:51 a.m.