tests/testthat/test-sfg_multilinestring.R

In sfheaders: Converts Between R Objects and Simple Feature Objects

context("sfg_multilinestring")

test_that("sfg multilinestring", {

  x <- 1L:2L
  res <- sfheaders:::rcpp_sfg_multilinestring( x, NULL, NULL, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x)
  expect_equal( res, r_res )

  x <- c(1.3, 2.2)
  res <- sfheaders:::rcpp_sfg_multilinestring( x, NULL, NULL, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x)
  expect_equal( res, r_res )

  ## matrix
  x <- matrix(c(1:24), ncol = 2)
  res <- sfheaders:::rcpp_sfg_multilinestring( x, NULL, NULL, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x)
  expect_equal( res, r_res )

  x <- matrix(c(1.2,3), ncol = 2)
  res <- sfheaders:::rcpp_sfg_multilinestring( x, NULL, NULL, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x)
  expect_equal( res, r_res )

  x <- matrix(c(1:24), ncol = 3)
  res <- sfheaders:::rcpp_sfg_multilinestring( x, NULL, NULL, "" )
  expect_equal( attr(res, "class"), c("XYZ", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x)
  expect_equal( res, r_res )

  x <- matrix(c(1:24), ncol = 4)
  res <- sfheaders:::rcpp_sfg_multilinestring( x, NULL, NULL, "" )
  expect_equal( attr(res, "class"), c("XYZM", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x)
  expect_equal( res, r_res )

  x <- matrix(c(1:24), ncol = 4)
  res <- sfheaders:::rcpp_sfg_multilinestring( x, c(0L,1L), NULL, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(obj = x, x = 1, y = 2)
  expect_equal( res, r_res )

  df <- data.frame(
    x = 1,
    y = 2
  )
  x <- as.matrix( df )
  res <- sfheaders:::rcpp_sfg_multilinestring( x, c(0L,1L), NULL, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(obj = x, x = 1, y = 2)
  expect_equal( res, r_res )

  df <- data.frame(
    x = 1L,
    y = 2L
  )
  x <- as.matrix( df )
  res <- sfheaders:::rcpp_sfg_multilinestring( x, c(0L,1L), NULL, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(obj = x, x = 1, y = 2)
  expect_equal( res, r_res )

  df <- data.frame(
    x = 1,
    y = 2
  )
  x <- as.matrix( df )
  res <- sfheaders:::rcpp_sfg_multilinestring( x, c("x","y"), NULL, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x, x = "x", y = "y")
  expect_equal( res, r_res )

  df <- data.frame(
    x = 1L,
    y = 2L
  )
  x <- as.matrix( df )
  res <- sfheaders:::rcpp_sfg_multilinestring( x, c("x","y"), NULL, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x, x = "x", y = "y")
  expect_equal( res, r_res )


  df <- data.frame(
    x = 1L,
    y = 2L,
    id = 1L
  )
  x <- as.matrix( df )
  res <- sfheaders:::rcpp_sfg_multilinestring( x, NULL, "id", "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x, x = "x", y = "y")
  expect_equal( res, r_res )

  df <- data.frame(
    x = 1L,
    y = 2L,
    id = 1L
  )
  res <- sfheaders:::rcpp_sfg_multilinestring( df, c(0L,1L),2L, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x, x = "x", y = "y")
  expect_equal( res, r_res )

  df <- data.frame(
    x = 1L,
    y = 2L
  )
  res <- sfheaders:::rcpp_sfg_multilinestring( df, c(0L,1L) , NULL, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  ## TODO names??
  # r_res <- sfg_multilinestring(df, x = "x", y = "y")
  # expect_equal( res, r_res )

  df <- data.frame(
    x = 1L,
    y = 2L
  )
  res <- sfheaders:::rcpp_sfg_multilinestring( df, c("x","y") , NULL, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(df, x = "x", y = "y")
  expect_equal( res, r_res )


  df <- data.frame(
    id = 1,
    x = 1,
    y = 2
  )
  x <- as.matrix( df )
  res <- sfheaders:::rcpp_sfg_multilinestring( x, c("x","y"), "id", "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x, x = "x", y = "y", linestring_id = "id")
  expect_equal( res, r_res )

  df <- data.frame(
    id = 1,
    x = 1L,
    y = 2L
  )
  x <- as.matrix( df )
  res <- sfheaders:::rcpp_sfg_multilinestring( x, c("x","y"), "id", "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x, x = "x", y = "y", linestring_id = "id")
  expect_equal( res, r_res )

  df <- data.frame(
    id = 1,
    x = 1,
    y = 2
  )
  x <- as.matrix( df )
  res <- sfheaders:::rcpp_sfg_multilinestring( x, c(1L,2L), 0L, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  #r_res <- sfg_multilinestring(x, x = "x", y = "y", linestring_id = "id")
  #expect_equal( res, r_res )

  df <- data.frame(
    id = 1,
    x = 1L,
    y = 2L
  )
  x <- as.matrix( df )
  res <- sfheaders:::rcpp_sfg_multilinestring( x, c(1L,2L), 0L, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  # r_res <- sfg_multilinestring(x, x = "x", y = "y", linestring_id = "id")
  # expect_equal( res, r_res )

  df <- data.frame(
    id = 1,
    x = 1L,
    y = 2L
  )
  x <- as.matrix( df )
  res <- sfheaders:::rcpp_sfg_multilinestring( x, c("x","y"), "id", "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x, x = "x", y = "y", linestring_id = "id")
  expect_equal( res, r_res )

  df <- data.frame(
    id = 1,
    x = 1L,
    y = 2L
  )
  x <- as.matrix( df )
  res <- sfheaders:::rcpp_sfg_multilinestring( x, c(1L, 2L), 0L, "" )
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x, x = 2, y = 3, linestring_id = 1 )
  expect_equal( res, r_res )

  x <- data.frame(
    id = 1,
    x = 1L,
    y = 2L
  )
  res <- sfheaders:::rcpp_sfg_multilinestring( x, c("x","y"), "id", "")
  expect_equal( attr(res, "class"), c("XY", "MULTILINESTRING","sfg"))
  r_res <- sfg_multilinestring(x, x = "x", y = "y", linestring_id = "id")
  expect_equal( res, r_res )


  ## data.frame
  ids <- c( rep(1,5), rep(2,3), rep(3,6) )
  df <- data.frame(
    x = c(rep(0, length(ids))),
    y = c(rep(0, length(ids))),
    z = c(rep(0, length(ids))),
    m = c(rep(0, length(ids)))
  )

  res <- sfheaders:::rcpp_sfg_multilinestring( df, NULL, NULL, "" )
  expect_equal( attr(res, "class"), c("XYZM", "MULTILINESTRING", "sfg"))
  r_res <- sfg_multilinestring(df)
  expect_equal( res, r_res )

})

test_that("vectorised version works",{

  is_multilinestring <- function(x) {
    y <- is.list(unclass(x))
    z <- attr( x, "class")[2] == "MULTILINESTRING"
    return( all(y) & all(z))
  }

  m1 <- matrix(1:3, ncol = 3)
  m2 <- matrix(1:3, ncol = 3)
  lst <- list( m1, m2 )
  res <- sfheaders:::rcpp_sfg_multilinestrings( lst, "" )
  expect_true( all( sapply( res, is_multilinestring ) ) )

})