library(Rcpp)
library(sfheaders)
library(sf)
#  Linking to GEOS 3.6.1, GDAL 2.1.3, PROJ 4.9.3

POINT


cppFunction(
  includes = '
    #include "sfheaders/sfg/sfg.hpp"
  ',
  code = '
    SEXP a_point( SEXP x ) {
      return sfheaders::sfg::sfg_point( x );
    }
  ',
  depends = "sfheaders"
)

## vector
a_point( c(1,2) )
#  POINT (1 2)
## single-row matrix
a_point( matrix(c(1,2), ncol = 2) )
#  POINT (1 2)
## single-row data.frame
a_point( data.frame(x =1, y = 2) )
#  POINT (1 2)

MULTIPOINT


cppFunction(
  includes = '
    #include "sfheaders/sfg/sfg.hpp"
  ',
  code = '
    SEXP a_multipoint( SEXP x ) {
      return sfheaders::sfg::sfg_multipoint( x );
    }
  ',
  depends = "sfheaders"
)

x <- 1:2
a_multipoint( x )
#  MULTIPOINT (1 2)

x <- matrix(c(1,2,3,4,5,6), ncol = 2)
a_multipoint( x )
#  MULTIPOINT (1 4, 2 5, 3 6)

x <- data.frame(x = 1:3, y = 4:6)
a_multipoint( x )
#  MULTIPOINT (1 4, 2 5, 3 6)

LINESTRING


cppFunction(
  includes = '
    #include "sfheaders/sfg/sfg.hpp"
  ',
  code = '
    SEXP a_linestring( SEXP x ) {
      return sfheaders::sfg::sfg_linestring( x );
    }
  ',
  depends = "sfheaders"
)

x <- 1:2
a_linestring( x )
#  LINESTRING (1 2)

x <- matrix(c(1,2,3,4,5,6), ncol = 2)
a_linestring( x )
#  LINESTRING (1 4, 2 5, 3 6)

x <- data.frame(x = 1:3, y = 4:6)
a_linestring( x )
#  LINESTRING (1 4, 2 5, 3 6)

x <- data.frame(x = 1:3, y = 4:6, z = 7:9)
a_linestring( x )
#  LINESTRING Z (1 4 7, 2 5 8, 3 6 9)

MULTILINESTRING


cppFunction(
  includes = '
    #include "sfheaders/sfg/sfg.hpp"
  ',
  code = '
    SEXP a_multilinestring( SEXP x ) {
      return sfheaders::sfg::sfg_multilinestring( x );
    }
  ',
  depends = "sfheaders"
)

x <- 1:2
a_multilinestring( x )
#  MULTILINESTRING ((1 2))

x <- matrix(c(1,2,3,4,5,6), ncol = 2)
a_multilinestring( x )
#  MULTILINESTRING ((1 4, 2 5, 3 6))

x <- data.frame(x = 1:3, y = 4:6)
a_multilinestring( x )
#  MULTILINESTRING ((1 4, 2 5, 3 6))

x <- data.frame(x = 1:3, y = 4:6, z = 7:9)
a_multilinestring( x )
#  MULTILINESTRING Z ((1 4 7, 2 5 8, 3 6 9))

cppFunction(
  includes = '
    #include "sfheaders/sfg/sfg.hpp"
  ',
  code = '
    SEXP a_multilinestring( SEXP x, SEXP geometry_cols, SEXP id_col ) {
      return sfheaders::sfg::sfg_multilinestring( x, geometry_cols, id_col );
    }
  ',
  depends = "sfheaders"
)

x <- data.frame(id = c(1,1,2), x = 1:3, y = 4:6, z = 7:9)
a_multilinestring( x, c("x","y"), "id" )
#  MULTILINESTRING ((1 4, 2 5), (3 6))

a_multilinestring( x, c("x","y","z"), "id" )
#  MULTILINESTRING Z ((1 4 7, 2 5 8), (3 6 9))

a_multilinestring( x, NULL, "id" )
#  MULTILINESTRING Z ((1 4 7, 2 5 8), (3 6 9))

POLYGON

MULTIPOLIYGON

from C++

There are various overloaded functions for each sfg, sfc and sf types



cppFunction(
  includes = '
    #include "sfheaders/sfg/sfg.hpp"
  ',
  code = '
    SEXP a_polygon( Rcpp::DataFrame df ) {
      return sfheaders::sfg::sfg_polygon( df );
    }
  ',
  depends = "sfheaders"
)

a_polygon( df )
cppFunction(
  includes = '
    #include "sfheaders/sfg/sfg.hpp"
  ',
  code = '
    SEXP a_polygon( Rcpp::DataFrame df, Rcpp::StringVector geometry_columns ) {
      return sfheaders::sfg::sfg_polygon( df, geometry_columns );
    }
  ',
  depends = "sfheaders"
)

a_polygon( df, c("x","y") )

a_polygon( df, c("y", "x") )
cppFunction(
  includes = '
    #include "sfheaders/sfg/sfg.hpp"
  ',
  code = '
    SEXP a_polygon( SEXP x, SEXP geometry_columns ) {
      return sfheaders::sfg::sfg_polygon( x, geometry_columns );
    }
  ',
  depends = "sfheaders"
)

a_polygon( df, c("x","y") )

a_polygon( df, c("y", "x") )

cppFunction(
  includes = '
    #include "sfheaders/sfg/sfg.hpp"
  ',
  code = '
    SEXP a_polygon( SEXP df, std::string geom_type ) {
      return sfheaders::sfg::to_sfg( df, geom_type );
    }
  ',
  depends = "sfheaders"
)

a_polygon( df, "POLYGON" )

sfc


cppFunction(
  includes = '
    #include "sfheaders/sfc/sfc.hpp"
  ',
  code = '
    SEXP a_polygon( SEXP df ) {
      return sfheaders::sfc::sfc_polygon( df );
    }
  ',
  depends = "sfheaders",
  plugins = "cpp11"
)

a_polygon( df )

cppFunction(
  includes = '
    #include "sfheaders/sfc/sfc.hpp"
  ',
  code = '
    SEXP a_polygon( SEXP df, SEXP geometry_columns ) {
      return sfheaders::sfc::sfc_polygon( df, geometry_columns );
    }
  ',
  depends = "sfheaders",
  plugins = "cpp11"
)

a_polygon( df, c("x","y") )

df <- data.frame(
  id = c( rep(1, 5), rep(2, 5) )
  , x = 1:10
  , y = 1:10
)

cppFunction(
  includes = '
    #include "sfheaders/sfc/sfc.hpp"
  ',
  code = '
    SEXP a_polygon( SEXP df, SEXP geometry_columns ) {
      return sfheaders::sfc::sfc_polygon( df, geometry_columns );
    }
  ',
  depends = "sfheaders",
  plugins = "cpp11"
)

a_polygon( df, c("x","y") )

cppFunction(
  includes = '
    #include "sfheaders/sfc/sfc.hpp"
  ',
  code = '
    SEXP a_polygon( SEXP df, SEXP geometry_columns, SEXP polygon_id, SEXP linestring_id ) {
      return sfheaders::sfc::sfc_polygon( df, geometry_columns, polygon_id, linestring_id );
    }
  ',
  depends = "sfheaders",
  plugins = "cpp11"
)

a_polygon( df, c("x","y"), "id", NULL )