context("to_df") test_that("sfc_to_df constructs data.frames",{ x <- matrix( c(11:16), ncol = 2 ) pt <- sfc_point( x ) df_pt <- sfheaders:::rcpp_sfc_to_df( pt ) expect_true( ncol( df_pt ) == 4 ) expect_equal( df_pt$x, x[,1] ) expect_equal( df_pt$y, x[,2] ) x <- matrix( c(1:8), ncol = 2 ) mpt <- sfc_multipoint( x ) df_mpt <- sfheaders:::rcpp_sfc_to_df( mpt ) expect_equal( names( df_mpt ), c("sfg_id", "multipoint_id", "x", "y" ) ) expect_equal( df_mpt$x, x[,1] ) expect_equal( df_mpt$y, x[,2] ) x <- data.frame( id = c(1,1,1,2,2), x = 1:5, y = 5:1 ) ls <- sfc_linestring( x, linestring_id = "id" ) df_ls <- sfheaders:::rcpp_sfc_to_df( ls ) expect_equal( names( df_ls ), c("sfg_id", "linestring_id", "x", "y" ) ) expect_equal( df_ls$x, x$x ) expect_equal( df_ls$y, x$y ) x <- data.frame( ml_id = c(1,1,1,1,1,1,1,1,2,2,2,2,2) , l_id = c(1,1,1,2,2,3,3,3,1,1,1,2,2) , x = rnorm(13) , y = rnorm(13) , z = rnorm(13) , m = rnorm(13) ) mls <- sfc_multilinestring( obj = x, x = "x", y = "y") df_mls <- sfc_to_df( mls ) expect_equal( names( df_mls ), c("sfg_id", "multilinestring_id", "linestring_id", "x", "y" ) ) expect_equal( df_mls$x, x$x ) expect_equal( df_mls$y, x$y ) x <- data.frame( ml_id = c(1,1,1,1,1,1,1,1,1,2,2,2,2,2,2) , l_id = c(1,1,1,2,2,2,3,3,3,1,1,1,2,2,2) , x = rnorm(15) , y = rnorm(15) , z = rnorm(15) , m = rnorm(15) ) p <- sfc_polygon( obj = x, x = "x", y = "y", close = FALSE) df_p <- sfc_to_df( p ) expect_equal( names( df_p ), c("sfg_id", "polygon_id", "linestring_id", "x", "y" ) ) expect_equal( df_p$x, x$x ) expect_equal( df_p$y, x$y ) x <- data.frame( id1 = c(1,1,1,1,1,1,1,1,1,1) , id2 = c(1,1,1,1,1,2,2,2,2,2) , x = c(0,0,1,1,0,1,1,2,2,1) , y = c(0,1,1,0,0,1,2,2,1,1) ) mp <- sfc_multipolygon( x, multipolygon_id = "id1", polygon_id = "id2") df_mp <- sfc_to_df( mp ) expect_equal( names( df_mp ), c("sfg_id", "multipolygon_id", "polygon_id", "linestring_id", "x", "y" ) ) expect_equal( df_mp$x, x$x ) expect_equal( df_mp$y, x$y ) }) test_that("sfg objectse convereted to data.frames", { df1 <- data.frame( id = c(1,1,1,2,2,2) , x = c(1,1,1,2,2,2) , y = c(3,3,3,4,4,4) ) pt <- sfheaders:::sfg_point(c(1,2)) mpt <- sfheaders:::sfg_multipoint( df1, x = "x", y = "y" ) ls <- sfheaders::sfg_linestring(df1, x = "x", y = "y") mls <- sfheaders::sfg_multilinestring(obj = df1, linestring_id = "id") m <- cbind( matrix( 1:24, ncol = 2 ), c(rep(1, 6), rep(2, 6) ) ) p <- sfg_polygon( obj = m, x = 1, y = 2, linestring_id = 3, close = FALSE ) df2 <- data.frame( polygon_id = c(rep(1, 5), rep(2, 10)) , line_id = c(rep(1, 10), rep(2, 5)) , x = c(0,0,1,1,0,2,2,5,5,2,3,3,4,4,3) , y = c(0,1,1,0,0,2,5,5,2,2,3,4,4,3,3) , z = c(1) , m = c(1) ) mpz <- sfg_multipolygon( df2, x = "x", y = "y", z = "z" , polygon_id = "polygon_id", linestring_id = "line_id" ) mpzm <- sfg_multipolygon( df2, x = "x", y = "y", z = "z", m = "m" , polygon_id = "polygon_id", linestring_id = "line_id" ) df_pt <- sfheaders::sfg_to_df( pt ) expect_equal( df_pt$x, 1 ) expect_equal( df_pt$y, 2 ) df_mpt <- sfheaders::sfg_to_df( mpt ) expect_equal( df_mpt$x, df1$x ) expect_equal( df_mpt$y, df1$y ) df_ls <- sfheaders::sfg_to_df( ls ) expect_equal( df_ls$x, df1$x ) expect_equal( df_ls$y, df1$y ) df_mls <- sfheaders::sfg_to_df( mls ) expect_equal( df_mls$x, df1$x ) expect_equal( df_mls$y, df1$y ) df_p <- sfheaders::sfg_to_df( p ) expect_equal( df_p$x, m[,1] ) expect_equal( df_p$y, m[,2] ) df_mp <- sfheaders::sfg_to_df( mpz ) expect_equal( df_mp$x, df2$x ) expect_equal( df_mp$y, df2$y ) df_mpzm <- sfheaders::sfg_to_df( mpzm ) expect_equal( df_mpzm$z, df2$z ) expect_equal( df_mpzm$m, df2$m ) expect_true( inherits( df_pt, "data.frame") ) expect_true( inherits( df_mpt, "data.frame") ) expect_true( inherits( df_ls, "data.frame") ) expect_true( inherits( df_mls, "data.frame") ) expect_true( inherits( df_p, "data.frame") ) expect_true( inherits( df_mp, "data.frame") ) ## x,y,z names expect_equal( names( df_mp ), c("polygon_id", "linestring_id", "x", "y", "z") ) ## round-trip res <- sfheaders::sfg_multipolygon( df_mp , x = "x" , y = "y" , z = "z" , polygon_id = "polygon_id" , linestring_id = "linestring_id" ) expect_equal( mpz, res ) }) test_that("different data.frame columns supported",{ df <- data.frame( id = 1L , dte = as.Date("2020-01-01") , psx = as.POSIXct("2020-01-01 00:00:01") , fct = "a" , num = 1.5 , int = 1L , cplx = as.complex(1.0) , rw = as.raw(1.0) , lgl = as.logical(T) , x = 1 , y = 2 , stringsAsFactors = F ) sf <- sfheaders::sf_point( obj = df, x = "x", y = "y" ) sf$id <- 1L sf <- base::merge.data.frame( x = sf , y = df[, setdiff(names(df), c("x","y"))] , by = "id" ) expect_error( sfheaders::sf_to_df( sf, fill = TRUE ) , "sfheaders - sf_column not found" ) sf$geometry <- sfheaders::sfc_point( df[, c("x","y")]) attr(sf, "class") <- c("sf", "data.frame") attr(sf, "sf_column") <- "geometry" res <- sfheaders::sf_to_df( sf, fill = TRUE ) test_cols <- names( df ) expect_equal( res[, test_cols ] , df[, test_cols ] ) }) test_that("different XYZM dimensions work",{ x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_point( x, x = 1, y = 2, z = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 5 ) expect_true( "z" %in% names(res) ) expect_false( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_point( x, x = 1, y = 2, z = 3, m = 4 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 6 ) expect_true( "z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) x[1,1] <- 1.1 sfc <- sfc_point( x, x = 1, y = 2, z = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 5 ) expect_true( "z" %in% names(res) ) expect_false( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) x[1,1] <- 1.1 sfc <- sfc_point( x, x = 1, y = 2, z = 3, m = 4 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 6 ) expect_true( "z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_multipoint( x, x = 1, y = 2, z = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 5 ) expect_true( "z" %in% names(res) ) expect_false( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_multipoint( x, x = 1, y = 2, z = 3, m = 4 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 6 ) expect_true( "z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_linestring( x, x = 1, y = 2, z = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 5 ) expect_true( "z" %in% names(res) ) expect_false( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_linestring( x, x = 1, y = 2, z = 3, m = 4 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 6 ) expect_true( "z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_multilinestring( x, x = 1, y = 2, z = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 6 ) expect_true( "z" %in% names(res) ) expect_false( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_multilinestring( x, x = 1, y = 2, z = 3, m = 4 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 7 ) expect_true( "z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_polygon( x, x = 1, y = 2, z = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 6 ) expect_true( "z" %in% names(res) ) expect_false( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_polygon( x, x = 1, y = 2, z = 3, m = 4 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 7 ) expect_true( "z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_multipolygon( x, x = 1, y = 2, z = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 7 ) expect_true( "z" %in% names(res) ) expect_false( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_multipolygon( x, x = 1, y = 2, z = 3, m = 4 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 8 ) expect_true( "z" %in% names(res) ) expect_true( "m" %in% names(res) ) }) test_that("XYM dimension works",{ x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_point( x, x = 1, y = 2, m = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 5 ) expect_false( "z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_point( x, x = 1, y = 2, m = 4 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 5 ) expect_true( !"z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) x[1,1] <- 1.1 sfc <- sfc_point( x, x = 1, y = 2, m = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 5 ) expect_true( !"z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) x[1,1] <- 1.1 sfc <- sfc_point( x, x = 1, y = 2, m = 4 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 5 ) expect_true( !"z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_multipoint( x, x = 1, y = 2, m = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 5 ) expect_true( !"z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_linestring( x, x = 1, y = 2, z = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 5 ) expect_true( "z" %in% names(res) ) expect_false( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_linestring( x, x = 1, y = 2, z = 3, m = 4 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 6 ) expect_true( "z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_multilinestring( x, x = 1, y = 2, m = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 6 ) expect_true( !"z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_multilinestring( x, x = 1, y = 2, m = 4 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 6 ) expect_true( !"z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_polygon( x, x = 1, y = 2, m = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 6 ) expect_true( !"z" %in% names(res) ) expect_true( "m" %in% names(res) ) x <- matrix( c(1:16), ncol = 4 ) sfc <- sfc_multipolygon( x, x = 1, y = 2, m = 3 ) res <- sfheaders:::rcpp_sfc_to_df( sfc ) expect_true( ncol( res ) == 7 ) expect_true( !"z" %in% names(res) ) expect_true( "m" %in% names(res) ) }) ## issue 58 test_that("list-columns get expanded",{ df <- data.frame( id = c(1,1,2,2) , x = 1:4 , y = 4:1 ) l1 <- sfheaders::sfc_linestring( df, linestring_id = "id" ) l2 <- sfheaders::sfc_linestring( df, linestring_id = "id" ) df <- data.frame( x = c(1,2) ) df$l1 <- l1 df$l2 <- l2 attr( df, "class" ) <- c("sf", "data.frame") attr( df, "sf_column" ) <- c("l1") res <- sfheaders::sf_to_df( df, fill = TRUE ) sfc <- res$l2 expect_true( length( sfc ) == 4 ) expect_equal( sfc[[1]], sfc[[2]] ) expect_equal( sfc[[3]], sfc[[4]] ) }) test_that("subsetted sf object converts to df",{ sf <- sf_linestring( obj = data.frame( id = c(1,1,2,2) , x = 1:4 , y = 4:1 ) , linestring_id = "id" ) df1 <- sf_to_df( sf[1, ], fill = TRUE ) df2 <- sf_to_df( sf[2, ], fill = TRUE ) expect_true(all(df1$id == 1)) expect_true(all(df2$id == 2)) })