tests/testthat/test-cast.R

In sfheaders: Converts Between R Objects and Simple Feature Objects

context("cast")

test_that("cast to sfc_POINT", {

  df <- data.frame(
    id1 = c(1,1,1,1,1,1,1,1,2,2,2,2)
    , id2 = c(1,1,1,1,2,2,2,2,1,1,1,1)
    , x = c(0,0,1,1,1,1,2,2,3,4,4,3)
    , y = c(0,1,1,0,1,2,2,1,3,3,4,4)
  )

  pt <- sfc_point(obj = df, x = "x", y = "y", z = "id1")
  mpt <- sfc_multipoint(obj = df, x = "x", y = "y", multipoint_id = "id1")
  ls <- sfc_linestring(obj = df, x = "x", y = "y", linestring_id = "id1")
  mls <- sfc_multilinestring(obj = df, x = "x", y = "y", multilinestring_id = "id1")
  p <- sfc_polygon(obj = df, x = "x", y = "y", polygon_id = "id1", linestring_id = "id2", close = FALSE )
  mp <- sfc_multipolygon(obj = df, x = "x", y = "y", multipolygon_id = "id1", linestring_id = "id2", close = FALSE )

  sfc_casted <- function( sfc, cast_to ) {
    cls <- attr( sfc, "class")
    return( cls[1] == paste0("sfc_", cast_to) )
  }

  sfg_casted <- function( sfc, cast_to ) {
    res <- unique( sapply( sfc, function(x) attr(x, "class")[2] ) )
    return( length( res ) == 1 & cast_to == res )
  }

  has_round_tripped <- function( df_orig, df_res ) {
    all( df_res[["x"]] == df_orig[["x"]] ) &
      all( df_res[["y"]] == df_orig[["y"]] )
  }

  cast_to <- "POINT"
  res <- sfc_cast( pt, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mpt, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( ls, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mls, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( p, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mp, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

})


test_that("cast to sfc_MULTIPOINT", {

  df <- data.frame(
    id1 = c(1,1,1,1,1,1,1,1,2,2,2,2)
    , id2 = c(1,1,1,1,2,2,2,2,1,1,1,1)
    , x = c(0,0,1,1,1,1,2,2,3,4,4,3)
    , y = c(0,1,1,0,1,2,2,1,3,3,4,4)
  )

  pt <- sfc_point(obj = df, x = "x", y = "y")
  mpt <- sfc_multipoint(obj = df, x = "x", y = "y", multipoint_id = "id1")
  ls <- sfc_linestring(obj = df, x = "x", y = "y", linestring_id = "id1")
  mls <- sfc_multilinestring(obj = df, x = "x", y = "y", multilinestring_id = "id1")
  p <- sfc_polygon(obj = df, x = "x", y = "y", polygon_id = "id1", linestring_id = "id2", close = FALSE )
  mp <- sfc_multipolygon(obj = df, x = "x", y = "y", multipolygon_id = "id1", linestring_id = "id2", close = FALSE )

  sfc_casted <- function( sfc, cast_to ) {
    cls <- attr( sfc, "class")
    return( cls[1] == paste0("sfc_", cast_to) )
  }

  sfg_casted <- function( sfc, cast_to ) {
    res <- unique( sapply( sfc, function(x) attr(x, "class")[2] ) )
    return( length( res ) == 1 & cast_to == res )
  }

  has_round_tripped <- function( df_orig, df_res ) {
    all( df_res[["x"]] == df_orig[["x"]] ) &
      all( df_res[["y"]] == df_orig[["y"]] )
  }

  cast_to <- "MULTIPOINT"
  res <- sfc_cast( pt, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mpt, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( ls, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mls, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( p, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mp, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

})


test_that("cast to sfc_LINESTRING", {

  df <- data.frame(
    id1 = c(1,1,1,1,1,1,1,1,2,2,2,2)
    , id2 = c(1,1,1,1,2,2,2,2,1,1,1,1)
    , x = c(0,0,1,1,1,1,2,2,3,4,4,3)
    , y = c(0,1,1,0,1,2,2,1,3,3,4,4)
  )

  pt <- sfc_point(obj = df, x = "x", y = "y")
  mpt <- sfc_multipoint(obj = df, x = "x", y = "y", multipoint_id = "id1")
  ls <- sfc_linestring(obj = df, x = "x", y = "y", linestring_id = "id1")
  mls <- sfc_multilinestring(obj = df, x = "x", y = "y", multilinestring_id = "id1")
  p <- sfc_polygon(obj = df, x = "x", y = "y", polygon_id = "id1", linestring_id = "id2", close = FALSE )
  mp <- sfc_multipolygon(obj = df, x = "x", y = "y", multipolygon_id = "id1", linestring_id = "id2", close = FALSE )

  sfc_casted <- function( sfc, cast_to ) {
    cls <- attr( sfc, "class")
    return( cls[1] == paste0("sfc_", cast_to) )
  }

  sfg_casted <- function( sfc, cast_to ) {
    res <- unique( sapply( sfc, function(x) attr(x, "class")[2] ) )
    return( length( res ) == 1 & cast_to == res )
  }

  has_round_tripped <- function( df_orig, df_res ) {
    all( df_res[["x"]] == df_orig[["x"]] ) &
      all( df_res[["y"]] == df_orig[["y"]] )
  }

  cast_to <- "LINESTRING"
  res <- sfc_cast( pt, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mpt, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( ls, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mls, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( p, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mp, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

})


test_that("cast to sfc_MULTILINESTRING", {

  df <- data.frame(
    id1 = c(1,1,1,1,1,1,1,1,2,2,2,2)
    , id2 = c(1,1,1,1,2,2,2,2,1,1,1,1)
    , x = c(0,0,1,1,1,1,2,2,3,4,4,3)
    , y = c(0,1,1,0,1,2,2,1,3,3,4,4)
  )

  pt <- sfc_point(obj = df, x = "x", y = "y")
  mpt <- sfc_multipoint(obj = df, x = "x", y = "y", multipoint_id = "id1")
  ls <- sfc_linestring(obj = df, x = "x", y = "y", linestring_id = "id1")
  mls <- sfc_multilinestring(obj = df, x = "x", y = "y", multilinestring_id = "id1")
  p <- sfc_polygon(obj = df, x = "x", y = "y", polygon_id = "id1", linestring_id = "id2", close = FALSE )
  mp <- sfc_multipolygon(obj = df, x = "x", y = "y", multipolygon_id = "id1", linestring_id = "id2", close = FALSE )

  sfc_casted <- function( sfc, cast_to ) {
    cls <- attr( sfc, "class")
    return( cls[1] == paste0("sfc_", cast_to) )
  }

  sfg_casted <- function( sfc, cast_to ) {
    res <- unique( sapply( sfc, function(x) attr(x, "class")[2] ) )
    return( length( res ) == 1 & cast_to == res )
  }

  has_round_tripped <- function( df_orig, df_res ) {
    all( df_res[["x"]] == df_orig[["x"]] ) &
      all( df_res[["y"]] == df_orig[["y"]] )
  }

  cast_to <- "MULTILINESTRING"
  res <- sfc_cast( pt, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mpt, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( ls, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mls, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( p, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mp, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

})


test_that("cast to sfc_POLYGON", {

  df <- data.frame(
    id1 = c(1,1,1,1,1,1,1,1,2,2,2,2)
    , id2 = c(1,1,1,1,2,2,2,2,1,1,1,1)
    , x = c(0,0,1,1,1,1,2,2,3,4,4,3)
    , y = c(0,1,1,0,1,2,2,1,3,3,4,4)
  )

  pt <- sfc_point(obj = df, x = "x", y = "y")
  mpt <- sfc_multipoint(obj = df, x = "x", y = "y", multipoint_id = "id1")
  ls <- sfc_linestring(obj = df, x = "x", y = "y", linestring_id = "id1")
  mls <- sfc_multilinestring(obj = df, x = "x", y = "y", multilinestring_id = "id1")
  p <- sfc_polygon(obj = df, x = "x", y = "y", polygon_id = "id1", linestring_id = "id2", close = FALSE )
  mp <- sfc_multipolygon(obj = df, x = "x", y = "y", multipolygon_id = "id1", linestring_id = "id2", close = FALSE )

  sfc_casted <- function( sfc, cast_to ) {
    cls <- attr( sfc, "class")
    return( cls[1] == paste0("sfc_", cast_to) )
  }

  sfg_casted <- function( sfc, cast_to ) {
    res <- unique( sapply( sfc, function(x) attr(x, "class")[2] ) )
    return( length( res ) == 1 & cast_to == res )
  }

  has_round_tripped <- function( df_orig, df_res ) {
    all( df_res[["x"]] == df_orig[["x"]] ) &
      all( df_res[["y"]] == df_orig[["y"]] )
  }

  cast_to <- "POLYGON"
  expect_error(
    sfc_cast( pt, cast_to, close = FALSE )
    , "sfheaders - can't cast from POINT to POLYGON"
  )

  res <- sfc_cast( mpt, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( ls, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mls, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( p, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mp, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

})


test_that("cast to sfc_MULTIPOLYGON", {

  df <- data.frame(
    id1 = c(1,1,1,1,1,1,1,1,2,2,2,2)
    , id2 = c(1,1,1,1,2,2,2,2,1,1,1,1)
    , x = c(0,0,1,1,1,1,2,2,3,4,4,3)
    , y = c(0,1,1,0,1,2,2,1,3,3,4,4)
  )

  pt <- sfc_point(obj = df, x = "x", y = "y")
  mpt <- sfc_multipoint(obj = df, x = "x", y = "y", multipoint_id = "id1")
  ls <- sfc_linestring(obj = df, x = "x", y = "y", linestring_id = "id1")
  mls <- sfc_multilinestring(obj = df, x = "x", y = "y", multilinestring_id = "id1")
  p <- sfc_polygon(obj = df, x = "x", y = "y", polygon_id = "id1", linestring_id = "id2", close = FALSE )
  mp <- sfc_multipolygon(obj = df, x = "x", y = "y", multipolygon_id = "id1", linestring_id = "id2", close = FALSE )

  sfc_casted <- function( sfc, cast_to ) {
    cls <- attr( sfc, "class")
    return( cls[1] == paste0("sfc_", cast_to) )
  }

  sfg_casted <- function( sfc, cast_to ) {
    res <- unique( sapply( sfc, function(x) attr(x, "class")[2] ) )
    return( length( res ) == 1 & cast_to == res )
  }

  has_round_tripped <- function( df_orig, df_res ) {
    all( df_res[["x"]] == df_orig[["x"]] ) &
      all( df_res[["y"]] == df_orig[["y"]] )
  }

  cast_to <- "MULTIPOLYGON"
  expect_error(
    sfc_cast( pt, cast_to, close = FALSE )
    , "sfheaders - can't cast from POINT to MULTIPOLYGON"
  )

  res <- sfc_cast( mpt, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( ls, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mls, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( p, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

  res <- sfc_cast( mp, cast_to, close = FALSE )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

})


test_that("mixed sfc_GEOMETRY is casted",{

  df <- data.frame(
    id1 = c(1,1,1,1,1,1,1,1,2,2,2,2)
    , id2 = c(1,1,1,1,2,2,2,2,1,1,1,1)
    , x = c(0,0,1,1,1,1,2,2,3,4,4,3)
    , y = c(0,1,1,0,1,2,2,1,3,3,4,4)
  )

  # pt <- sf_point(obj = df, x = "x", y = "y")
  mpt <- sf_multipoint(obj = df, x = "x", y = "y", multipoint_id = "id1")
  ls <- sf_linestring(obj = df, x = "x", y = "y", linestring_id = "id1")
  mls <- sf_multilinestring(obj = df, x = "x", y = "y", multilinestring_id = "id1")
  # p <- sf_polygon(obj = df, x = "x", y = "y", polygon_id = "id1", linestring_id = "id2", close = FALSE )
  # mp <- sf_multipolygon(obj = df, x = "x", y = "y", multipolygon_id = "id1", linestring_id = "id2", close = FALSE )

  sf <- rbind( mpt, ls, mls )

  sfc_casted <- function( sfc, cast_to ) {
    cls <- attr( sfc, "class")
    return( cls[1] == paste0("sfc_", cast_to) )
  }

  sfg_casted <- function( sfc, cast_to ) {
    res <- unique( sapply( sfc, function(x) attr(x, "class")[2] ) )
    return( length( res ) == 1 & cast_to == res )
  }

  has_round_tripped <- function( df_orig, df_res ) {
    all( df_res[["x"]] == df_orig[["x"]] ) &
      all( df_res[["y"]] == df_orig[["y"]] )
  }

  cast_to <- "POINT"
  res <- sfc_cast( sf$geometry, cast_to )
  df_res <- sfheaders::sfc_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res, cast_to ) )
  expect_true( sfg_casted( res, cast_to ) )

})

test_that("sf objects are casted",{

  df <- data.frame(
    id1 = c(1,1,1,1,1,1,1,1,2,2,2,2)
    , id2 = c(1,1,1,1,2,2,2,2,1,1,1,1)
    , x = c(0,0,1,1,1,1,2,2,3,4,4,3)
    , y = c(0,1,1,0,1,2,2,1,3,3,4,4)
  )

  # pt <- sf_point(obj = df, x = "x", y = "y")
  mpt <- sf_multipoint(obj = df, x = "x", y = "y", multipoint_id = "id1")
  ls <- sf_linestring(obj = df, x = "x", y = "y", linestring_id = "id1")
  mls <- sf_multilinestring(obj = df, x = "x", y = "y", multilinestring_id = "id1")
  # p <- sf_polygon(obj = df, x = "x", y = "y", polygon_id = "id1", linestring_id = "id2", close = FALSE )
  # mp <- sf_multipolygon(obj = df, x = "x", y = "y", multipolygon_id = "id1", linestring_id = "id2", close = FALSE )

  sf <- rbind( mpt, ls, mls )

  sfc_casted <- function( sfc, cast_to ) {
    cls <- attr( sfc, "class")
    return( cls[1] == paste0("sfc_", cast_to) )
  }

  sfg_casted <- function( sfc, cast_to ) {
    res <- unique( sapply( sfc, function(x) attr(x, "class")[2] ) )
    return( length( res ) == 1 & cast_to == res )
  }

  has_round_tripped <- function( df_orig, df_res ) {
    all( df_res[["x"]] == df_orig[["x"]] ) &
      all( df_res[["y"]] == df_orig[["y"]] )
  }

  cast_to <- "POINT"
  res <- sf_cast( sf, cast_to )
  df_res <- sfheaders::sf_to_df( res )
  expect_true( has_round_tripped( df, df_res ))
  expect_true( sfc_casted( res$geometry, cast_to ) )
  expect_true( sfg_casted( res$geometry, cast_to ) )

  new_coords <- sfheaders:::rcpp_count_new_sfc_objects( sf$geometry, cast_to )

  expect_true( nrow( res ) == sum( new_coords ) )

})


test_that("errors handled",{

  df <- data.frame(
    id1 = c(1,1,1,1,1,1,1,1,2,2,2,2)
    , id2 = c(1,1,1,1,2,2,2,2,1,1,1,1)
    , x = c(0,0,1,1,1,1,2,2,3,4,4,3)
    , y = c(0,1,1,0,1,2,2,1,3,3,4,4)
  )

  pt <- sf_point(obj = df, x = "x", y = "y")

  expect_error(
    sfc_cast( pt, "POINTY" )
    , "sfheaders - I don't know the type of object you're trying to cast to"
  )

  expect_error(
    sf_cast( df, "POINT" )
    , "sfheaders - sf_column not found"
  )

})

test_that("sfc objects counted correctly",{

  df <- data.frame(
    id1 = c(1,1,1,1,1,1,1,1,2,2,2,2)
    , id2 = c(1,1,1,1,2,2,2,2,1,1,1,1)
    , x = c(0,0,1,1,1,1,2,2,3,4,4,3)
    , y = c(0,1,1,0,1,2,2,1,3,3,4,4)
  )

  mpt <- sfg_multipoint(obj = df, x = "x", y = "y")
  ls <- sfg_linestring(obj = df, x = "x", y = "y")
  mls <- sfg_multilinestring(obj = df, x = "x", y = "y", linestring_id = "id1")

  expect_equal(
    sfheaders:::rcpp_count_new_objects( mpt, "POINT" )
    , nrow( df )
  )

  expect_equal(
    sfheaders:::rcpp_count_new_objects( ls, "POINT" )
    , nrow( df )
  )

  expect_equal(
    sfheaders:::rcpp_count_new_objects( mls, "POINT" )
    , nrow( df )
  )

  expect_equal(
    sfheaders:::rcpp_count_new_objects( mpt, "MULTIPOLYGON" )
    , 1
  )

})

test_that("input objects not updated by-reference",{

  df <- data.frame(
    id1 = c(1,1,1,1,1,1,1,1,2,2,2,2)
    , id2 = c(1,1,1,1,2,2,2,2,1,1,1,1)
    , x = c(0,0,1,1,1,1,2,2,3,4,4,3)
    , y = c(0,1,1,0,1,2,2,1,3,3,4,4)
  )

  pt1 <- sfc_point(obj = df, x = "x", y = "y")
  mpt1 <- sfc_multipoint(obj = df, x = "x", y = "y", multipoint_id = "id1")
  ls1 <- sfc_linestring(obj = df, x = "x", y = "y", linestring_id = "id1")
  mls1 <- sfc_multilinestring(obj = df, x = "x", y = "y", multilinestring_id = "id1")
  p1 <- sfc_polygon(obj = df, x = "x", y = "y", polygon_id = "id1", linestring_id = "id2", close = FALSE )
  mp1 <- sfc_multipolygon(obj = df, x = "x", y = "y", multipolygon_id = "id1", linestring_id = "id2", close = FALSE )

  pt2 <- sfc_point(obj = df, x = "x", y = "y")
  mpt2 <- sfc_multipoint(obj = df, x = "x", y = "y", multipoint_id = "id1")
  ls2 <- sfc_linestring(obj = df, x = "x", y = "y", linestring_id = "id1")
  mls2 <- sfc_multilinestring(obj = df, x = "x", y = "y", multilinestring_id = "id1")
  p2 <- sfc_polygon(obj = df, x = "x", y = "y", polygon_id = "id1", linestring_id = "id2", close = FALSE )
  mp2 <- sfc_multipolygon(obj = df, x = "x", y = "y", multipolygon_id = "id1", linestring_id = "id2", close = FALSE )

  res <- sfc_cast( pt1, "POINT" )
  expect_equal( pt1, pt2 )
  res <- sfc_cast( pt1, "MULTIPOINT" )
  expect_equal( pt1, pt2 )
  res <- sfc_cast( pt1, "LINESTRING" )
  expect_equal( pt1, pt2 )
  res <- sfc_cast( pt1, "MULTILINESTRING" )
  expect_equal( pt1, pt2 )

  res <- sfc_cast( mpt1, "POINT" )
  expect_equal( mpt1, mpt2 )
  res <- sfc_cast( mpt1, "MULTIPOINT" )
  expect_equal( mpt1, mpt2 )
  res <- sfc_cast( mpt1, "LINESTRING" )
  expect_equal( mpt1, mpt2 )
  res <- sfc_cast( mpt1, "MULTILINESTRING" )
  expect_equal( mpt1, mpt2 )
  res <- sfc_cast( mpt1, "POLYGON" )
  expect_equal( mpt1, mpt2 )
  res <- sfc_cast( mpt1, "MULTIPOLYGON" )
  expect_equal( mpt1, mpt2 )

  res <- sfc_cast( ls1, "POINT" )
  expect_equal( ls1, ls2 )
  res <- sfc_cast( ls1, "MULTIPOINT" )
  expect_equal( ls1, ls2 )
  res <- sfc_cast( ls1, "LINESTRING" )
  expect_equal( ls1, ls2 )
  res <- sfc_cast( ls1, "MULTILINESTRING" )
  expect_equal( ls1, ls2 )
  res <- sfc_cast( ls1, "POLYGON" )
  expect_equal( ls1, ls2 )
  res <- sfc_cast( ls1, "MULTIPOLYGON" )
  expect_equal( ls1, ls2 )

  res <- sfc_cast( mls1, "POINT" )
  expect_equal( mls1, mls2 )
  res <- sfc_cast( mls1, "MULTIPOINT" )
  expect_equal( mls1, mls2 )
  res <- sfc_cast( mls1, "LINESTRING" )
  expect_equal( mls1, mls2 )
  res <- sfc_cast( mls1, "MULTILINESTRING" )
  expect_equal( mls1, mls2 )
  res <- sfc_cast( mls1, "POLYGON" )
  expect_equal( mls1, mls2 )
  res <- sfc_cast( mls1, "MULTIPOLYGON" )
  expect_equal( mls1, mls2 )

  res <- sfc_cast( p1, "POINT" )
  expect_equal( p1, p2 )
  res <- sfc_cast( p1, "MULTIPOINT" )
  expect_equal( p1, p2 )
  res <- sfc_cast( p1, "LINESTRING" )
  expect_equal( p1, p2 )
  res <- sfc_cast( p1, "MULTILINESTRING" )
  expect_equal( p1, p2 )
  res <- sfc_cast( p1, "POLYGON" )
  expect_equal( p1, p2 )
  res <- sfc_cast( p1, "MULTIPOLYGON" )
  expect_equal( p1, p2 )

  res <- sfc_cast( mp1, "POINT" )
  expect_equal( mp1, mp2 )
  res <- sfc_cast( mp1, "MULTIPOINT" )
  expect_equal( mp1, mp2 )
  res <- sfc_cast( mp1, "LINESTRING" )
  expect_equal( mp1, mp2 )
  res <- sfc_cast( mp1, "MULTILINESTRING" )
  expect_equal( mp1, mp2 )
  res <- sfc_cast( mp1, "POLYGON" )
  expect_equal( mp1, mp2 )
  res <- sfc_cast( mp1, "MULTIPOLYGON" )
  expect_equal( mp1, mp2 )

})

test_that("list-columns casted",{

  df <- data.frame(
    id1 = c(1,1,1,1,1,1,1,1,2,2,2,2)
    , id2 = c(1,1,1,1,2,2,2,2,1,1,1,1)
    , x = c(0,0,1,1,1,1,2,2,3,4,4,3)
    , y = c(0,1,1,0,1,2,2,1,3,3,4,4)
  )

  df$val <- letters[1:nrow(df)]

  pt <- sf_point(obj = df, x = "x", y = "y")
  mpt <- sf_multipoint(obj = df, x = "x", y = "y", multipoint_id = "id1", keep = TRUE, list_columns = "val")
  ls <- sf_linestring(obj = df, x = "x", y = "y", linestring_id = "id1", keep = TRUE, list_columns = "val")
  mls <- sf_multilinestring(obj = df, x = "x", y = "y", multilinestring_id = "id1", keep = TRUE, list_columns = "val")
  p <- sf_polygon(obj = df, x = "x", y = "y", polygon_id = "id1", linestring_id = "id2", close = FALSE, keep = TRUE, list_columns = "val" )
  mp <- sf_multipolygon(obj = df, x = "x", y = "y", multipolygon_id = "id1", linestring_id = "id2", close = FALSE, keep = TRUE, list_columns = "val" )

  ## Linestring to Point
  res <- sf_cast(ls, "POINT", list_columns = "val")
  expect_true( nrow( res ) == nrow( df ) )
  expect_equal( res$val, df$val )
  expect_true( is.character( res$val ) )

  ## Linestring to Polygon
  res <- sf_cast(ls, "POLYGON", list_columns = "val")

  expect_true( nrow( res ) == 2 )
  expect_equal( res$val[[1]][[1]], ls$val[[1]] )
  expect_equal( res$val[[2]][[1]], ls$val[[2]] )


  ## Linestring to Multipolygon
  res <- sf_cast(ls, "MULTIPOLYGON", list_columns = "val")

  expect_true( nrow( res ) == 2 )
  expect_equal( res$val[[1]][[1]][[1]], ls$val[[1]] )
  expect_equal( res$val[[2]][[1]][[1]], ls$val[[2]] )


  ## Polygon to Point
  res <- sf_cast(p, "POINT", list_columns = "val")
  expect_true( nrow( res ) == nrow( df ) )
  expect_equal( res$val, df$val )
  expect_true( is.character( res$val ) )

  ## Polygon to Linestring
  res <- sf_cast(p, "LINESTRING", list_columns = "val")

  expect_equal(length(res$val), 3)
  expect_equal( res$val[[1]], p$val[[1]][[1]] )
  expect_equal( res$val[[2]], p$val[[1]][[2]] )
  expect_equal( res$val[[3]], p$val[[2]][[1]] )

  ## Polygon to Multipolygon
  res <- sf_cast(p, "MULTIPOLYGON", list_columns = "val")
  expect_true( nrow( res ) == 2 )
  expect_equal( res$val[[1]][[1]], p$val[[1]] )
  expect_equal( res$val[[2]][[1]], p$val[[2]] )



})