context("basic ct") skip_if_not(utils::packageVersion("sf") >= "0.5.6") library(sf) nc <- read_sf(system.file("shape/nc.shp", package = "sf"), quiet = TRUE) nc_triangles <- ct_triangulate(nc) ## simple freedoms plot.sf <- function(x, ...) plot(st_geometry(x), ..., col = "transparent") test_that("ct works", { expect_that(nc_triangles, is_a("sf")) expect_that(as.character(unique(st_geometry_type(nc_triangles))), equals("GEOMETRYCOLLECTION")) }) test_that("sf, sfc, sfg all return as input", { expect_that(ct_triangulate(nc[1, ]), is_a(class(nc[1, ]))) expect_that(ct_triangulate(nc[1:4, ]), is_a(class(nc[1:4, ]))) expect_that(ct_triangulate(st_geometry(nc[1, ])), is_a(class(st_geometry(nc[1, ])))) expect_that(ct_triangulate(st_geometry(nc[1:4, ])), is_a(class(st_geometry(nc[1:4, ])))) ## drop to a geometry expect_that(ct_triangulate(st_geometry(nc[1, ])[[1]]), is_a(class(st_geometry(nc[1, ])[[1]]))) } ) is_empty <- function(x, ...) { UseMethod("is_empty") } is_empty.sfg <- function(x, ...) !length(x) > 0 is_empty.sfc <- function(x, ...) unlist(lapply(x, is_empty)) is_empty.sf <- function(x, ...) is_empty(st_geometry(x)) test_that("different inputs work", { ## replace with st_cast when 0.2.8 comes out #st_geometry(nc) <- st_sfc(lapply(st_geometry(nc), function(x) st_multipoint(do.call(rbind, unlist(x, recursive = FALSE)))), crs = st_crs(nc)) nc_mpoint <- st_cast(nc, "MULTIPOINT") expect_that(ct_triangulate(nc_mpoint), is_a("sf")) ## change in January 2017 #expect_warning(ml_nc <- st_cast(nc, "MULTILINESTRING"), "repeating") ml_nc <- st_cast(nc, "MULTILINESTRING") ml_nc %>% expect_s3_class("sf") %>% ct_triangulate() %>% expect_s3_class("sf") lstri <- st_linestring(st_geometry(ml_nc)[[4]][[1]]) %>% ct_triangulate() expect_false(lstri %>% is_empty()) ## beware that cast just joins all the paths together ## it doesn't drop the first ## change in January 2017 expect_error(st_cast(nc, "LINESTRING"), "use smaller steps") l_nc <- expect_warning(st_cast(st_cast(nc, "MULTILINESTRING"), "LINESTRING"), "repeating attributes") l_nc %>% expect_s3_class("sf") %>% ct_triangulate() %>% expect_s3_class("sf") ## but to POLYGON it copies out the extra ones expect_warning(p_nc <- st_cast(nc, "POLYGON"), "repeating") p_nc %>% expect_s3_class("sf") %>% ct_triangulate() %>% expect_s3_class("sf") ## expect_warning(pp_nc <- st_cast(nc, "POINT"), "repeating") pp_tri <- pp_nc %>% expect_s3_class("sf") %>% ct_triangulate() %>% expect_s3_class("sf") expect_that(nrow(pp_tri), equals(1L)) }) # ## from ?st_geometrycollection g1 <- c(st_geometrycollection(list(st_point(1:2), st_linestring(matrix(1:6,3)))), st_geometrycollection(list(st_multilinestring(list(matrix(11:16,3)))))) g2 <- c(st_geometrycollection(list(st_point(1:2), st_linestring(matrix(1:6,3)))), st_multilinestring(list(matrix(11:16,3))), st_point(5:6), st_geometrycollection(list(st_point(10:11)))) test_that("we can triangulate a geometrycollection", { #st_geometry(nc_triangles) %>% ct_triangulate() %>% plot(col = "transparent") # #expect_that(st_geometry(nc_triangles) %>% ct_triangulate() %>% is_empty() %>% all(), is_true()) expect_that(ct_triangulate(st_geometry(nc_triangles[1:5, ])), is_a("sfc_GEOMETRYCOLLECTION") ) #expect_that(st_geometry(nc_triangles)[[1]] %>% ct_triangulate() %>% is_empty(), is_true()) expect_false(st_geometry(nc_triangles)[[1]] %>% ct_triangulate() %>% is_empty()) # ## give it one of the polygons from the geometrycollection and it's fine expect_false(st_geometry(nc_triangles)[[1]][[1]] %>% ct_triangulate(a = .00001) %>% is_empty()) # expect_warning(ct_triangulate(g1), "returning empty") }) # # # data("sfzoo", package= "sc") # data("sfgc", package= "sc") test_that("all POINT with args works", { library(sf) library(sfdct) set.seed(1) n <- 150 a <- ct_triangulate(st_as_sf(data.frame(x = rnorm(n), y = rnorm(n)), coords = c("x", "y")), a = 0.1, D = TRUE) expect_that(a, is_a("sf")) } ) #lapply(sfzoo, ct_triangulate) #ct_triangulate(sfgc) %>% plot(col = "transparent")