Nothing
tests/testthat/test-sfc_multipolygon.R
In sfheaders: Converts Between R Objects and Simple Feature Objects
context("sfc_multipolygon")
test_that("sfc_multipolygon works after refactoring issue14",{
is_multipolygon <- function(x) {
y <- sapply( x, function(y) is.list( unclass( y ) ) )
z <- sapply( x, function(y) attr( y, "class")[2] == "MULTIPOLYGON")
return( all(y) & all(z))
}
m <- matrix(1:9, ncol = 3)
res <- sfheaders:::rcpp_sfc_multipolygon( m , c(0L, 1L), NULL, NULL, NULL, "", FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
m <- cbind(m, c(1L,1L,2L))
res <- sfheaders:::rcpp_sfc_multipolygon( m , c(0L, 1L), 3L, NULL, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
m <- cbind(m, c(1L,1L,2L))
m <- cbind(m, c(1L,1L,1L))
res <- sfheaders:::rcpp_sfc_multipolygon( m , c(0L, 1L), 3L, 4L, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
m <- cbind(m, c(1L,1L,2L))
m <- cbind(m, c(1L,1L,1L))
m <- cbind(m, c(1L,1L,1L))
res <- sfheaders:::rcpp_sfc_multipolygon( m , c(0L, 1L), 3L, 4L, 5L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
m <- cbind(m, c(1,1,2))
m <- cbind(m, c(1,1,1))
m <- cbind(m, c(1,1,1))
res <- sfheaders:::rcpp_sfc_multipolygon( m , c(0L, 1L), 3L, 4L, 5L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
df <- as.data.frame( m )
m <- as.matrix( df )
res <- sfheaders:::rcpp_sfc_multipolygon( m , c("V1","V2"), NULL, NULL, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
m <- cbind(m, c(1L,1L,2L))
df <- as.data.frame( m )
m <- as.matrix( df )
res <- sfheaders:::rcpp_sfc_multipolygon( m , c("V1","V2"), "V4", NULL, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
m <- cbind(m, c(1,1,2))
m <- cbind(m, c(1,1,1))
m <- cbind(m, c(1,1,1))
df <- as.data.frame(m)
m <- as.matrix(m)
res <- sfheaders:::rcpp_sfc_multipolygon( m , c("V1", "V2"), "V3","V4","V5", "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
df <- data.frame(
mp_id = c(1,1,1,1,2,2,2,2)
#, p_id = c(1,1,1,1,2,2,2,2)
, l_id = c(1,1,1,1,1,1,1,1)
, x = c(1,2,3,1,4,5,6,4)
, y = c(1,2,3,1,4,5,6,4)
)
res <- sfheaders:::rcpp_sfc_multipolygon( df, NULL, NULL, NULL, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
df <- data.frame(
mp_id = c(1,1,1,1,2,2,2,2)
, p_id = c(1,1,1,1,2,2,2,2)
, l_id = c(1,1,1,1,1,1,1,1)
, x = c(1.1,2,3,1,4,5,6,4)
, y = c(1,2,3,1,4,5,6,4)
)
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), NULL, NULL, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), 0L, NULL, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 2 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), NULL, 1L, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), NULL, NULL, 2L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
m <- as.matrix( df )
res <- sfheaders:::rcpp_sfc_multipolygon( m, c(3L,4L), NULL, NULL, 2L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), 0L, NULL, 2L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 2 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), NULL, 1L, 2L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
m <- as.matrix( df )
res <- sfheaders:::rcpp_sfc_multipolygon( m, c(3L,4L), NULL, 1L, 2L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), 0L, 1L, 2L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 2 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), c(2L), c(0L), c(1L), "", close = FALSE)
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
})
test_that("data.frame with non-numeric id columns work",{
is_multipolygon <- function(x) {
y <- sapply( x, function(y) is.list( unclass( y ) ) )
z <- sapply( x, function(y) attr( y, "class")[2] == "MULTIPOLYGON")
return( all(y) & all(z))
}
df <- data.frame(
p_id = letters[c(1,1,1,1,2,2,2,2)]
, l_id = c(1,1,1,1,1,1,1,1)
, x = c(1,2,3,1,4,5,6,4)
, y = c(1,2,3,1,4,5,6,4)
, stringsAsFactors = F
)
res <- sfheaders::sfc_multipolygon(
obj = df
, x = "x"
, y = "y"
, multipolygon_id = "p_id"
)
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
df <- data.frame(
mp_id = letters[c(1,1,2,2,3,3,3,3)]
, p_id = letters[c(1,1,1,1,2,2,2,2)]
, l_id = letters[c(1,1,1,1,1,1,1,1)]
, x = c(1,2,3,1,4,5,6,4)
, y = c(1,2,3,1,4,5,6,4)
, stringsAsFactors = F
)
res <- sfheaders::sfc_multipolygon(
obj = df
, x = "x"
, y = "y"
, multipolygon_id = "mp_id"
, polygon_id = "p_id"
, close = FALSE
)
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
df <- data.frame(
mp_id = letters[c(1,1,2,2,3,3,3,3)]
, p_id = letters[c(1,1,1,1,2,2,2,2)]
, l_id = letters[c(1,2,1,1,1,1,2,2)]
, x = c(1,2,3,1,4,5,6,4)
, y = c(1,2,3,1,4,5,6,4)
, stringsAsFactors = F
)
res <- sfheaders::sfc_multipolygon(
obj = df
, x = "x"
, y = "y"
, multipolygon_id = "mp_id"
, polygon_id = "p_id"
, linestring_id = "l_id"
, close = FALSE
)
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
})
## issue 61
test_that("correct columsn returned - issue 61",{
df <- data.frame(
mp_id = c( rep(1, 14), rep(2, 5) )
, p_id = c( rep(1, 19 ) )
, l_id = c( rep(1, 8), rep(2, 6), rep(1, 5))
, x = c(0,0,0.75,1,0.5,0.8,0.69,0,0.2,0.5,0.5,0.3,0.2,0.2,0.69,0.8,1.1,1.23,0.69)
, y = c(0,1,1,0.8,0.7,0.6,0,0,0.2,0.2,0.4,0.6,0.4,0.2,0,0.6,0.63,0.3,0)
)
sf <- sf_multipolygon(
obj = df,
multipolygon_id = "mp_id",
polygon_id = "p_id",
linestring_id = "l_id",
x = "x",
y = "y"
)
res <- sf_to_df( sf )
expect_equal( res$multipolygon_id, df$mp_id )
expect_equal( res$polygon_id, df$p_id )
expect_equal( res$linestring_id, df$l_id )
})
test_that("vectorised version works",{
is_multipolygon <- function(x) {
y <- sapply( x, function(y) is.list( unclass( y ) ) )
z <- sapply( x, function(y) attr( y, "class")[2] == "MULTIPOLYGON")
return( all(y) & all(z))
}
m1 <- matrix(1:12, ncol = 3)
m2 <- matrix(1:12, ncol = 3)
lst <- list( m1, m2 )
res <- sfheaders:::rcpp_sfc_multipolygons( lst, "", FALSE )
expect_true( all( sapply( res, is_multipolygon ) ) )
})
Try the sfheaders package in your browser
Any scripts or data that you put into this service are public.
sfheaders documentation built on July 9, 2023, 7:41 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
context("sfc_multipolygon")
test_that("sfc_multipolygon works after refactoring issue14",{
is_multipolygon <- function(x) {
y <- sapply( x, function(y) is.list( unclass( y ) ) )
z <- sapply( x, function(y) attr( y, "class")[2] == "MULTIPOLYGON")
return( all(y) & all(z))
}
m <- matrix(1:9, ncol = 3)
res <- sfheaders:::rcpp_sfc_multipolygon( m , c(0L, 1L), NULL, NULL, NULL, "", FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
m <- cbind(m, c(1L,1L,2L))
res <- sfheaders:::rcpp_sfc_multipolygon( m , c(0L, 1L), 3L, NULL, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
m <- cbind(m, c(1L,1L,2L))
m <- cbind(m, c(1L,1L,1L))
res <- sfheaders:::rcpp_sfc_multipolygon( m , c(0L, 1L), 3L, 4L, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
m <- cbind(m, c(1L,1L,2L))
m <- cbind(m, c(1L,1L,1L))
m <- cbind(m, c(1L,1L,1L))
res <- sfheaders:::rcpp_sfc_multipolygon( m , c(0L, 1L), 3L, 4L, 5L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
m <- cbind(m, c(1,1,2))
m <- cbind(m, c(1,1,1))
m <- cbind(m, c(1,1,1))
res <- sfheaders:::rcpp_sfc_multipolygon( m , c(0L, 1L), 3L, 4L, 5L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
df <- as.data.frame( m )
m <- as.matrix( df )
res <- sfheaders:::rcpp_sfc_multipolygon( m , c("V1","V2"), NULL, NULL, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
m <- cbind(m, c(1L,1L,2L))
df <- as.data.frame( m )
m <- as.matrix( df )
res <- sfheaders:::rcpp_sfc_multipolygon( m , c("V1","V2"), "V4", NULL, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
m <- matrix(1:9, ncol = 3)
m <- cbind(m, c(1,1,2))
m <- cbind(m, c(1,1,1))
m <- cbind(m, c(1,1,1))
df <- as.data.frame(m)
m <- as.matrix(m)
res <- sfheaders:::rcpp_sfc_multipolygon( m , c("V1", "V2"), "V3","V4","V5", "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
df <- data.frame(
mp_id = c(1,1,1,1,2,2,2,2)
#, p_id = c(1,1,1,1,2,2,2,2)
, l_id = c(1,1,1,1,1,1,1,1)
, x = c(1,2,3,1,4,5,6,4)
, y = c(1,2,3,1,4,5,6,4)
)
res <- sfheaders:::rcpp_sfc_multipolygon( df, NULL, NULL, NULL, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
df <- data.frame(
mp_id = c(1,1,1,1,2,2,2,2)
, p_id = c(1,1,1,1,2,2,2,2)
, l_id = c(1,1,1,1,1,1,1,1)
, x = c(1.1,2,3,1,4,5,6,4)
, y = c(1,2,3,1,4,5,6,4)
)
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), NULL, NULL, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), 0L, NULL, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 2 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), NULL, 1L, NULL, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), NULL, NULL, 2L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
m <- as.matrix( df )
res <- sfheaders:::rcpp_sfc_multipolygon( m, c(3L,4L), NULL, NULL, 2L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), 0L, NULL, 2L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 2 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), NULL, 1L, 2L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
m <- as.matrix( df )
res <- sfheaders:::rcpp_sfc_multipolygon( m, c(3L,4L), NULL, 1L, 2L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), 0L, 1L, 2L, "", close = FALSE )
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 2 )
res <- sfheaders:::rcpp_sfc_multipolygon( df, c(3L,4L), c(2L), c(0L), c(1L), "", close = FALSE)
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
expect_true( length( res ) == 1 )
})
test_that("data.frame with non-numeric id columns work",{
is_multipolygon <- function(x) {
y <- sapply( x, function(y) is.list( unclass( y ) ) )
z <- sapply( x, function(y) attr( y, "class")[2] == "MULTIPOLYGON")
return( all(y) & all(z))
}
df <- data.frame(
p_id = letters[c(1,1,1,1,2,2,2,2)]
, l_id = c(1,1,1,1,1,1,1,1)
, x = c(1,2,3,1,4,5,6,4)
, y = c(1,2,3,1,4,5,6,4)
, stringsAsFactors = F
)
res <- sfheaders::sfc_multipolygon(
obj = df
, x = "x"
, y = "y"
, multipolygon_id = "p_id"
)
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
df <- data.frame(
mp_id = letters[c(1,1,2,2,3,3,3,3)]
, p_id = letters[c(1,1,1,1,2,2,2,2)]
, l_id = letters[c(1,1,1,1,1,1,1,1)]
, x = c(1,2,3,1,4,5,6,4)
, y = c(1,2,3,1,4,5,6,4)
, stringsAsFactors = F
)
res <- sfheaders::sfc_multipolygon(
obj = df
, x = "x"
, y = "y"
, multipolygon_id = "mp_id"
, polygon_id = "p_id"
, close = FALSE
)
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
df <- data.frame(
mp_id = letters[c(1,1,2,2,3,3,3,3)]
, p_id = letters[c(1,1,1,1,2,2,2,2)]
, l_id = letters[c(1,2,1,1,1,1,2,2)]
, x = c(1,2,3,1,4,5,6,4)
, y = c(1,2,3,1,4,5,6,4)
, stringsAsFactors = F
)
res <- sfheaders::sfc_multipolygon(
obj = df
, x = "x"
, y = "y"
, multipolygon_id = "mp_id"
, polygon_id = "p_id"
, linestring_id = "l_id"
, close = FALSE
)
expect_equal( attr( res, "class" ), c("sfc_MULTIPOLYGON", "sfc") )
expect_true( is_multipolygon( res ) )
})
## issue 61
test_that("correct columsn returned - issue 61",{
df <- data.frame(
mp_id = c( rep(1, 14), rep(2, 5) )
, p_id = c( rep(1, 19 ) )
, l_id = c( rep(1, 8), rep(2, 6), rep(1, 5))
, x = c(0,0,0.75,1,0.5,0.8,0.69,0,0.2,0.5,0.5,0.3,0.2,0.2,0.69,0.8,1.1,1.23,0.69)
, y = c(0,1,1,0.8,0.7,0.6,0,0,0.2,0.2,0.4,0.6,0.4,0.2,0,0.6,0.63,0.3,0)
)
sf <- sf_multipolygon(
obj = df,
multipolygon_id = "mp_id",
polygon_id = "p_id",
linestring_id = "l_id",
x = "x",
y = "y"
)
res <- sf_to_df( sf )
expect_equal( res$multipolygon_id, df$mp_id )
expect_equal( res$polygon_id, df$p_id )
expect_equal( res$linestring_id, df$l_id )
})
test_that("vectorised version works",{
is_multipolygon <- function(x) {
y <- sapply( x, function(y) is.list( unclass( y ) ) )
z <- sapply( x, function(y) attr( y, "class")[2] == "MULTIPOLYGON")
return( all(y) & all(z))
}
m1 <- matrix(1:12, ncol = 3)
m2 <- matrix(1:12, ncol = 3)
lst <- list( m1, m2 )
res <- sfheaders:::rcpp_sfc_multipolygons( lst, "", FALSE )
expect_true( all( sapply( res, is_multipolygon ) ) )
})
Try the sfheaders package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.