dcooley / sfheaders
Showing 22 of 52 files from the diff.

@@ -69,16 +69,18 @@
Loading
69 69
      Rcpp::String this_name = df_names[ i ];
70 70
      std::string str_name = this_name;
71 71
      if( str_name != geom_column ) {
72 -
        // Rcpp::Rcout << "this_name: " << str_name << std::endl;
73 72
        SEXP v = sf[ i ];
73 +
        //Rcpp::Rcout << "this_name: " << str_name << std::endl;
74 74
        sfheaders::df::expand_vector( sf_res, v, expanded_index, column_counter );
75 -
        res_names[ i ] = str_name;
75 +
        res_names[ column_counter ] = str_name;
76 76
        ++column_counter;
77 77
      }
78 78
    }
79 79
80 +
    // Rcpp::Rcout << "res_names: " << res_names << std::endl;
80 81
    // append 'geom_column' to res_columns;
81 82
    res_names[ column_counter ] = geom_column;
83 +
    // Rcpp::Rcout << "res_names: " << res_names << std::endl;
82 84
83 85
    sf_res[ column_counter ] = casted_sfc;
84 86
    sf_res.names() = res_names;

@@ -0,0 +1,304 @@
Loading
1 +
#ifndef R_SFHEADERS_DF_LIST_H
2 +
#define R_SFHEADERS_DF_LIST_H
3 +
4 +
// adapted from colourvalues
5 +
6 +
#include <Rcpp.h>
7 +
8 +
/* unlisting a list
9 +
#
10 +
 * - follow: https://stackoverflow.com/questions/30175104/how-to-effectively-combine-a-list-of-numericvectors-into-one-large-numericvector
11 +
 * - get size of vector
12 +
 * - get type of each element
13 +
 * - get overal type
14 +
 * - create vector of overall type
15 +
 * - coerce other types to that overall type
16 +
 * - fill vector
17 +
 * - pass into colouring function
18 +
 * - CHECK: the order of values in the vector is maintained from the original list
19 +
 */
20 +
21 +
namespace sfheaders {
22 +
namespace utils {
23 +
24 +
  inline int vector_type( int new_type, int existing_type ) {
25 +
26 +
    // can't change from STRSXP
27 +
    if( existing_type == 16 ) {
28 +
      return existing_type;
29 +
    }
30 +
31 +
    std::vector< int > valid_types{10, 13, 14, 16};
32 +
    bool new_is_valid = ( std::find( valid_types.begin(), valid_types.end(), new_type ) != valid_types.end() );
33 +
    bool existing_is_valid = ( std::find( valid_types.begin(), valid_types.end(), existing_type ) != valid_types.end() );
34 +
35 +
    if( new_type == existing_type && new_is_valid ) {
36 +
      return existing_type;
37 +
    }
38 +
39 +
    // convert new type up to existing type
40 +
    if( new_type < existing_type && existing_is_valid ) {
41 +
      return existing_type;
42 +
    }
43 +
44 +
    if( new_type > existing_type && new_is_valid ) {
45 +
      return new_type;
46 +
    }
47 +
48 +
    if( new_type > existing_type && !new_is_valid ) {
49 +
      return 16;
50 +
    }
51 +
52 +
    if( existing_is_valid ) {
53 +
      return existing_type;
54 +
    }
55 +
56 +
    return 16;
57 +
  }
58 +
59 +
  inline Rcpp::List list_size(
60 +
    const Rcpp::List& lst,
61 +
    int& total_size,
62 +
    int& existing_type
63 +
  ) {
64 +
    R_xlen_t n = lst.size();
65 +
    Rcpp::List res( n ); // create a list to store the size corresponding to each list element
66 +
    R_xlen_t i;
67 +
    for( i = 0; i < n; i++ ) {
68 +
      switch( TYPEOF( lst[i] ) ) {
69 +
      case VECSXP: {
70 +
        res[ i ] = list_size( lst[i], total_size, existing_type );
71 +
        break;
72 +
      }
73 +
      default: {
74 +
        int n_elements = Rf_length( lst[i] );
75 +
        int new_type = TYPEOF( lst[i] );
76 +
        existing_type = vector_type( new_type, existing_type );
77 +
        res[i] = n_elements;
78 +
        total_size += n_elements;
79 +
      }
80 +
      }
81 +
    }
82 +
    return res;
83 +
  }
84 +
85 +
  // collapse a vector into a list
86 +
  // where line_ids gives the start and end indexes of v to use
87 +
  template < int RTYPE >
88 +
  inline Rcpp::List fill_list(
89 +
    Rcpp::Vector< RTYPE >& v,
90 +
    Rcpp::IntegerMatrix& line_positions
91 +
  ) {
92 +
    R_xlen_t n = line_positions.nrow();  // nrow should also be the row of the final sf object we are creating
93 +
    Rcpp::List res( n );
94 +
    R_xlen_t i;
95 +
96 +
    // Rcpp::Rcout << "n: " << n << std::endl;
97 +
    // Rcpp::Rcout << "line_positions: " << line_positions << std::endl;
98 +
99 +
    for( i = 0; i < n; ++i ) {
100 +
      //Rcpp::Rcout << "i: " << i << std::endl;
101 +
      R_xlen_t start = line_positions(i, 0);
102 +
      R_xlen_t end = line_positions(i, 1);
103 +
      Rcpp::IntegerVector elements = Rcpp::seq( start, end );
104 +
      //Rcpp::Rcout << "elements: " << elements << std::endl;
105 +
      res[ i ] = v[ elements ];
106 +
    }
107 +
    return res;
108 +
  }
109 +
110 +
  // TODO - handle dates and factors??
111 +
  inline Rcpp::List fill_list(
112 +
    SEXP& v,
113 +
    Rcpp::IntegerMatrix& line_positions
114 +
  ) {
115 +
    switch( TYPEOF( v ) ) {
116 +
    case LGLSXP: {
117 +
      Rcpp::LogicalVector lv = Rcpp::as< Rcpp::LogicalVector >( v );
118 +
      return fill_list( lv, line_positions );
119 +
    }
120 +
    case INTSXP: {
121 +
      Rcpp::IntegerVector iv = Rcpp::as< Rcpp::IntegerVector >( v );
122 +
      return fill_list( iv, line_positions );
123 +
    }
124 +
    case REALSXP: {
125 +
      Rcpp::NumericVector nv = Rcpp::as< Rcpp::NumericVector >( v );
126 +
      return fill_list( nv, line_positions );
127 +
    }
128 +
    case STRSXP: {
129 +
      Rcpp::StringVector sv = Rcpp::as< Rcpp::StringVector >( v );
130 +
      return fill_list( sv, line_positions );
131 +
    }
132 +
    default: {
133 +
      Rcpp::stop("sfheaders - unknown column type");
134 +
    }
135 +
    }
136 +
    return Rcpp::List::create(); // #nocov
137 +
  }
138 +
139 +
140 +
  /*
141 +
   * @param lst - the original input list
142 +
   * @param lst_sizes - the dimensions of the list
143 +
   * @param values - vector of values to be unlist
144 +
   */
145 +
  inline void unlist_list(
146 +
      const Rcpp::List& lst,
147 +
      const Rcpp::List& lst_sizes,
148 +
      Rcpp::LogicalVector& values,
149 +
      int& list_position
150 +
  ) {
151 +
    // - iterate through original list
152 +
    // - extract each element and insert into 'values'
153 +
    R_xlen_t n = lst.size();
154 +
    Rcpp::List res( n );
155 +
    R_xlen_t i;
156 +
    for( i = 0; i < n; ++i ) {
157 +
      switch( TYPEOF( lst[ i ] ) ) {
158 +
      case VECSXP: {
159 +
        unlist_list( lst[ i ], lst_sizes[ i ], values, list_position );
160 +
        break;
161 +
      }
162 +
      default: {
163 +
        Rcpp::IntegerVector n_elements = Rcpp::as< Rcpp::IntegerVector >( lst_sizes[ i ] );
164 +
        int end_position = list_position + n_elements[0] - 1;
165 +
        Rcpp::IntegerVector elements = Rcpp::seq( list_position, end_position );
166 +
        values[ elements ] = Rcpp::as< Rcpp::LogicalVector >( lst[ i ] );
167 +
168 +
        list_position = end_position + 1;
169 +
        break;
170 +
      }
171 +
      }
172 +
    }
173 +
  }
174 +
175 +
  inline void unlist_list(
176 +
      const Rcpp::List& lst,
177 +
      const Rcpp::List& lst_sizes,
178 +
      Rcpp::IntegerVector& values,
179 +
      int& list_position
180 +
  ) {
181 +
    // - iterate through original list
182 +
    // - extract each element and insert into 'values'
183 +
    R_xlen_t n = lst.size();
184 +
    Rcpp::List res( n );
185 +
    R_xlen_t i;
186 +
    for( i = 0; i < n; ++i ) {
187 +
      switch( TYPEOF( lst[ i ] ) ) {
188 +
      case VECSXP: {
189 +
        unlist_list( lst[ i ], lst_sizes[ i ], values, list_position );
190 +
        break;
191 +
      }
192 +
      default: {
193 +
        Rcpp::IntegerVector n_elements = Rcpp::as< Rcpp::IntegerVector >( lst_sizes[ i ] );
194 +
        int end_position = list_position + n_elements[0] - 1;
195 +
        Rcpp::IntegerVector elements = Rcpp::seq( list_position, end_position );
196 +
        values[ elements ] = Rcpp::as< Rcpp::IntegerVector >( lst[ i ] );
197 +
198 +
        list_position = end_position + 1;
199 +
        break;
200 +
      }
201 +
      }
202 +
    }
203 +
  }
204 +
205 +
  inline void unlist_list(
206 +
      const Rcpp::List& lst,
207 +
      const Rcpp::List& lst_sizes,
208 +
      Rcpp::NumericVector& values,
209 +
      int& list_position
210 +
  ) {
211 +
    // - iterate through original list
212 +
    // - extract each element and insert into 'values'
213 +
    R_xlen_t n = lst.size();
214 +
    Rcpp::List res( n );
215 +
    R_xlen_t i;
216 +
    for( i = 0; i < n; ++i ) {
217 +
      switch( TYPEOF( lst[ i ] ) ) {
218 +
      case VECSXP: {
219 +
        unlist_list( lst[ i ], lst_sizes[ i ], values, list_position );
220 +
        break;
221 +
      }
222 +
      default: {
223 +
        Rcpp::IntegerVector n_elements = Rcpp::as< Rcpp::IntegerVector >( lst_sizes[ i ] );
224 +
        int end_position = list_position + n_elements[0] - 1;
225 +
        Rcpp::IntegerVector elements = Rcpp::seq( list_position, end_position );
226 +
        values[ elements ] = Rcpp::as< Rcpp::NumericVector >( lst[ i ] );
227 +
228 +
        list_position = end_position + 1;
229 +
        break;
230 +
      }
231 +
      }
232 +
    }
233 +
  }
234 +
235 +
  inline void unlist_list(
236 +
      const Rcpp::List& lst,
237 +
      const Rcpp::List& lst_sizes,
238 +
      Rcpp::StringVector& values,
239 +
      int& list_position
240 +
  ) {
241 +
    // - iterate through original list
242 +
    // - extract each element and insert into 'values'
243 +
    R_xlen_t n = lst.size();
244 +
    Rcpp::List res( n );
245 +
    R_xlen_t i;
246 +
    for( i = 0; i < n; i++ ) {
247 +
      switch( TYPEOF( lst[i] ) ) {
248 +
      case VECSXP: {
249 +
        unlist_list( lst[ i ], lst_sizes[ i ], values, list_position );
250 +
        break;
251 +
      }
252 +
      default: {
253 +
        Rcpp::IntegerVector n_elements = Rcpp::as< Rcpp::IntegerVector >( lst_sizes[ i ] );
254 +
        int end_position = list_position + n_elements[0] - 1;
255 +
        Rcpp::IntegerVector elements = Rcpp::seq( list_position, end_position );
256 +
        values[ elements ] = Rcpp::as< Rcpp::StringVector >( lst[ i ] );
257 +
258 +
        list_position = end_position + 1;
259 +
        break;
260 +
      }
261 +
      }
262 +
    }
263 +
  }
264 +
265 +
 inline SEXP unlist_list( Rcpp::List& lst ) {
266 +
267 +
    int total_size = 0;
268 +
    int existing_type = 10;
269 +
    int position = 0;
270 +
    Rcpp::List lst_sizes = list_size( lst, total_size, existing_type );
271 +
272 +
    switch( existing_type ) {
273 +
    case LGLSXP: {
274 +
      Rcpp::LogicalVector lv( total_size );
275 +
      unlist_list( lst, lst_sizes, lv, position );
276 +
      return lv;
277 +
    }
278 +
    case INTSXP: {
279 +
      Rcpp::IntegerVector iv( total_size );
280 +
      unlist_list( lst, lst_sizes, iv, position );
281 +
      return iv;
282 +
    }
283 +
    case REALSXP: {
284 +
      Rcpp::NumericVector nv( total_size );
285 +
      unlist_list( lst, lst_sizes, nv, position );
286 +
      return nv;
287 +
    }
288 +
    default: {
289 +
      Rcpp::StringVector sv( total_size );
290 +
      unlist_list( lst, lst_sizes, sv, position );
291 +
      return sv;
292 +
    }
293 +
    }
294 +
295 +
    Rcpp::stop("sfheaders - couldn't unlist this object");
296 +
    return lst; // #nocov - never reaches
297 +
298 +
  }
299 +
300 +
} // utils
301 +
} // sfheaders
302 +
303 +
#endif
304 +

@@ -42,7 +42,21 @@
Loading
42 42
    Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( property_cols, df_names );
43 43
44 44
    Rcpp::List sfc = sfheaders::sfc::sfc_multipolygon( df, geometry_cols, polygon_ids, line_ids, polygon_positions, close );
45 -
    return sfheaders::sf::create_sf( df, sfc, id_column, property_cols, property_idx, row_idx );
45 +
46 +
47 +
    Rcpp::List res = Rcpp::List::create(
48 +
      Rcpp::_["df"] = df,
49 +
      Rcpp::_["sfc"] = sfc,
50 +
      Rcpp::_["id_column"] = id_column,
51 +
      Rcpp::_["property_cols"] = property_cols,
52 +
      Rcpp::_["property_idx"] = property_idx,
53 +
      Rcpp::_["row_idx"] = row_idx,
54 +
      Rcpp::_["line_positions"] = polygon_positions
55 +
    );
56 +
57 +
    return res;
58 +
59 +
    //return sfheaders::sf::create_sf( df, sfc, id_column, property_cols, property_idx, row_idx );
46 60
  }
47 61
48 62
  inline SEXP sf_multipolygon(
@@ -281,7 +295,21 @@
Loading
281 295
      // the entire object is one multipolygon
282 296
      Rcpp::List sfc = sfheaders::sfc::sfc_multipolygon( x, geometry_cols, multipolygon_id, polygon_id, linestring_id, close );
283 297
      SEXP property_columns = sfheaders::utils::other_columns( x, geometry_cols, polygon_id );
284 -
      return sfheaders::sf::create_sf( x, sfc, property_columns );
298 +
299 +
      Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( property_columns, x );
300 +
      Rcpp::IntegerMatrix line_positions(1,2);
301 +
      line_positions(0,0) = 0;
302 +
      line_positions(0,1) = sfheaders::utils::sexp_n_row( x ) - 1;
303 +
304 +
      Rcpp::List res = Rcpp::List::create(
305 +
        Rcpp::_["x"] = x,
306 +
        Rcpp::_["sfc"] = sfc,
307 +
        Rcpp::_["property_cols"] = property_columns,
308 +
        Rcpp::_["property_idx"] = property_idx,
309 +
        Rcpp::_["line_positions"] = line_positions
310 +
      );
311 +
312 +
      return res;
285 313
286 314
    }
287 315
@@ -293,7 +321,21 @@
Loading
293 321
      // the entire object is one multipolygon
294 322
      Rcpp::List sfc = sfheaders::sfc::sfc_multipolygon( x, geometry_cols, multipolygon_id, polygon_id, linestring_id, close );
295 323
      SEXP property_columns = sfheaders::utils::other_columns( x, geometry_cols, linestring_id );
296 -
      return sfheaders::sf::create_sf( x, sfc, property_columns );
324 +
325 +
      Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( property_columns, x );
326 +
      Rcpp::IntegerMatrix line_positions(1,2);
327 +
      line_positions(0,0) = 0;
328 +
      line_positions(0,1) = sfheaders::utils::sexp_n_row( x ) - 1;
329 +
330 +
      Rcpp::List res = Rcpp::List::create(
331 +
        Rcpp::_["x"] = x,
332 +
        Rcpp::_["sfc"] = sfc,
333 +
        Rcpp::_["property_cols"] = property_columns,
334 +
        Rcpp::_["property_idx"] = property_idx,
335 +
        Rcpp::_["line_positions"] = line_positions
336 +
      );
337 +
338 +
      return res;
297 339
    }
298 340
299 341
@@ -323,7 +365,21 @@
Loading
323 365
      // the entire object is one multipolygon
324 366
      Rcpp::List sfc = sfheaders::sfc::sfc_multipolygon( x, geometry_cols, multipolygon_id, polygon_id, linestring_id, close );
325 367
      SEXP property_columns = sfheaders::utils::other_columns( x, geometry_cols, polygon_id, linestring_id );
326 -
      return sfheaders::sf::create_sf( x, sfc, property_columns );
368 +
369 +
      Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( property_columns, x );
370 +
      Rcpp::IntegerMatrix line_positions(1,2);
371 +
      line_positions(0,0) = 0;
372 +
      line_positions(0,1) = sfheaders::utils::sexp_n_row( x ) - 1;
373 +
374 +
      Rcpp::List res = Rcpp::List::create(
375 +
        Rcpp::_["x"] = x,
376 +
        Rcpp::_["sfc"] = sfc,
377 +
        Rcpp::_["property_cols"] = property_columns,
378 +
        Rcpp::_["property_idx"] = property_idx,
379 +
        Rcpp::_["line_positions"] = line_positions
380 +
      );
381 +
382 +
      return res;
327 383
    }
328 384
329 385
    if(
@@ -334,7 +390,23 @@
Loading
334 390
      // the entire object is one multipolygon
335 391
      Rcpp::List sfc = sfheaders::sfc::sfc_multipolygon( x, geometry_cols, multipolygon_id, polygon_id, linestring_id, close );
336 392
      SEXP property_columns = sfheaders::utils::other_columns( x, geometry_cols );
337 -
      return sfheaders::sf::create_sf( x, sfc, property_columns );
393 +
394 +
      Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( property_columns, x );
395 +
      Rcpp::IntegerMatrix line_positions(1,2);
396 +
      line_positions(0,0) = 0;
397 +
      line_positions(0,1) = sfheaders::utils::sexp_n_row( x ) - 1;
398 +
399 +
      Rcpp::List res = Rcpp::List::create(
400 +
        Rcpp::_["x"] = x,
401 +
        Rcpp::_["sfc"] = sfc,
402 +
        Rcpp::_["property_cols"] = property_columns,
403 +
        Rcpp::_["property_idx"] = property_idx,
404 +
        Rcpp::_["line_positions"] = line_positions
405 +
      );
406 +
407 +
      return res;
408 +
409 +
      //return sfheaders::sf::create_sf( x, sfc, property_columns );
338 410
    }
339 411
340 412
    if(

@@ -14,13 +14,19 @@
Loading
14 14
#'
15 15
#' @section Keeping Properties:
16 16
#'
17 -
#' Setting \code{keep = TRUE} will retain the first row of any columns not specified as a
17 +
#' Setting \code{keep = TRUE} will retain any columns not specified as a
18 18
#' coordinate (x, y, z, m) or an id (e.g., linestring_id, polygon_id) of the input \code{obj}.
19 19
#'
20 +
#' You can use \code{list_columns} to specify which of the properties will be turned into
21 +
#' a list, thus keeping all the values in the column. For columns not specified in \code{list_columns},
22 +
#' only the first row of the column is kept
23 +
#'
20 24
#' The \code{sf_*} functions assume the input \code{obj} is a long data.frame / matrix,
21 25
#' where any properties are repeated down the table for the same geometry.
22 26
#'
23 27
#'
28 +
#'
29 +
#'
24 30
#' @return \code{sf} object of POINT geometries
25 31
#'
26 32
#' @examples
@@ -50,7 +56,23 @@
Loading
50 56
  keep = FALSE
51 57
  ) {
52 58
  geometry_columns <- c(x,y,z,m)
53 -
  return( rcpp_sf_point( obj, index_correct( geometry_columns ), keep ) )
59 +
  geometry_columns <- index_correct( geometry_columns )
60 +
  return(
61 +
    rcpp_to_sf(
62 +
      obj,
63 +
      geometry_columns
64 +
      , NULL ## multipoint_id
65 +
      , NULL ## linestring_id
66 +
      , NULL ## multilinestring_id
67 +
      , NULL ## polygon_id
68 +
      , NULL ## multipolygon_id
69 +
      , NULL ## list_columns
70 +
      , FALSE ## Close
71 +
      , keep ## keep
72 +
      , "POINT"
73 +
    )
74 +
  )
75 +
  # return( rcpp_sf_point( obj, , keep ) )
54 76
}
55 77
56 78
#' sf MULTIPOINT
@@ -62,6 +84,7 @@
Loading
62 84
#' @inheritSection sfc_point notes
63 85
#' @inheritSection sf_point Keeping Properties
64 86
#' @param multipoint_id column of ids for multipoints
87 +
#' @param list_columns vector of column names to turn into a list.
65 88
#'
66 89
#' @return \code{sf} object of MULTIPOINT geometries
67 90
#' @examples
@@ -83,15 +106,29 @@
Loading
83 106
  z = NULL,
84 107
  m = NULL,
85 108
  multipoint_id = NULL,
86 -
  keep = FALSE
109 +
  keep = FALSE,
110 +
  list_columns = NULL
87 111
  ) {
88 112
  geometry_columns <- c(x,y,z,m)
89 -
  res <- rcpp_sf_multipoint(
90 -
    obj
91 -
    , index_correct( geometry_columns )
92 -
    , index_correct( multipoint_id )
93 -
    , keep
113 +
  geometry_columns <- index_correct( geometry_columns )
114 +
  multipoint_id <- index_correct( multipoint_id )
115 +
  list_columns <- index_correct( list_columns )
116 +
  res <- return(
117 +
    rcpp_to_sf(
118 +
      obj,
119 +
      geometry_columns
120 +
      , multipoint_id ## multipoint_id
121 +
      , NULL ## linestring_id
122 +
      , NULL ## multilinestring_id
123 +
      , NULL ## polygon_id
124 +
      , NULL ## multipolygon_id
125 +
      , list_columns ## list_columns
126 +
      , FALSE ## close
127 +
      , keep ## keep
128 +
      , "MULTIPOINT"
94 129
    )
130 +
  )
131 +
95 132
  return( replace_id( res, multipoint_id ) )
96 133
}
97 134
@@ -118,6 +155,16 @@
Loading
118 155
#' sf_linestring( x, x = "y", y = "x" )
119 156
#' sf_linestring( x, linestring_id = "id", x = "x", y = "y")
120 157
#'
158 +
#' ## keeping properties
159 +
#' x <- data.frame( id = c(1,1,2,2), x = 1:4, y = 4:1, val = letters[1:4], stringsAsFactors = FALSE)
160 +
#'
161 +
#' ## first-row of 'val' is kept
162 +
#' sf_linestring( x, linestring_id = "id", x = "x", y = "y", keep = TRUE )
163 +
#'
164 +
#' ## 'val' column converted to a list
165 +
#' sf_linestring( x, linestring_id = "id", x = "x", y = "y", keep = TRUE, list_columns = "val" )
166 +
#'
167 +
#'
121 168
#' @export
122 169
sf_linestring <- function(
123 170
  obj = NULL,
@@ -126,15 +173,28 @@
Loading
126 173
  z = NULL,
127 174
  m = NULL,
128 175
  linestring_id = NULL,
129 -
  keep = FALSE
176 +
  keep = FALSE,
177 +
  list_columns = NULL
130 178
  ) {
131 179
  geometry_columns <- c(x,y,z,m)
132 -
  res <- rcpp_sf_linestring(
133 -
    obj
134 -
    , index_correct( geometry_columns )
135 -
    ,  index_correct( linestring_id )
136 -
    , keep
180 +
  geometry_columns <- index_correct( geometry_columns )
181 +
  linestring_id <- index_correct( linestring_id )
182 +
  list_columns <- index_correct( list_columns )
183 +
  res <- return(
184 +
    rcpp_to_sf(
185 +
      obj,
186 +
      geometry_columns
187 +
      , NULL ## multipoint_id
188 +
      , linestring_id ## linestring_id
189 +
      , NULL ## multilinestring_id
190 +
      , NULL ## polygon_id
191 +
      , NULL ## multipolygon_id
192 +
      , list_columns ## list_columns
193 +
      , FALSE ## close
194 +
      , keep ## keep
195 +
      , "LINESTRING"
137 196
    )
197 +
  )
138 198
  return( replace_id( res, linestring_id ) )
139 199
}
140 200
@@ -199,15 +259,28 @@
Loading
199 259
  m = NULL,
200 260
  multilinestring_id = NULL,
201 261
  linestring_id = NULL,
202 -
  keep = FALSE
262 +
  keep = FALSE,
263 +
  list_columns = NULL
203 264
  ) {
204 265
  geometry_columns <- c(x,y,z,m)
205 -
  res <- rcpp_sf_multilinestring(
206 -
    obj
207 -
    , index_correct( geometry_columns )
208 -
    , index_correct( multilinestring_id )
209 -
    , index_correct( linestring_id )
210 -
    , keep
266 +
  geometry_columns <- index_correct( geometry_columns )
267 +
  linestring_id <- index_correct( linestring_id )
268 +
  multilinestring_id <- index_correct( multilinestring_id )
269 +
  list_columns <- index_correct( list_columns )
270 +
  res <- return(
271 +
    rcpp_to_sf(
272 +
      obj,
273 +
      geometry_columns
274 +
      , NULL ## multipoint_id
275 +
      , linestring_id ## linestring_id
276 +
      , multilinestring_id ## multilinestring_id
277 +
      , NULL ## polygon_id
278 +
      , NULL ## multipolygon_id
279 +
      , list_columns ## list_columns
280 +
      , FALSE ## Close
281 +
      , keep ## keep
282 +
      , "MULTILINESTRING"
283 +
    )
211 284
  )
212 285
  return( replace_id( res, multilinestring_id ) )
213 286
}
@@ -264,6 +337,41 @@
Loading
264 337
#' sf_polygon( obj = df, polygon_id = "ml_id", linestring_id = "l_id" )
265 338
#' sf_polygon( obj = df, polygon_id = 1, linestring_id = 2 )
266 339
#'
340 +
#' ## keeping properties
341 +
#' df <- data.frame(
342 +
#'   ml_id = c(1,1,1,1,1,1,1,1,1,2,2,2,2,2,2)
343 +
#'   , l_id = c(1,1,1,2,2,2,3,3,3,1,1,1,2,2,2)
344 +
#'   , x = rnorm(15)
345 +
#'   , y = rnorm(15)
346 +
#'   , z = rnorm(15)
347 +
#'   , m = rnorm(15)
348 +
#'   , val = letters[1:15]
349 +
#'   , stringsAsFactors = FALSE
350 +
#' )
351 +
#'
352 +
#' ## using keep = TRUE means the first row of all non-geometries are kept
353 +
#' sf_polygon(
354 +
#'   obj = df
355 +
#'   , polygon_id = "ml_id"
356 +
#'   , linestring_id = "l_id"
357 +
#'   , x = "x"
358 +
#'   , y = "y"
359 +
#'   , keep = TRUE
360 +
#' )
361 +
#'
362 +
#' ## use 'list_column' to specify columns where you want to keep all the values
363 +
#' sf_polygon(
364 +
#'   obj = df
365 +
#'   , polygon_id = "ml_id"
366 +
#'   , linestring_id = "l_id"
367 +
#'   , x = "x"
368 +
#'   , y = "y"
369 +
#'   , keep = TRUE
370 +
#'   , list_columns = "val"
371 +
#' )
372 +
#'
373 +
#'
374 +
#'
267 375
#'
268 376
#'
269 377
#' @export
@@ -276,17 +384,30 @@
Loading
276 384
  polygon_id = NULL,
277 385
  linestring_id = NULL,
278 386
  close = TRUE,
279 -
  keep = FALSE
387 +
  keep = FALSE,
388 +
  list_columns = NULL
280 389
  ) {
281 390
  geometry_columns <- c(x,y,z,m)
282 -
  res <- rcpp_sf_polygon(
283 -
    obj
284 -
    , index_correct( geometry_columns )
285 -
    , index_correct( polygon_id )
286 -
    , index_correct( linestring_id )
287 -
    , close
288 -
    , keep
391 +
  geometry_columns <- index_correct( geometry_columns )
392 +
  linestring_id <- index_correct( linestring_id )
393 +
  polygon_id <- index_correct( polygon_id )
394 +
  list_columns <- index_correct( list_columns )
395 +
  res <- return(
396 +
    rcpp_to_sf(
397 +
      obj,
398 +
      geometry_columns
399 +
      , NULL ## multipoint_id
400 +
      , linestring_id ## linestring_id
401 +
      , NULL ## multilinestring_id
402 +
      , polygon_id ## polygon_id
403 +
      , NULL ## multipolygon_id
404 +
      , list_columns ## list_columns
405 +
      , close ## Close
406 +
      , keep ## keep
407 +
      , "POLYGON"
289 408
    )
409 +
  )
410 +
290 411
  return( replace_id( res, polygon_id ) )
291 412
}
292 413
@@ -376,21 +497,35 @@
Loading
376 497
  polygon_id = NULL,
377 498
  linestring_id = NULL,
378 499
  close = TRUE,
379 -
  keep = FALSE
500 +
  keep = FALSE,
501 +
  list_columns = NULL
380 502
  ) {
503 +
381 504
  geometry_columns <- c(x,y,z,m)
382 -
  res <- rcpp_sf_multipolygon(
383 -
    obj
384 -
    , index_correct( geometry_columns )
385 -
    , index_correct( multipolygon_id )
386 -
    , index_correct( polygon_id )
387 -
    , index_correct( linestring_id )
388 -
    , close
389 -
    , keep
505 +
  geometry_columns <- index_correct( geometry_columns )
506 +
  linestring_id <- index_correct( linestring_id )
507 +
  polygon_id <- index_correct( polygon_id )
508 +
  multipolygon_id <- index_correct( multipolygon_id )
509 +
  list_columns <- index_correct( list_columns )
510 +
  res <- return(
511 +
    rcpp_to_sf(
512 +
      obj,
513 +
      geometry_columns
514 +
      , NULL ## multipoint_id
515 +
      , linestring_id ## linestring_id
516 +
      , NULL ## multilinestring_id
517 +
      , polygon_id ## polygon_id
518 +
      , multipolygon_id ## multipolygon_id
519 +
      , list_columns ## list_columns
520 +
      , close ## Close
521 +
      , keep ## keep
522 +
      , "MULTIPOLYGON"
390 523
    )
524 +
  )
391 525
  return( replace_id( res, multipolygon_id ) )
392 526
}
393 527
528 +
394 529
replace_id <- function( x, id ) {
395 530
  if( is.character( id ) ) {
396 531
    names( x )[ names( x ) == "id" ] <- id

@@ -2,6 +2,7 @@
Loading
2 2
#define R_SFHEADERS_SF_UTILS_H
3 3
4 4
#include "sfheaders/utils/vectors/vectors.hpp"
5 +
#include "sfheaders/utils/lists/list.hpp"
5 6
6 7
namespace sfheaders {
7 8
namespace sf {
@@ -64,9 +65,10 @@
Loading
64 65
      Rcpp::List& sfc,
65 66
      Rcpp::StringVector& property_cols,
66 67
      Rcpp::IntegerVector& property_idx,
67 -
      Rcpp::IntegerVector& row_idx
68 +
      Rcpp::IntegerVector& list_column_idx,
69 +
      Rcpp::IntegerVector& row_idx,
70 +
      Rcpp::IntegerMatrix& line_positions
68 71
  ) {
69 -
70 72
    R_xlen_t n_col = property_idx.length();
71 73
    Rcpp::List sf( n_col + 1 );  // +1 == sfc
72 74
    Rcpp::StringVector res_names( n_col + 1 );
@@ -75,8 +77,14 @@
Loading
75 77
    // fill columns of properties
76 78
    for( i = 0; i < n_col; ++i ) {
77 79
      int idx = property_idx[i];
80 +
      bool is_in = ( std::find( list_column_idx.begin(), list_column_idx.end(), idx ) != list_column_idx.end()  );
78 81
      SEXP v = df[ idx ];
79 -
      sf[ i ] = subset_properties( v, row_idx );
82 +
83 +
      if( is_in ) {
84 +
        sf[ i ] = sfheaders::utils::fill_list( v, line_positions );
85 +
      } else {
86 +
        sf[ i ] = subset_properties( v, row_idx );
87 +
      }
80 88
      res_names[ i ] = property_cols[ i ];
81 89
    }
82 90
@@ -101,9 +109,12 @@
Loading
101 109
      Rcpp::String& id_column,
102 110
      Rcpp::StringVector& property_cols,
103 111
      Rcpp::IntegerVector& property_idx,
104 -
      Rcpp::IntegerVector& row_idx
112 +
      Rcpp::IntegerVector& list_column_idx,
113 +
      Rcpp::IntegerVector& row_idx,
114 +
      Rcpp::IntegerMatrix& line_positions
105 115
  ) {
106 116
117 +
    // Rcpp::Rcout << "create_sf(df) + id " << std::endl;
107 118
    R_xlen_t n_col = property_idx.length();
108 119
    Rcpp::List sf( n_col + 2 );  // +1 == sfc, +1 == sf_id
109 120
    Rcpp::StringVector res_names( n_col + 2 );
@@ -111,9 +122,21 @@
Loading
111 122
112 123
    // fill columns of properties
113 124
    for( i = 0; i < n_col; ++i ) {
114 -
      int idx = property_idx[i];
125 +
      int idx = property_idx[ i ];
126 +
127 +
      // Rcpp::Rcout << "idx: " << idx << std::endl;
128 +
      // Rcpp::Rcout << "lst_columns: " << list_column_idx << std::endl;
129 +
130 +
      bool is_in = ( std::find( list_column_idx.begin(), list_column_idx.end(), idx ) != list_column_idx.end()  );
115 131
      SEXP v = df[ idx ];
116 -
      sf[ i + 1 ] = subset_properties( v, row_idx );
132 +
      if( is_in ) {
133 +
        sf[ i + 1 ] = sfheaders::utils::fill_list( v, line_positions );
134 +
      } else {
135 +
        sf[ i + 1 ] = subset_properties( v, row_idx );
136 +
      }
137 +
138 +
      //SEXP v = df[ idx ];
139 +
      //sf[ i + 1 ] = subset_properties( v, row_idx );
117 140
      res_names[ i + 1 ] = property_cols[ i ];
118 141
    }
119 142
@@ -140,23 +163,22 @@
Loading
140 163
  inline SEXP create_sf(
141 164
      Rcpp::DataFrame& df,
142 165
      Rcpp::List& sfc,
143 -
      SEXP& property_columns
166 +
      SEXP& property_columns,
167 +
      Rcpp::IntegerVector& list_column_idx,
168 +
      Rcpp::IntegerMatrix& line_positions
144 169
  ) {
145 170
171 +
    //Rcpp::Rcout << "create_sf(df)" << std::endl;
146 172
    Rcpp::StringVector df_names = df.names();
147 173
    Rcpp::StringVector str_property_columns;
148 174
149 175
    switch( TYPEOF( property_columns ) ) {
176 +
    case REALSXP: {}
150 177
    case INTSXP: {
151 178
      Rcpp::IntegerVector iv = Rcpp::as< Rcpp::IntegerVector >( property_columns );
152 179
      str_property_columns = df_names[ iv ];
153 180
      break;
154 181
    }
155 -
    case REALSXP: {
156 -
      Rcpp::NumericVector nv = Rcpp::as< Rcpp::NumericVector >( property_columns );
157 -
      str_property_columns = df_names[ nv ];
158 -
      break;
159 -
    }
160 182
    case STRSXP: {
161 183
      str_property_columns = Rcpp::as< Rcpp::StringVector >( property_columns );
162 184
      break;
@@ -171,14 +193,18 @@
Loading
171 193
    row_idx[0] = 0;
172 194
173 195
    Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( str_property_columns, df_names );
174 -
    return sfheaders::sf::create_sf( df, sfc, str_property_columns, property_idx, row_idx );
196 +
    return sfheaders::sf::create_sf( df, sfc, str_property_columns, property_idx, list_column_idx, row_idx, line_positions );
175 197
  }
176 198
177 199
  inline SEXP create_sf(
178 200
      SEXP& x,
179 201
      Rcpp::List& sfc,
180 -
      SEXP& property_columns
202 +
      SEXP& property_columns,
203 +
      Rcpp::IntegerVector& list_column_idx,
204 +
      Rcpp::IntegerMatrix& line_positions
181 205
  ) {
206 +
207 +
    //Rcpp::Rcout << "create_sf(x)" << std::endl;
182 208
    Rcpp::DataFrame df;
183 209
    switch( TYPEOF( x ) ) {
184 210
    case INTSXP: {
@@ -199,9 +225,18 @@
Loading
199 225
      Rcpp::stop("sfheaders - unknown type"); // #nocov
200 226
    }
201 227
    }
202 -
    return create_sf( df, sfc, property_columns );
228 +
    return create_sf( df, sfc, property_columns, list_column_idx, line_positions );
203 229
  }
204 230
231 +
  // inline SEXP create_sf(
232 +
  //   SEXP& x,
233 +
  //   Rcpp::List& sfc,
234 +
  //   SEXP& property_columns,
235 +
  //   SEXP& list_columns
236 +
  // ) {
237 +
  //
238 +
  // }
239 +
205 240
  inline SEXP make_sf( Rcpp::List& sfc ) {
206 241
207 242
    Rcpp::List df = Rcpp::List::create(

@@ -30,11 +30,27 @@
Loading
30 30
  ) {
31 31
32 32
    Rcpp::IntegerVector row_idx = Rcpp::seq( 0, df.nrow() - 1 );
33 +
    Rcpp::IntegerMatrix line_positions( df.nrow(), 2 );
34 +
    line_positions( Rcpp::_, 0 ) = row_idx;
35 +
    line_positions( Rcpp::_, 1 ) = row_idx + 1;
36 +
33 37
    Rcpp::StringVector df_names = df.names();
34 38
    Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( property_cols, df_names );
35 39
    Rcpp::List sfc = sfheaders::sfc::sfc_point( df, geometry_cols );
36 40
37 -
    return sfheaders::sf::create_sf( df, sfc, property_cols, property_idx, row_idx );
41 +
    Rcpp::List res = Rcpp::List::create(
42 +
      Rcpp::_["df"] = df,
43 +
      Rcpp::_["sfc"] = sfc,
44 +
      //Rcpp::_["id_column"] = id_column,
45 +
      Rcpp::_["property_cols"] = property_cols,
46 +
      Rcpp::_["property_idx"] = property_idx,
47 +
      Rcpp::_["row_idx"] = row_idx,
48 +
      Rcpp::_["line_positions"] = line_positions
49 +
    );
50 +
51 +
    return res;
52 +
53 +
    //return sfheaders::sf::create_sf( df, sfc, property_cols, property_idx, row_idx );
38 54
  }
39 55
40 56
  inline SEXP sf_point(

@@ -16,29 +16,7 @@
Loading
16 16
  return sfheaders::df::sf_to_df( sf, fill );
17 17
}
18 18
19 -
// // TODO - remove this function for release
20 -
// // [[Rcpp::export]]
21 -
// SEXP rcpp_get_sfg_coordinates( SEXP sfg ) {
22 -
//   R_xlen_t sfc_rows = 0;
23 -
//
24 -
//   Rcpp::CharacterVector cls;
25 -
//   std::string dim;
26 -
//   std::string sfg_class;
27 -
//   int sfg_type;
28 -
//
29 -
//   cls = sfheaders::utils::getSfgClass( sfg );
30 -
//
31 -
//   dim = cls[0];
32 -
//
33 -
//   sfg_class = cls[1];
34 -
//   sfg_type = sfheaders::df::get_sfg_type( sfg_class );
35 -
//   return sfheaders::df::get_sfg_coordinates( sfg, sfc_rows, sfg_type );
36 -
// }
37 -
38 -
// // TODO - remove ths function for release
39 -
// // [[Rcpp::export]]
40 -
// Rcpp::List rcpp_collapse_list( Rcpp::List lst ) {
41 -
//
42 -
//   R_xlen_t total_rows = 5;
43 -
//   return sfheaders::df::collapse_list( lst, total_rows );
44 -
// }
19 +
// [[Rcpp::export]]
20 +
SEXP rcpp_sf_to_df_unlist( Rcpp::DataFrame sf, Rcpp::StringVector unlist, bool fill = false ) {
21 +
  return sfheaders::df::sf_to_df( sf, unlist, fill );
22 +
}

@@ -5,169 +5,6 @@
Loading
5 5
6 6
#include "sfheaders/sfc/sfc.hpp"
7 7
8 -
// // [[Rcpp::export]]
9 -
// SEXP rcpp_sfg_cast_df( SEXP sfg ) {
10 -
//   return sfheaders::cast::sfg_to_cast_df( sfg );
11 -
// }
12 -
//
13 -
//
14 -
// // [[Rcpp::export]]
15 -
// SEXP rcpp_sfc_cast_df( Rcpp::List sfc ) {
16 -
//   return sfheaders::cast::sfc_to_cast_df( sfc );
17 -
// }
18 -
19 -
// // [[Rcpp::export]]
20 -
// SEXP rcpp_vec_to_vec( Rcpp::NumericVector sfg ) {
21 -
//   double id = 1;
22 -
//   R_xlen_t sfg_rows = 0;
23 -
//   return sfheaders::cast::vec_to_vec( sfg, sfg_rows, id );
24 -
// }
25 -
//
26 -
// // [[Rcpp::export]]
27 -
// SEXP rcpp_mat_to_vec( Rcpp::NumericMatrix sfg ) {
28 -
//   double id = 1;
29 -
//   R_xlen_t sfg_rows = 0;
30 -
//   return sfheaders::cast::mat_to_vec( sfg, sfg_rows, id );
31 -
// }
32 -
//
33 -
// // [[Rcpp::export]]
34 -
// SEXP rcpp_listMat_to_vec( Rcpp::List sfg ) {
35 -
//   double id = 1;
36 -
//   R_xlen_t sfg_rows = 0;
37 -
//   return sfheaders::cast::listMat_to_vec( sfg, sfg_rows, id );
38 -
// }
39 -
//
40 -
// // [[Rcpp::export]]
41 -
// SEXP rcpp_listListMat_to_vec( Rcpp::List sfg ) {
42 -
//   double id = 1;
43 -
//   R_xlen_t sfg_rows = 0;
44 -
//   return sfheaders::cast::listListMat_to_vec( sfg, sfg_rows, id );
45 -
// }
46 -
//
47 -
// // [[Rcpp::export]]
48 -
// SEXP rcpp_vec_to_mat( Rcpp::NumericVector sfg ) {
49 -
//   double id = 1;
50 -
//   R_xlen_t sfg_rows = 0;
51 -
//   return sfheaders::cast::vec_to_mat( sfg, sfg_rows, id );
52 -
// }
53 -
//
54 -
// // [[Rcpp::export]]
55 -
// SEXP rcpp_mat_to_mat( Rcpp::NumericMatrix sfg ) {
56 -
//   double id = 1;
57 -
//   R_xlen_t sfg_rows = 0;
58 -
//   return sfheaders::cast::mat_to_mat( sfg, sfg_rows, id );
59 -
// }
60 -
//
61 -
//
62 -
// // [[Rcpp::export]]
63 -
// SEXP rcpp_listMat_to_mat( Rcpp::List sfg ) {
64 -
//   double id = 1;
65 -
//   R_xlen_t sfg_rows = 0;
66 -
//   return sfheaders::cast::listMat_to_mat( sfg, sfg_rows, id );
67 -
// }
68 -
//
69 -
//
70 -
// // [[Rcpp::export]]
71 -
// SEXP rcpp_listListMat_to_mat( Rcpp::List sfg ) {
72 -
//   double id = 1;
73 -
//   R_xlen_t sfg_rows = 0;
74 -
//   return sfheaders::cast::listListMat_to_mat( sfg, sfg_rows, id );
75 -
// }
76 -
//
77 -
// // [[Rcpp::export]]
78 -
// SEXP rcpp_vec_to_listMat( Rcpp::NumericVector sfg ) {
79 -
//   double id = 1;
80 -
//   R_xlen_t sfg_rows = 0;
81 -
//   return sfheaders::cast::vec_to_listMat( sfg, sfg_rows, id );
82 -
// }
83 -
//
84 -
// // [[Rcpp::export]]
85 -
// SEXP rcpp_mat_to_listMat( Rcpp::NumericMatrix sfg ) {
86 -
//   double id = 1;
87 -
//   R_xlen_t sfg_rows = 0;
88 -
//   return sfheaders::cast::mat_to_listMat( sfg, sfg_rows, id );
89 -
// }
90 -
//
91 -
// // [[Rcpp::export]]
92 -
// SEXP rcpp_listMat_to_listMat( Rcpp::List sfg ) {
93 -
//   double id = 1;
94 -
//   R_xlen_t sfg_rows = 0;
95 -
//   return sfheaders::cast::listMat_to_listMat( sfg, sfg_rows, id );
96 -
// }
97 -
//
98 -
//
99 -
// // [[Rcpp::export]]
100 -
// SEXP rcpp_listListMat_to_listMat( Rcpp::List sfg ) {
101 -
//   double id = 1;
102 -
//   R_xlen_t sfg_rows = 0;
103 -
//   return sfheaders::cast::listListMat_to_listMat( sfg, sfg_rows, id );
104 -
// }
105 -
//
106 -
// // [[Rcpp::export]]
107 -
// SEXP rcpp_vec_to_listListMat( Rcpp::NumericVector sfg ) {
108 -
//   double id = 1;
109 -
//   R_xlen_t sfg_rows = 0;
110 -
//   return sfheaders::cast::vec_to_listListMat( sfg, sfg_rows, id );
111 -
// }
112 -
//
113 -
// // [[Rcpp::export]]
114 -
// SEXP rcpp_mat_to_listListMat( Rcpp::NumericMatrix sfg ) {
115 -
//   double id = 1;
116 -
//   R_xlen_t sfg_rows = 0;
117 -
//   return sfheaders::cast::mat_to_listListMat( sfg, sfg_rows, id );
118 -
// }
119 -
//
120 -
// // [[Rcpp::export]]
121 -
// SEXP rcpp_listMat_to_listListMat( Rcpp::List sfg ) {
122 -
//   double id = 1;
123 -
//   R_xlen_t sfg_rows = 0;
124 -
//   return sfheaders::cast::listMat_to_listListMat( sfg, sfg_rows, id );
125 -
// }
126 -
//
127 -
// // [[Rcpp::export]]
128 -
// SEXP rcpp_listListMat_to_listListMat( Rcpp::List sfg ) {
129 -
//   double id = 1;
130 -
//   R_xlen_t sfg_rows = 0;
131 -
//   return sfheaders::cast::listListMat_to_listListMat( sfg, sfg_rows, id );
132 -
// }
133 -
//
134 -
// // [[Rcpp::export]]
135 -
// SEXP rcpp_sfc_polygon_to_sfc_multipolygon( Rcpp::List sfc ) {
136 -
//   double id = 1;
137 -
//   R_xlen_t sfg_rows = 0;
138 -
//   R_xlen_t i;
139 -
//   R_xlen_t n = sfc.size();
140 -
//   Rcpp::List res( n );
141 -
//   for( i = 0; i < n; ++i ) {
142 -
//     Rcpp::List sfg = sfc[ i ];
143 -
//     res[ i ] = sfheaders::cast::listMat_to_listListMat( sfg, sfg_rows, id );
144 -
//   }
145 -
//
146 -
//   // make res a sfc_multipolygon
147 -
//   return sfheaders::df::collapse_list( res, sfg_rows );
148 -
//
149 -
//   // Rcpp::List res2 = sfheaders::df::collapse_list( res, sfg_rows );
150 -
//   //
151 -
//   // Rcpp::DataFrame df = Rcpp::DataFrame::create(
152 -
//   //   Rcpp::_["x"] = res2[ 4 ],
153 -
//   //   Rcpp::_["y"] = res2[ 5 ],
154 -
//   //   Rcpp::_["mp_id"] = res2[ 1 ],
155 -
//   //   Rcpp::_["p_id"] = res2[ 2 ],
156 -
//   //   Rcpp::_["l_id"] = res2[ 3 ]
157 -
//   // );
158 -
//   //
159 -
//   // Rcpp::IntegerVector geometry_cols({0,2});
160 -
//   // int mpid = 2;
161 -
//   // int pid = 3;
162 -
//   // int lid = 4;
163 -
//   //
164 -
//   //
165 -
//   // return sfheaders::sfc::sfc_multipolygon(
166 -
//   //   df, geometry_cols, mpid, pid, lid
167 -
//   // );
168 -
//   // //return df;
169 -
// }
170 -
171 8
// [[Rcpp::export]]
172 9
Rcpp::NumericVector rcpp_count_new_objects( SEXP sfg, std::string cast_to ) {
173 10
  R_xlen_t x = sfheaders::cast::count_new_objects( sfg, cast_to );

@@ -18,6 +18,8 @@
Loading
18 18
    SEXP& linestring_id
19 19
  ) {
20 20
21 +
    // Rcpp::Rcout << "sf_linestring1 " << std::endl;
22 +
21 23
    Rcpp::List sfc = sfheaders::sfc::sfc_linestring( x, geometry_cols, linestring_id );
22 24
    // TODO: we're getting the linestring_ids inside sfc_linestring,
23 25
    // and re-doing it here... say what...
@@ -33,14 +35,30 @@
Loading
33 35
      Rcpp::String& id_column,
34 36
      SEXP& line_ids
35 37
  ) {
38 +
39 +
    // Rcpp::Rcout << "sf_linestring2 " << std::endl;
40 +
36 41
    Rcpp::IntegerMatrix line_positions = sfheaders::utils::id_positions( line_ids );
37 42
    Rcpp::IntegerVector row_idx = line_positions( Rcpp::_, 0 );
43 +
38 44
    Rcpp::StringVector df_names = df.names();
39 45
    Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( property_cols, df_names );
40 46
41 47
    Rcpp::List sfc = sfheaders::sfc::sfc_linestring( df, geometry_cols, line_positions );
42 48
43 -
    return sfheaders::sf::create_sf( df, sfc, id_column, property_cols, property_idx, row_idx );
49 +
    Rcpp::List res = Rcpp::List::create(
50 +
      Rcpp::_["df"] = df,
51 +
      Rcpp::_["sfc"] = sfc,
52 +
      Rcpp::_["id_column"] = id_column,
53 +
      Rcpp::_["property_cols"] = property_cols,
54 +
      Rcpp::_["property_idx"] = property_idx,
55 +
      Rcpp::_["row_idx"] = row_idx,
56 +
      Rcpp::_["line_positions"] = line_positions
57 +
    );
58 +
59 +
    return res;
60 +
61 +
    //return sfheaders::sf::create_sf( df, sfc, id_column, property_cols, property_idx, row_idx );
44 62
  }
45 63
46 64
  inline SEXP sf_linestring(
@@ -215,7 +233,21 @@
Loading
215 233
    if( Rf_isNull( linestring_id ) ) {
216 234
      Rcpp::List sfc = sfheaders::sfc::sfc_linestring( x, geometry_cols, linestring_id );
217 235
      SEXP property_columns = sfheaders::utils::other_columns( x, geometry_cols );
218 -
      return sfheaders::sf::create_sf( x, sfc, property_columns );
236 +
237 +
      Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( property_columns, x );
238 +
      Rcpp::IntegerMatrix line_positions(1,2);
239 +
      line_positions(0,0) = 0;
240 +
      line_positions(0,1) = sfheaders::utils::sexp_n_row( x ) - 1;
241 +
242 +
      Rcpp::List res = Rcpp::List::create(
243 +
        Rcpp::_["x"] = x,
244 +
        Rcpp::_["sfc"] = sfc,
245 +
        Rcpp::_["property_cols"] = property_columns,
246 +
        Rcpp::_["property_idx"] = property_idx,
247 +
        Rcpp::_["line_positions"] = line_positions
248 +
      );
249 +
250 +
      return res;
219 251
    }
220 252
221 253
    if( !Rf_isNull( linestring_id ) ) {

@@ -3,6 +3,7 @@
Loading
3 3
4 4
#include "sfheaders/df/sfc.hpp"
5 5
#include "sfheaders/utils/vectors/vectors.hpp"
6 +
#include "sfheaders/utils/lists/list.hpp"
6 7
7 8
#include <Rcpp.h>
8 9
@@ -156,7 +157,6 @@
Loading
156 157
      keep_columns[ i ] = is_in == -1 ? false : true;
157 158
    }
158 159
159 -
    //Rcpp::Rcout << "keep: " << keep_columns << std::endl;
160 160
161 161
    for( i = 0; i < sfc_cols; ++i ) {
162 162
      Rcpp::String this_name = unique_name( sfc_df_names[ i ], res_names );
@@ -171,18 +171,6 @@
Loading
171 171
    res.attr("sfc_columns") = sfc_df_names[ keep_columns ];
172 172
    return sfheaders::utils::make_dataframe( res, total_coordinates, res_names );
173 173
174 -
    // res.attr("class") = Rcpp::CharacterVector("data.frame");
175 -
    //
176 -
    //
177 -
    // if( total_coordinates > 0 ) {
178 -
    //   Rcpp::IntegerVector rownames = Rcpp::seq( 1, total_coordinates );
179 -
    //   res.attr("row.names") = rownames;
180 -
    // } else {
181 -
    //   res.attr("row.names") = Rcpp::IntegerVector(0);  // #nocov
182 -
    // }
183 -
    //
184 -
    // res.attr("names") = res_names;
185 -
    // return res;
186 174
  }
187 175
188 176
  inline Rcpp::List sf_to_df(
@@ -199,6 +187,66 @@
Loading
199 187
    return sf_to_df( sf, sfc, geom_column, sfc_coordinates, fill );
200 188
  }
201 189
190 +
  inline Rcpp::List sf_to_df(
191 +
      Rcpp::DataFrame& sf,
192 +
      Rcpp::List& sfc,
193 +
      std::string& geom_column,
194 +
      Rcpp::NumericMatrix& sfc_coordinates,
195 +
      Rcpp::StringVector& unlist,
196 +
      bool fill = false
197 +
  ) {
198 +
    if( !sf.hasAttribute("sf_column") ) {
199 +
      Rcpp::stop("sfheaders - sf_column not found");
200 +
    }
201 +
202 +
    if( Rf_isNull( unlist ) ) {
203 +
      return sf_to_df( sf, fill );
204 +
    }
205 +
206 +
    R_xlen_t n_unlist = unlist.size();
207 +
    R_xlen_t i;
208 +
    Rcpp::List to_unlist( n_unlist );
209 +
210 +
    for( i = 0; i < n_unlist; ++i ) {
211 +
      const char *s = unlist[ i ];
212 +
      Rcpp::List lst = sf[ s ];
213 +
      to_unlist[ i ] = sfheaders::utils::unlist_list( lst );
214 +
    }
215 +
216 +
    to_unlist.names() = unlist;
217 +
218 +
    // std::string geom_column = sf.attr("sf_column");
219 +
    // Rcpp::List sfc = sf[ geom_column ];
220 +
    // Rcpp::NumericMatrix sfc_coordinates = sfc_n_coordinates( sfc );
221 +
    Rcpp::DataFrame res = sf_to_df( sf, sfc, geom_column, sfc_coordinates, fill );
222 +
223 +
    R_xlen_t n_row = res.nrow();
224 +
225 +
    for( i = 0; i < n_unlist; ++i ) {
226 +
      const char *s = unlist[ i ];
227 +
      SEXP unlisted_col = to_unlist[ i ];
228 +
      R_xlen_t n = sfheaders::utils::get_sexp_length( unlisted_col );
229 +
      if( n != n_row ) {
230 +
        Rcpp::stop("sfheaders - unlisted column doesn't have the correct number of rows");
231 +
      }
232 +
      res[ s ] = to_unlist[ i ];
233 +
    }
234 +
235 +
    return sfheaders::utils::make_dataframe( res, n_row );
236 +
  }
237 +
238 +
  inline Rcpp::List sf_to_df(
239 +
      Rcpp::DataFrame& sf,
240 +
      Rcpp::StringVector& unlist,
241 +
      bool fill = false
242 +
  ) {
243 +
    std::string geom_column = sf.attr("sf_column");
244 +
    Rcpp::List sfc = sf[ geom_column ];
245 +
    Rcpp::NumericMatrix sfc_coordinates = sfc_n_coordinates( sfc );
246 +
247 +
    return sf_to_df( sf, sfc, geom_column, sfc_coordinates, unlist, fill );
248 +
  }
249 +
202 250
203 251
} // df
204 252
} // sfheaders

@@ -46,7 +46,19 @@
Loading
46 46
47 47
    Rcpp::List sfc = sfheaders::sfc::sfc_polygon( df, geometry_cols, line_ids, polygon_positions, close );
48 48
49 -
    return sfheaders::sf::create_sf( df, sfc, id_column, property_cols, property_idx, row_idx );
49 +
    Rcpp::List res = Rcpp::List::create(
50 +
      Rcpp::_["df"] = df,
51 +
      Rcpp::_["sfc"] = sfc,
52 +
      Rcpp::_["id_column"] = id_column,
53 +
      Rcpp::_["property_cols"] = property_cols,
54 +
      Rcpp::_["property_idx"] = property_idx,
55 +
      Rcpp::_["row_idx"] = row_idx,
56 +
      Rcpp::_["line_positions"] = polygon_positions
57 +
    );
58 +
59 +
    return res;
60 +
61 +
    //return sfheaders::sf::create_sf( df, sfc, id_column, property_cols, property_idx, row_idx );
50 62
  }
51 63
52 64
  inline SEXP sf_polygon(
@@ -262,14 +274,42 @@
Loading
262 274
      // the entire object is a polygon
263 275
      Rcpp::List sfc = sfheaders::sfc::sfc_polygon( x, geometry_cols, polygon_id, linestring_id, close );
264 276
      SEXP property_columns = sfheaders::utils::other_columns( x, geometry_cols, linestring_id );
265 -
      return sfheaders::sf::create_sf( x, sfc, property_columns );
277 +
278 +
      Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( property_columns, x );
279 +
      Rcpp::IntegerMatrix line_positions(1,2);
280 +
      line_positions(0,0) = 0;
281 +
      line_positions(0,1) = sfheaders::utils::sexp_n_row( x ) - 1;
282 +
283 +
      Rcpp::List res = Rcpp::List::create(
284 +
        Rcpp::_["x"] = x,
285 +
        Rcpp::_["sfc"] = sfc,
286 +
        Rcpp::_["property_cols"] = property_columns,
287 +
        Rcpp::_["property_idx"] = property_idx,
288 +
        Rcpp::_["line_positions"] = line_positions
289 +
      );
290 +
291 +
      return res;
266 292
    }
267 293
268 294
    if( Rf_isNull( polygon_id ) && Rf_isNull( linestring_id ) ) {
269 295
      // the entire object is a polygon
270 296
      Rcpp::List sfc = sfheaders::sfc::sfc_polygon( x, geometry_cols, polygon_id, linestring_id, close );
271 297
      SEXP property_columns = sfheaders::utils::other_columns( x, geometry_cols );
272 -
      return sfheaders::sf::create_sf( x, sfc, property_columns );
298 +
299 +
      Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( property_columns, x );
300 +
      Rcpp::IntegerMatrix line_positions(1,2);
301 +
      line_positions(0,0) = 0;
302 +
      line_positions(0,1) = sfheaders::utils::sexp_n_row( x ) - 1;
303 +
304 +
      Rcpp::List res = Rcpp::List::create(
305 +
        Rcpp::_["x"] = x,
306 +
        Rcpp::_["sfc"] = sfc,
307 +
        Rcpp::_["property_cols"] = property_columns,
308 +
        Rcpp::_["property_idx"] = property_idx,
309 +
        Rcpp::_["line_positions"] = line_positions
310 +
      );
311 +
312 +
      return res;
273 313
    }
274 314
275 315
    if( !Rf_isNull( polygon_id ) && !Rf_isNull( linestring_id ) ) {
@@ -315,7 +355,6 @@
Loading
315 355
    return Rcpp::List::create(); // ??
316 356
  }
317 357
318 -
319 358
} // sf
320 359
} // sfheaders
321 360

@@ -0,0 +1,288 @@
Loading
1 +
2 +
name_matcher <- function(x, ...) {
3 +
  args <- list(obj = NULL,
4 +
               x = "x",
5 +
               y = "y",
6 +
               z = "z",
7 +
               m = "m",
8 +
               multipolygon_id = "multipolygon_id",
9 +
               polygon_id = "polygon_id",
10 +
               multilinestring_id = "multilinestring_id",
11 +
               linestring_id = "linestring_id",
12 +
               multipoint_id = "multipoint_id")
13 +
  ## return the list args that make sense for this data frame
14 +
  args[base::intersect(colnames(x), names(args))]
15 +
}
16 +
## ensure constructor has access to all required columns for this type
17 +
check_columns <- function(x, req_names, fun_name) {
18 +
  found <- req_names %in% colnames(x)
19 +
  if (sum(found) < length(req_names)) {
20 +
    stop(sprintf("'%s()' requires columns:  %s", fun_name,
21 +
                 paste(req_names, collapse = ", ")), call. = FALSE)
22 +
  }
23 +
  invisible(NULL)
24 +
}
25 +
26 +
#' Helper for sf POINT
27 +
#'
28 +
#' Constructs sf of POINT objects, a helper for [sf_point()] with a simpler
29 +
#' syntax.
30 +
#'
31 +
#' @section Helpers:
32 +
#' These are simpler versions of the main functions [sf_point()],
33 +
#' [sf_multipoint()], [sf_linestring()], [sf_multilinestring()], [sf_polygon()],
34 +
#' and [sf_multipolygon()] for input data frame or matrix that contains columns
35 +
#' appropriately of 'x', 'y', 'z', 'm', ' multipolygon_id', polygon_id',
36 +
#' 'multilinestring_id', 'linestring_id', 'multipoint_id'.
37 +
#'
38 +
#' This puts the onus of the naming and identification of entities onto the
39 +
#' input data set, rather than when calling the creator function. This has pros
40 +
#' and cons, so is not necessarily always 'simpler'. Please choose the
41 +
#' appropriate constructor for the context you have. For examples a data frame
42 +
#' from the real world with columns 'lon', 'lat', 'line' will be best used with
43 +
#'
44 +
#' `sf_linestring(df, x = "lon", y = "lat", linestring_id = "line")`
45 +
#'
46 +
#' whereas a heavy user of sfheaders might always create a data frame with 'x',
47 +
#' 'y', 'linestring_id' precisely because they are expecting to call
48 +
#' `sf_line(df)` and no further work is required. These are very different
49 +
#' contexts and both equally valid.
50 +
#'
51 +
#' Some columns are mandatory, such as 'x' and 'y' (always), while others depend
52 +
#' on the output type where each column for that type is mandatory. The 'z'
53 +
#' and/or 'm' values are included for 'XYZ', 'XYM', or 'XYZM' geometry types if
54 +
#' and as they are present.
55 +
#'
56 +
#' In summary these helpers:
57 +
#'
58 +
#' * do not require arguments declaring column names.
59 +
#' * use assumed default column names, with no variation or absence allowed for
60 +
#'  a given type.
61 +
#' * use `z`, and/or `m` if present.
62 +
#' * use `close = FALSE` and `keep = FALSE` same as proper constructors.
63 +
#' * unlike [sf_point()] [sf_pt()] does not accept a flat vector for a single
64 +
#'  point.
65 +
#' * require a matrix or data frame with complete column names.
66 +
#'
67 +
#' None of the helpers allow partial name matching for column names.
68 +
#'
69 +
#' @inheritParams sf_point
70 +
#' @inheritSection sfc_point notes
71 +
#' @inheritSection sf_point Keeping Properties
72 +
#' @return \code{sf} object of POINT geometries
73 +
#' @examples
74 +
#'
75 +
#' x <- cbind(x = 1, y= 3)
76 +
#' sf_pt( x )
77 +
#' sf_pt(cbind(x, z = 2))
78 +
#'
79 +
#' x <- matrix( c(1:10) , ncol = 2 , dimnames = list(NULL, c("x", "y")))
80 +
#' sf_pt( x )
81 +
#'
82 +
#' x <- setNames( as.data.frame( x ), c("x","y") )
83 +
#' sf_pt( x )
84 +
#'
85 +
#' # keeping properties
86 +
#' x$val <- letters[1:5]
87 +
#' (sfx <- sf_pt( x, keep = TRUE ))
88 +
#'
89 +
#' ## we trivially round-trip with sf_pt()
90 +
#' sf_pt(sf_to_df(sfx, fill = TRUE), keep = TRUE)
91 +
#' @export
92 +
sf_pt <- function(obj, keep = FALSE) {
93 +
  check_columns(obj, c("x", "y"), "sf_pt")
94 +
  call_args <- name_matcher(obj)
95 +
  call_args[c("obj", "keep")] <- list(obj, keep)
96 +
97 +
  call_args[c("multipolygon_id", "polygon_id",
98 +
              "multilinestring_id", "linestring_id", "multipoint_id")] <- NULL
99 +
  do.call(sfheaders::sf_point, call_args)
100 +
}
101 +
102 +
#' Helper for sf MULTIPOINT
103 +
#'
104 +
#' Constructs sf of MULTIPOINT objects, a helper for [sf_multipoint()] with a
105 +
#' simpler syntax.
106 +
#'
107 +
#' @inheritParams sf_point
108 +
#' @inheritSection sf_pt Helpers
109 +
#' @inheritSection sfc_point notes
110 +
#' @inheritSection sf_point Keeping Properties
111 +
#' @return \code{sf} object of MULTIPOINT geometries
112 +
#' @examples
113 +
#'
114 +
#' x <- cbind(x = 1:2, y = 3:4, multipoint_id = 1, ncol = 2 )
115 +
#' sf_mpt( x )
116 +
#'
117 +
#' x <- data.frame( id = 1:2, x = 1:2, y = 2:1, multipoint_id = 1)
118 +
#' sf_mpt( x )
119 +
#' sf_mpt( x, keep = TRUE)
120 +
#' x <- data.frame(multipoint_id = 1:2, id = 1:2, x = 1:2, y = 2:1 )
121 +
#' (sfx <- sf_mpt(x))
122 +
#'
123 +
#' ## we trivially round-trip with sf_mpt()
124 +
#' sf_mpt(sf_to_df(sfx))
125 +
#' @export
126 +
sf_mpt <- function(obj, keep = FALSE) {
127 +
  check_columns(obj, c("x", "y", "multipoint_id"), "sf_mpt")
128 +
  call_args <- name_matcher(obj)
129 +
  call_args[c("obj", "keep")] <- list(obj, keep)
130 +
131 +
  call_args[c("multipolygon_id", "polygon_id", "multilinestring_id",
132 +
              "linestring_id")] <- NULL
133 +
  do.call(sfheaders::sf_multipoint, call_args)
134 +
}
135 +
136 +
#' Helper for sf MULTIPOLYGON
137 +
#'
138 +
#' Constructs sf of MULTIPOLYGON objects, a helper for [sf_multipolygon()] with
139 +
#' a simpler syntax.
140 +
#'
141 +
#' @inheritParams sf_multipolygon
142 +
#' @inheritParams sf_point
143 +
#' @inheritSection sf_pt Helpers
144 +
#' @inheritSection sfc_point notes
145 +
#' @inheritSection sf_point Keeping Properties
146 +
#' @return \code{sf} object of MULTIPOLYGON geometries
147 +
#'
148 +
#'@examples
149 +
#'
150 +
#' m <- matrix(c(0,0,0,0,1,0,0,1,1,0,0,1,0,0,0), ncol = 3, byrow = TRUE,
151 +
#'       dimnames = list(NULL, c("x", "y", "z")))
152 +
#' m <- cbind(m, multipolygon_id = 1, polygon_id = 1, linestring_id = 1)
153 +
#' sf_mpoly( m )
154 +
#'
155 +
#' df <- as.data.frame(m)
156 +
#'
157 +
#' sf_mpoly( df)
158 +
#'
159 +
#' ## order doesn't matter, only the names are used
160 +
#' sf_mpoly(df[c(6, 5, 3, 4, 1, 2)])
161 +
#'
162 +
#' @export
163 +
sf_mpoly <- function(obj, close = TRUE, keep = FALSE) {
164 +
  check_columns(obj, c("x", "y", "multipolygon_id",
165 +
                  "polygon_id", "linestring_id"), "sf_mpoly")
166 +
  call_args <- name_matcher(obj)
167 +
  call_args[c("obj", "keep", "close")] <- list(obj, keep, close)
168 +
169 +
  call_args[c("multilinestring_id", "multipoint_id")] <- NULL
170 +
171 +
  do.call(sfheaders::sf_multipolygon, call_args)
172 +
}
173 +
#'Helper for sf POLYGON
174 +
#'
175 +
#'Constructs sf of POLYGON objects, a helper for [sf_polygon()] with a simpler
176 +
#'syntax.
177 +
#'
178 +
#'@inheritParams sf_multipolygon
179 +
#'@inheritParams sf_point
180 +
#'@inheritSection sf_pt Helpers
181 +
#'@inheritSection sfc_point notes
182 +
#'@inheritSection sf_point Keeping Properties
183 +
#'@return \code{sf} object of POLYGON geometries
184 +
#'
185 +
#'@examples
186 +
#'
187 +
#' m <- matrix(c(0,0,0,0,1,0,0,1,1,0,0,1,0,0,0), ncol = 3, byrow = TRUE,
188 +
#'       dimnames = list(NULL, c("x", "y", "z")))
189 +
#' m <- cbind(m, polygon_id = 1, linestring_id = 1)
190 +
#' sf_poly( m )
191 +
#'
192 +
#' df <- as.data.frame(m)
193 +
#'
194 +
#' sf_poly( df)
195 +
#'
196 +
#' ## order doesn't matter, only the names are used
197 +
#' sf_poly(df[c(5, 3, 4, 1, 2)])
198 +
#'
199 +
#'@export
200 +
sf_poly <- function(obj, close = TRUE, keep = FALSE) {
201 +
  check_columns(obj, c("x", "y", "polygon_id", "linestring_id"), "sf_poly")
202 +
  call_args <- name_matcher(obj)
203 +
  call_args[c("obj", "keep", "close")] <- list(obj, keep, close)
204 +
205 +
  call_args[c("multipolygon_id", "multilinestring_id", "multipoint_id")] <- NULL
206 +
  do.call(sfheaders::sf_polygon, call_args)
207 +
}
208 +
209 +
#' Helper for sf MULTILINESTRING
210 +
#'
211 +
#' Constructs sf of MULTILINESTRING objects, a helper for [sf_multilinestring()]
212 +
#' with a simpler syntax.
213 +
#'
214 +
#' @inheritParams sf_point
215 +
#' @inheritSection sf_pt Helpers
216 +
#' @inheritSection sfc_point notes
217 +
#' @inheritSection sf_point Keeping Properties
218 +
#' @return \code{sf} object of MULTILINESTRING geometries
219 +
#' @examples
220 +
#'
221 +
#' m <- cbind(x = 0, y = 0, multilinestring_id = c(1, 1, 1), linestring_id = 1)
222 +
#' sf_mline( m )
223 +
#'
224 +
#' df <- data.frame(
225 +
#'   multilinestring_id = c(1,1,1,1,1,1,1,1,2,2,2,2,2)
226 +
#'   ,    linestring_id = c(1,1,1,2,2,3,3,3,1,1,1,2,2)
227 +
#'   , x = rnorm(13)
228 +
#'   , y = rnorm(13)
229 +
#'   , z = rnorm(13)
230 +
#'   , m = rnorm(13)
231 +
#' )
232 +
#'
233 +
#' sf_mline( obj = df)
234 +
#' sf_mline( obj = df[-6])
235 +
#' ## this gives XYZ, not XYM see #64
236 +
#' (sfx <- sf_mline( obj = df[-5]))
237 +
#'
238 +
#' ## we trivially round-trip with sf_mline()
239 +
#' sf_mline(sf_to_df(sfx))
240 +
#'
241 +
#' ## to round-trip with all fields use `fill`, then `keep`
242 +
#' sf_mline(sf_to_df(sfx, fill = TRUE), keep = TRUE)
243 +
#'
244 +
#' @export
245 +
sf_mline <- function(obj, keep = FALSE) {
246 +
  check_columns(obj, c("x", "y", "multilinestring_id",
247 +
                  "linestring_id"), "sf_mline")
248 +
  call_args <- name_matcher(obj)
249 +
  call_args[c("obj", "keep")] <- list(obj, keep)
250 +
251 +
  call_args[c("multipolygon_id", "polygon_id", "multipoint_id")] <- NULL
252 +
  do.call(sfheaders::sf_multilinestring, call_args)
253 +
254 +
}
255 +
256 +
#' Helper for sf LINESTRING
257 +
#'
258 +
#' Constructs sf of LINESTRING objects, a helper for [sf_linestring()] with a
259 +
#' simpler syntax.
260 +
#'
261 +
#' @inheritParams sf_point
262 +
#' @inheritSection sf_pt Helpers
263 +
#' @inheritSection sfc_point notes
264 +
#' @inheritSection sf_point Keeping Properties
265 +
#' @return \code{sf} object of LINESTRING geometries
266 +
#' @examples
267 +
#'
268 +
#' x <- cbind(x = 1:2, y = 3:4, linestring_id = 1)
269 +
#' sf_line( x )
270 +
#'
271 +
#' x <- data.frame( linestring_id = rep(1:2, each = 2), x = 1:4, y = 4:1 )
272 +
#' (sfx <- sf_line( x ))
273 +
#'
274 +
#' ## we trivially round-trip with sf_line()
275 +
#' sf_line(sf_to_df(sfx))
276 +
#' @export
277 +
sf_line <- function(obj, keep = FALSE) {
278 +
  check_columns(obj, c("x", "y", "linestring_id"), "sf_line")
279 +
  call_args <- name_matcher(obj)
280 +
  call_args[c("obj", "keep")] <- list(obj, keep)
281 +
282 +
  call_args[c("multipolygon_id", "polygon_id", "multilinestring_id",
283 +
              "multipoint_id")] <- NULL
284 +
  do.call(sfheaders::sf_linestring, call_args)
285 +
}
286 +
287 +
288 +

@@ -393,13 +393,16 @@
Loading
393 393
    R_xlen_t& total_coordinates
394 394
  ) {
395 395
396 -
    Rcpp::CharacterVector sfc_class = sfc.attr("class");
397 -
    std::string cls;
398 -
    cls = sfc_class[0];
399 -
400 -
    // switch on cls
401 -
    if ( cls == "sfc_POINT" ) {
402 -
      return get_sfc_point_coordinates( sfc, total_coordinates );
396 +
    // issue 71
397 +
    if( !Rf_isNull( sfc.attr("class") ) ) {
398 +
      Rcpp::CharacterVector sfc_class = sfc.attr("class");
399 +
      std::string cls;
400 +
      cls = sfc_class[0];
401 +
402 +
      // switch on cls
403 +
      if ( cls == "sfc_POINT" ) {
404 +
        return get_sfc_point_coordinates( sfc, total_coordinates );
405 +
      }
403 406
    }
404 407
405 408
    return get_sfc_geometry_coordinates( sfc, total_coordinates );
@@ -419,16 +422,19 @@
Loading
419 422
420 423
  inline Rcpp::List sfc_to_df( Rcpp::List& sfc ) {
421 424
422 -
    // get teh sfc class here!
423 -
    // so if it's a POINT, can go direct to get_sfc_point()
424 -
    Rcpp::CharacterVector sfc_class = sfc.attr("class");
425 -
    std::string cls;
426 -
    cls = sfc_class[1];
427 -
428 -
    // switch on cls
429 -
    if ( cls == "sfc_POINT" ) {
430 -
      R_xlen_t n_geometries = sfc.size();
431 -
      return get_sfc_point_coordinates( sfc, n_geometries );
425 +
    // issue 71
426 +
    if( !Rf_isNull( sfc.attr("class") ) ) {
427 +
      // get teh sfc class here!
428 +
      // so if it's a POINT, can go direct to get_sfc_point()
429 +
      Rcpp::CharacterVector sfc_class = sfc.attr("class");
430 +
      std::string cls;
431 +
      cls = sfc_class[1];
432 +
433 +
      // switch on cls
434 +
      if ( cls == "sfc_POINT" ) {
435 +
        R_xlen_t n_geometries = sfc.size();
436 +
        return get_sfc_point_coordinates( sfc, n_geometries );
437 +
      }
432 438
    }
433 439
434 440
    // seprated this so it's independant / not called twice from `sf_to_df()`

@@ -53,6 +53,9 @@
Loading
53 53
#' @param fill logical indicating if the resulting data.frame should be filled
54 54
#' with the data columns from the sf object. If \code{TRUE}, each row of data will
55 55
#' be replicated for every coordiante in every geometry.
56 +
#' @param unlist string vector of columns to unlist. Each list element is equivalent
57 +
#' to a row of the input object, and is expected to be the same
58 +
#' length as the number of coordinates in the geometry.
56 59
#'
57 60
#' @examples
58 61
#'
@@ -68,11 +71,32 @@
Loading
68 71
#' sf <- sf_polygon( obj = df, polygon_id = "ml_id", linestring_id = "l_id" )
69 72
#' df <- sf_to_df( sf )
70 73
#'
71 -
#' ## with associated ata
74 +
#' ## with associated data
72 75
#' sf$val1 <- c("a","b")
73 76
#' sf$val2 <- c(1L, 2L)
74 77
#'
75 78
#' df <- sf_to_df( sf, fill = TRUE )
76 79
#'
80 +
#' ## Unlisting lsit columns
81 +
#'
82 +
#' df <- data.frame(
83 +
#' l_id = c(1,1,1,2,2,2,3,3,3,3)
84 +
#' , x = rnorm(10)
85 +
#' , y = rnorm(10)
86 +
#' )
87 +
#'
88 +
#' sf <- sf_linestring( obj = df, linestring_id = "l_id" , x = "x", y = "y")
89 +
#'
90 +
#' ## put on a list column
91 +
#' sf$l <- list( c(1,2,3),c(3,2,1),c(10,11,12,13))
92 +
#'
93 +
#' sf_to_df( sf, unlist = "l" )
94 +
#'
95 +
#'
77 96
#' @export
78 -
sf_to_df <- function( sf, fill = FALSE ) return( rcpp_sf_to_df( sf, fill ) )
97 +
sf_to_df <- function( sf, fill = FALSE, unlist = NULL ) {
98 +
  if( is.null( unlist ) ) {
99 +
    return( rcpp_sf_to_df( sf, fill ))
100 +
  }
101 +
  return( rcpp_sf_to_df_unlist( sf, unlist, fill ) )
102 +
}

@@ -37,7 +37,19 @@
Loading
37 37
38 38
    Rcpp::List sfc = sfheaders::sfc::sfc_multipoint( df, geometry_cols, line_positions );
39 39
40 -
    return sfheaders::sf::create_sf( df, sfc, id_column, property_cols, property_idx, row_idx );
40 +
    Rcpp::List res = Rcpp::List::create(
41 +
      Rcpp::_["df"] = df,
42 +
      Rcpp::_["sfc"] = sfc,
43 +
      Rcpp::_["id_column"] = id_column,
44 +
      Rcpp::_["property_cols"] = property_cols,
45 +
      Rcpp::_["property_idx"] = property_idx,
46 +
      Rcpp::_["row_idx"] = row_idx,
47 +
      Rcpp::_["line_positions"] = line_positions
48 +
    );
49 +
50 +
    return res;
51 +
52 +
    //return sfheaders::sf::create_sf( df, sfc, id_column, property_cols, property_idx, row_idx );
41 53
  }
42 54
43 55
  inline SEXP sf_multipoint(
@@ -210,7 +222,23 @@
Loading
210 222
    if( Rf_isNull( multipoint_id ) ) {
211 223
      Rcpp::List sfc = sfheaders::sfc::sfc_multipoint( x, geometry_cols, multipoint_id );
212 224
      SEXP property_columns = sfheaders::utils::other_columns( x, geometry_cols );
213 -
      return sfheaders::sf::create_sf( x, sfc, property_columns );
225 +
226 +
      Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( property_columns, x );
227 +
      Rcpp::IntegerMatrix line_positions(1,2);
228 +
      line_positions(0,0) = 0;
229 +
      line_positions(0,1) = sfheaders::utils::sexp_n_row( x ) - 1;
230 +
231 +
      // Rcpp::Rcout << "lines: " << line_positions << std::endl;
232 +
233 +
      Rcpp::List res = Rcpp::List::create(
234 +
        Rcpp::_["x"] = x,
235 +
        Rcpp::_["sfc"] = sfc,
236 +
        Rcpp::_["property_cols"] = property_columns,
237 +
        Rcpp::_["property_idx"] = property_idx,
238 +
        Rcpp::_["line_positions"] = line_positions
239 +
      );
240 +
241 +
      return res;
214 242
    }
215 243
216 244
    if( !Rf_isNull( multipoint_id ) ) {

@@ -9,4 +9,185 @@
Loading
9 9
#include "sfheaders/sf/polygon/sf_polygon.hpp"
10 10
#include "sfheaders/sf/multipolygon/sf_multipolygon.hpp"
11 11
12 +
namespace sfheaders {
13 +
namespace api {
14 +
15 +
  inline void get_list_column_index(
16 +
      SEXP& list_columns,
17 +
      Rcpp::IntegerVector& list_column_idx,
18 +
      SEXP& property_cols,  // only needs to be stringified IFF list_columns is a string?
19 +
      Rcpp::IntegerVector& property_idx
20 +
  ) {
21 +
22 +
    if( !Rf_isNull( list_columns ) ) {
23 +
      switch( TYPEOF( list_columns ) ) {
24 +
      case REALSXP: {}
25 +
      case INTSXP: {
26 +
        list_column_idx = Rcpp::as< Rcpp::IntegerVector >( list_columns );
27 +
        break;
28 +
      }
29 +
      case STRSXP: {
30 +
        Rcpp::StringVector str_list_columns = Rcpp::as< Rcpp::StringVector >( list_columns );
31 +
        Rcpp::StringVector str_property_cols = Rcpp::as< Rcpp::StringVector >( property_cols );
32 +
        Rcpp::IntegerVector idx = sfheaders::utils::where_is( str_list_columns, str_property_cols );
33 +
        list_column_idx = property_idx[ idx ];
34 +
        break;
35 +
36 +
      }
37 +
      default:{
38 +
        Rcpp::stop("sfheaders - unknown list-column type");
39 +
      }
40 +
      }
41 +
    }
42 +
  }
43 +
44 +
  inline SEXP to_sf(
45 +
    SEXP& obj,
46 +
    SEXP& geometry_columns,
47 +
    SEXP& multipoint_id,
48 +
    SEXP& linestring_id,
49 +
    SEXP& multilinestring_id,
50 +
    SEXP& polygon_id,
51 +
    SEXP& multipolygon_id,
52 +
    SEXP& list_columns,
53 +
    bool close,
54 +
    bool keep,
55 +
    const std::string sf_type
56 +
  ) {
57 +
      // TODO - Make the id_columns the correct type
58 +
      // then inside each if() condition, split it by polygon_id & linestring_id (for example)
59 +
      // assume the 0th index is the outer-most geometry
60 +
      // as this function will be called from R this is controllable.
61 +
62 +
    Rcpp::List sf_objs;
63 +
64 +
    // can I make the obj a data.frame here?
65 +
    // then can sort out all the column names as well
66 +
67 +
    // If numeric values are sent it; can I rely on them beign the same?
68 +
    // will the output 'df' remain un-sorted?
69 +
    // I think it will... right??....
70 +
71 +
72 +
    if( sf_type == "POINT" ) {
73 +
      sf_objs = sfheaders::sf::sf_point( obj, geometry_columns, keep );
74 +
    } else if ( sf_type == "MULTIPOINT" ) {
75 +
      sf_objs = sfheaders::sf::sf_multipoint( obj, geometry_columns, multipoint_id, keep );
76 +
    } else if ( sf_type == "LINESTRING" ) {
77 +
      sf_objs = sfheaders::sf::sf_linestring( obj, geometry_columns, linestring_id, keep );
78 +
    } else if ( sf_type == "MULTILINESTRING" ) {
79 +
      sf_objs = sfheaders::sf::sf_multilinestring( obj, geometry_columns, multilinestring_id, linestring_id, keep );
80 +
    } else if ( sf_type == "POLYGON" ) {
81 +
      sf_objs = sfheaders::sf::sf_polygon( obj, geometry_columns, polygon_id, linestring_id, close, keep );
82 +
    } else if ( sf_type == "MULTIPOLYGON" ) {
83 +
      sf_objs = sfheaders::sf::sf_multipolygon( obj, geometry_columns, multipolygon_id, polygon_id, linestring_id, close, keep );
84 +
    } else {
85 +
      Rcpp::stop("sfheaders - unknown sf type");
86 +
    }
87 +
88 +
    // if sf_objs doesn't contain any elements, it means it went directly through make_sf()
89 +
    if( !sf_objs.containsElementNamed("df") && !sf_objs.containsElementNamed("x") ) {
90 +
      return sf_objs;
91 +
    }
92 +
    // sf_objs is an object of either
93 +
    // 1. x, sfc, property_columns
94 +
    // 2. df, sfc, id_column, property_cols, row_idx, line_positions
95 +
96 +
    // previously each of the sf_ functions would call create_sf();
97 +
    // but now we can have SEXP list_columns
98 +
    // which we can use to fill lists
99 +
    //
100 +
    // need to know what type of object is list_columns (string or integer)
101 +
    // so we can subset the x / df
102 +
    //
103 +
    // list columns HAVE TO exist within property_columns (sf_objs[["property_cols"]])
104 +
    // so strings are OK.
105 +
    // integers?
106 +
    // integers HAVE to exist within property_idx (sf_objs[["property_idx"]] )
107 +
    // so IFF list_columns is an integerVector, then it corresponds
108 +
109 +
    //SEXP x = sf_objs["df"];
110 +
111 +
    SEXP property_cols = sf_objs[ "property_cols" ];
112 +
    Rcpp::List sfc = sf_objs["sfc"];
113 +
    Rcpp::IntegerMatrix line_positions = Rcpp::as< Rcpp::IntegerMatrix >( sf_objs["line_positions"] );
114 +
    Rcpp::IntegerVector property_idx = sf_objs[ "property_idx" ];
115 +
116 +
    Rcpp::String id_column;
117 +
    Rcpp::IntegerVector row_idx;
118 +
    Rcpp::IntegerVector list_column_idx;  // TODO - initialise as -1 ?? so its' never NULL and we only
119 +
    // need one 'create_sf()' function?
120 +
    Rcpp::StringVector str_property_cols;
121 +
122 +
123 +
124 +
    // need to 'exit early' if some of the properties don't exist
125 +
    if( sf_objs.containsElementNamed("x") ) {
126 +
      SEXP x = sf_objs["x"];
127 +
      get_list_column_index(
128 +
        list_columns, list_column_idx, property_cols, property_idx
129 +
      );
130 +
      return sfheaders::sf::create_sf( x, sfc, property_cols, list_column_idx, line_positions );
131 +
    }
132 +
133 +
134 +
    row_idx = sf_objs["row_idx"];
135 +
136 +
    str_property_cols = Rcpp::as< Rcpp::StringVector >( property_cols );
137 +
138 +
    if( sf_objs.containsElementNamed("id_column") ) {
139 +
      id_column = Rcpp::as< Rcpp::String >( sf_objs["id_column"] );
140 +
    }
141 +
142 +
    // this should give us list_column_idx, which is a subset (or all) of property_idx,
143 +
    // which can be passed into create_sf()
144 +
    // and checked iff property_idx %in% list_column_idx;
145 +
    // and if so, make it a list-column, rather than subset the first row.
146 +
    //Rcpp::Rcout << "list_columns: " << list_column_idx << std::endl;
147 +
    get_list_column_index(
148 +
      list_columns, list_column_idx, property_cols, property_idx
149 +
    );
150 +
151 +
    Rcpp::DataFrame df = Rcpp::as< Rcpp::DataFrame >( sf_objs["df"] );
152 +
153 +
    if( !sf_objs.containsElementNamed("id_column") ) {
154 +
      return sfheaders::sf::create_sf( df, sfc, str_property_cols, property_idx, list_column_idx, row_idx, line_positions );
155 +
    }
156 +
157 +
    return sfheaders::sf::create_sf(
158 +
      df, sfc, id_column, str_property_cols, property_idx, list_column_idx, row_idx, line_positions
159 +
      );
160 +
 }
161 +
162 +
  // TODO
163 +
  // write each of the rcpp_sf_xxx functions here, so they appropriately call the to_sf() code
164 +
  inline SEXP rcpp_sf_point( SEXP x, SEXP cols, bool keep ) {
165 +
    return to_sf( x, cols, R_NilValue, R_NilValue, R_NilValue, R_NilValue, R_NilValue, R_NilValue, false, keep, "POINT" );
166 +
  }
167 +
168 +
  inline SEXP rcpp_sf_multipoint( SEXP x, SEXP cols, SEXP multipoint_id, bool keep ) {
169 +
    return to_sf( x, cols, multipoint_id, R_NilValue, R_NilValue, R_NilValue, R_NilValue, R_NilValue, false, keep, "MULTIPOINT" );
170 +
  }
171 +
172 +
  inline SEXP rcpp_sf_linestring( SEXP x, SEXP cols, SEXP linestring_id, bool keep ) {
173 +
    return to_sf( x, cols, R_NilValue, linestring_id, R_NilValue, R_NilValue, R_NilValue, R_NilValue, false, keep, "LINESTRING" );
174 +
  }
175 +
176 +
  inline SEXP rcpp_sf_multilinestring( SEXP x, SEXP cols, SEXP multilinestring_id, SEXP linestring_id, bool keep ) {
177 +
    return to_sf( x, cols, R_NilValue, linestring_id, multilinestring_id, R_NilValue, R_NilValue, R_NilValue, false, keep, "MULTILINESTRING" );
178 +
  }
179 +
180 +
  inline SEXP rcpp_sf_polygon( SEXP x, SEXP cols, SEXP polygon_id, SEXP linestring_id, bool close, bool keep ) {
181 +
    return to_sf( x, cols, R_NilValue, linestring_id, R_NilValue, polygon_id, R_NilValue, R_NilValue, close, keep, "POLYGON" );
182 +
  }
183 +
184 +
  inline SEXP rcpp_sf_multipolygon( SEXP x, SEXP cols, SEXP multipolygon_id, SEXP polygon_id, SEXP linestring_id, bool close, bool keep ) {
185 +
    return to_sf( x, cols, R_NilValue, linestring_id, R_NilValue, polygon_id, multipolygon_id, R_NilValue, close, keep, "MULTIPOLYGON" );
186 +
  }
187 +
188 +
189 +
} // api
190 +
} // sfheaders
191 +
192 +
12 193
#endif

@@ -8,6 +8,19 @@
Loading
8 8
namespace sfheaders {
9 9
namespace utils {
10 10
11 +
  inline int where_is(
12 +
      int to_find,
13 +
      Rcpp::IntegerVector& iv ) {
14 +
    int n = iv.size();
15 +
    int i;
16 +
    for( i = 0; i < n; ++i ) {
17 +
      if ( to_find == iv[i] ) {
18 +
        return i;
19 +
      }
20 +
    }
21 +
    return -1;
22 +
  }
23 +
11 24
  inline int where_is(
12 25
      Rcpp::String to_find,
13 26
      Rcpp::StringVector& sv ) {
@@ -22,19 +35,59 @@
Loading
22 35
  }
23 36
24 37
  inline Rcpp::IntegerVector where_is(
25 -
      Rcpp::StringVector& param_value,
26 -
      Rcpp::StringVector& data_names) {
38 +
      Rcpp::IntegerVector& values_to_find,
39 +
      Rcpp::IntegerVector& vector_to_look_in
40 +
  ) {
27 41
28 -
    int n = param_value.size();
42 +
    int n = values_to_find.size();
29 43
    int i;
30 44
    Rcpp::IntegerVector res( n );
31 45
    for ( i = 0; i < n; ++i ) {
32 -
      Rcpp::String to_find = param_value[i];
33 -
      res[i] = where_is( to_find, data_names );
46 +
      int to_find = values_to_find[ i ];
47 +
      res[ i ] = where_is( to_find, vector_to_look_in );
34 48
    }
35 49
    return res;
36 50
  }
37 51
52 +
  inline Rcpp::IntegerVector where_is(
53 +
      Rcpp::StringVector& values_to_find,
54 +
      Rcpp::StringVector& vector_to_look_in
55 +
  ) {
56 +
57 +
    int n = values_to_find.size();
58 +
    int i;
59 +
    Rcpp::IntegerVector res( n );
60 +
    for ( i = 0; i < n; ++i ) {
61 +
      Rcpp::String to_find = values_to_find[ i ];
62 +
      res[ i ] = where_is( to_find, vector_to_look_in );
63 +
    }
64 +
    return res;
65 +
  }
66 +
67 +
  inline Rcpp::IntegerVector where_is(
68 +
    SEXP& values_to_find,
69 +
    SEXP& x   // object, of which are names or indices
70 +
  ) {
71 +
    switch( TYPEOF( values_to_find ) ) {
72 +
    case REALSXP: {}
73 +
    case INTSXP: {
74 +
      Rcpp::IntegerVector values = Rcpp::as< Rcpp::IntegerVector >( values_to_find );
75 +
      Rcpp::IntegerVector look_in = sfheaders::utils::get_sexp_length( x );
76 +
      return where_is( values, look_in );
77 +
    }
78 +
    case STRSXP: {
79 +
      Rcpp::StringVector values = Rcpp::as< Rcpp::StringVector >( values_to_find );
80 +
      //Rcpp::StringVector look_in = Rcpp::as< Rcpp::StringVector >( vector_to_look_in );
81 +
      Rcpp::StringVector look_in = sfheaders::utils::get_sexp_col_names( x );
82 +
      return where_is( values, look_in );
83 +
    }
84 +
    default: {
85 +
      Rcpp::stop("sfheaders - error trying to find values in a vector");
86 +
    }
87 +
    }
88 +
    return Rcpp::IntegerVector::create(); // #nocov // never reaches
89 +
  }
90 +
38 91
  inline SEXP concatenate_vectors(
39 92
    Rcpp::IntegerVector& iv_1,
40 93
    Rcpp::IntegerVector& iv_2

@@ -57,6 +57,14 @@
Loading
57 57
    return res;
58 58
  }
59 59
60 +
  inline Rcpp::List make_dataframe(
61 +
    Rcpp::List& res,
62 +
    R_xlen_t& total_rows
63 +
  ) {
64 +
    Rcpp::StringVector res_names = res.names();
65 +
    return make_dataframe( res, total_rows, res_names );
66 +
  }
67 +
60 68
} // utils
61 69
} // sfheaders
62 70

@@ -0,0 +1,60 @@
Loading
1 +
#include <Rcpp.h>
2 +
#include "sfheaders/utils/lists/list.hpp"
3 +
4 +
// [[Rcpp::export]]
5 +
Rcpp::List rcpp_fill_list( Rcpp::NumericVector v, Rcpp::IntegerMatrix line_ids ) {
6 +
  return sfheaders::utils::fill_list( v, line_ids );
7 +
}
8 +
9 +
// [[Rcpp::export]]
10 +
Rcpp::List rcpp_list_sizes( Rcpp::List lst ) {
11 +
  int total_size = 0;
12 +
  int existing_type = 10;
13 +
  Rcpp::List lst_sizes = sfheaders::utils::list_size( lst, total_size, existing_type );
14 +
  return Rcpp::List::create(
15 +
    Rcpp::_["elements"] = lst_sizes,
16 +
    Rcpp::_["total"] = total_size
17 +
  );
18 +
}
19 +
20 +
// [[Rcpp::export]]
21 +
int rcpp_list_type( Rcpp::List lst ) {
22 +
  int total_size = 0;
23 +
  int existing_type = 10;
24 +
  Rcpp::List lst_sizes = sfheaders::utils::list_size( lst, total_size, existing_type );
25 +
  return existing_type;
26 +
}
27 +
28 +
// [[Rcpp::export]]
29 +
SEXP rcpp_unlist_list( Rcpp::List lst ) {
30 +
  int total_size = 0;
31 +
  int existing_type = 10;
32 +
  int position = 0;
33 +
  Rcpp::List lst_sizes = sfheaders::utils::list_size( lst, total_size, existing_type );
34 +
  switch( existing_type ) {
35 +
  case LGLSXP: {
36 +
    Rcpp::LogicalVector lv( total_size );
37 +
    sfheaders::utils::unlist_list( lst, lst_sizes, lv, position );
38 +
    return lv;
39 +
  }
40 +
  case INTSXP: {
41 +
    Rcpp::IntegerVector iv( total_size );
42 +
    sfheaders::utils::unlist_list( lst, lst_sizes, iv, position );
43 +
    return iv;
44 +
  }
45 +
  case REALSXP: {
46 +
    Rcpp::NumericVector nv( total_size );
47 +
    sfheaders::utils::unlist_list( lst, lst_sizes, nv, position );
48 +
    return nv;
49 +
  }
50 +
  default: {
51 +
    Rcpp::StringVector sv( total_size );
52 +
    sfheaders::utils::unlist_list( lst, lst_sizes, sv, position );
53 +
    return sv;
54 +
  }
55 +
  }
56 +
57 +
  Rcpp::stop("sfheaders - couldn't unlist this object");
58 +
  return lst; // #nocov - never reaches
59 +
60 +
}

@@ -3,12 +3,13 @@
Loading
3 3
#include <Rcpp.h>
4 4
//#include "sfheaders/sf/sf.hpp"
5 5
6 -
#include "sfheaders/sf/point/sf_point.hpp"
7 -
#include "sfheaders/sf/multipoint/sf_multipoint.hpp"
8 -
#include "sfheaders/sf/linestring/sf_linestring.hpp"
9 -
#include "sfheaders/sf/multilinestring/sf_multilinestring.hpp"
10 -
#include "sfheaders/sf/polygon/sf_polygon.hpp"
11 -
#include "sfheaders/sf/multipolygon/sf_multipolygon.hpp"
6 +
#include "sfheaders/sf/sf.hpp"
7 +
//#include "sfheaders/sf/point/sf_point.hpp"
8 +
//#include "sfheaders/sf/multipoint/sf_multipoint.hpp"
9 +
//#include "sfheaders/sf/linestring/sf_linestring.hpp"
10 +
//#include "sfheaders/sf/multilinestring/sf_multilinestring.hpp"
11 +
//#include "sfheaders/sf/polygon/sf_polygon.hpp"
12 +
//#include "sfheaders/sf/multipolygon/sf_multipolygon.hpp"
12 13
13 14
// /*
14 15
//  * rcpp_make_sf
@@ -20,35 +21,65 @@
Loading
20 21
//   return sfheaders::sf::make_sf( sfc, ids );
21 22
// }
22 23
24 +
// [[Rcpp::export]]
25 +
SEXP rcpp_to_sf(
26 +
    SEXP obj,
27 +
    SEXP geometry_columns,
28 +
    SEXP multipoint_id,
29 +
    SEXP linestring_id,
30 +
    SEXP multilinestring_id,
31 +
    SEXP polygon_id,
32 +
    SEXP multipolygon_id,
33 +
    SEXP list_columns,
34 +
    bool close,
35 +
    bool keep,
36 +
    std::string sf_type
37 +
) {
38 +
  return sfheaders::api::to_sf(
39 +
    obj,
40 +
    geometry_columns,
41 +
    multipoint_id,
42 +
    linestring_id,
43 +
    multilinestring_id,
44 +
    polygon_id,
45 +
    multipolygon_id,
46 +
    list_columns,
47 +
    close,
48 +
    keep,
49 +
    sf_type
50 +
  );
51 +
}
52 +
53 +
23 54
// [[Rcpp::export]]
24 55
SEXP rcpp_sf_point( SEXP x, SEXP cols, bool keep ) {
25 -
  return sfheaders::sf::sf_point( x, cols, keep );
56 +
  return sfheaders::api::rcpp_sf_point( x, cols, keep );
26 57
}
27 58
28 59
// [[Rcpp::export]]
29 60
SEXP rcpp_sf_multipoint( SEXP x, SEXP cols, SEXP multipoint_id, bool keep ) {
30 -
  return sfheaders::sf::sf_multipoint( x, cols, multipoint_id, keep );
61 +
  return sfheaders::api::rcpp_sf_multipoint( x, cols, multipoint_id, keep );
31 62
}
32 63
33 64
34 65
// [[Rcpp::export]]
35 66
SEXP rcpp_sf_linestring( SEXP x, SEXP cols, SEXP linestring_id, bool keep) {
36 -
  return sfheaders::sf::sf_linestring( x, cols, linestring_id, keep );
67 +
  return sfheaders::api::rcpp_sf_linestring( x, cols, linestring_id, keep );
37 68
}
38 69
39 70
// [[Rcpp::export]]
40 71
SEXP rcpp_sf_multilinestring( SEXP x, SEXP cols, SEXP multilinestring_id, SEXP linestring_id, bool keep ) {
41 -
  return sfheaders::sf::sf_multilinestring( x, cols, multilinestring_id, linestring_id, keep );
72 +
  return sfheaders::api::rcpp_sf_multilinestring( x, cols, multilinestring_id, linestring_id, keep );
42 73
}
43 74
44 75
// [[Rcpp::export]]
45 76
SEXP rcpp_sf_polygon( SEXP x, SEXP cols, SEXP polygon_id, SEXP linestring_id, bool close, bool keep ) {
46 -
  return sfheaders::sf::sf_polygon( x, cols, polygon_id, linestring_id, close, keep );
77 +
  return sfheaders::api::rcpp_sf_polygon( x, cols, polygon_id, linestring_id, close, keep );
47 78
}
48 79
49 80
// [[Rcpp::export]]
50 81
SEXP rcpp_sf_multipolygon( SEXP x, SEXP cols, SEXP multipolygon_id, SEXP polygon_id, SEXP linestring_id, bool close, bool keep ) {
51 -
  return sfheaders::sf::sf_multipolygon( x, cols, multipolygon_id, polygon_id, linestring_id, close, keep );
82 +
  return sfheaders::api::rcpp_sf_multipolygon( x, cols, multipolygon_id, polygon_id, linestring_id, close, keep );
52 83
}
53 84
54 85

@@ -39,7 +39,19 @@
Loading
39 39
40 40
    Rcpp::List sfc = sfheaders::sfc::sfc_multilinestring( df, geometry_cols, line_ids, multilinestring_positions );
41 41
42 -
    return sfheaders::sf::create_sf( df, sfc, id_column, property_cols, property_idx, row_idx );
42 +
    Rcpp::List res = Rcpp::List::create(
43 +
      Rcpp::_["df"] = df,
44 +
      Rcpp::_["sfc"] = sfc,
45 +
      Rcpp::_["id_column"] = id_column,
46 +
      Rcpp::_["property_cols"] = property_cols,
47 +
      Rcpp::_["property_idx"] = property_idx,
48 +
      Rcpp::_["row_idx"] = row_idx,
49 +
      Rcpp::_["line_positions"] = multilinestring_positions
50 +
    );
51 +
52 +
    return res;
53 +
54 +
    //return sfheaders::sf::create_sf( df, sfc, id_column, property_cols, property_idx, row_idx );
43 55
  }
44 56
45 57
  inline SEXP sf_multilinestring(
@@ -243,14 +255,42 @@
Loading
243 255
      // the entire object is a polygon
244 256
      Rcpp::List sfc = sfheaders::sfc::sfc_multilinestring( x, geometry_cols, multilinestring_id, linestring_id );
245 257
      SEXP property_columns = sfheaders::utils::other_columns( x, geometry_cols, linestring_id );
246 -
      return sfheaders::sf::create_sf( x, sfc, property_columns );
258 +
259 +
      Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( property_columns, x );
260 +
      Rcpp::IntegerMatrix line_positions(1,2);
261 +
      line_positions(0,0) = 0;
262 +
      line_positions(0,1) = sfheaders::utils::sexp_n_row( x ) - 1;
263 +
264 +
      Rcpp::List res = Rcpp::List::create(
265 +
        Rcpp::_["x"] = x,
266 +
        Rcpp::_["sfc"] = sfc,
267 +
        Rcpp::_["property_cols"] = property_columns,
268 +
        Rcpp::_["property_idx"] = property_idx,
269 +
        Rcpp::_["line_positions"] = line_positions
270 +
      );
271 +
272 +
      return res;
247 273
    }
248 274
249 275
    if( Rf_isNull( multilinestring_id ) && Rf_isNull( linestring_id ) ) {
250 276
      // the entire object is a polygon
251 277
      Rcpp::List sfc = sfheaders::sfc::sfc_multilinestring( x, geometry_cols, multilinestring_id, linestring_id );
252 278
      SEXP property_columns = sfheaders::utils::other_columns( x, geometry_cols );
253 -
      return sfheaders::sf::create_sf( x, sfc, property_columns );
279 +
280 +
      Rcpp::IntegerVector property_idx = sfheaders::utils::where_is( property_columns, x );
281 +
      Rcpp::IntegerMatrix line_positions(1,2);
282 +
      line_positions(0,0) = 0;
283 +
      line_positions(0,1) = sfheaders::utils::sexp_n_row( x ) - 1;
284 +
285 +
      Rcpp::List res = Rcpp::List::create(
286 +
        Rcpp::_["x"] = x,
287 +
        Rcpp::_["sfc"] = sfc,
288 +
        Rcpp::_["property_cols"] = property_columns,
289 +
        Rcpp::_["property_idx"] = property_idx,
290 +
        Rcpp::_["line_positions"] = line_positions
291 +
      );
292 +
293 +
      return res;
254 294
    }
255 295
256 296

@@ -1,8 +1,9 @@
Loading
1 1
2 2
## convert R-index to c++-index
3 3
index_correct <- function( geometry_columns ) {
4 -
  if( is.numeric( geometry_columns ) )
4 +
  if( is.numeric( geometry_columns ) ) {
5 5
    return( geometry_columns - 1 )
6 +
  }
6 7
7 8
  return( geometry_columns )
8 9
}
@@ -10,7 +11,7 @@
Loading
10 11
11 12
#' remove holes
12 13
#'
13 -
#' Removes holes from olygons and multipolygons. Points and linestrings are unaffected.
14 +
#' Removes holes from polygons and multipolygons. Points and linestrings are unaffected.
14 15
#'
15 16
#' @param obj sfg, sfc or sf object.
16 17
#' @inheritParams sfc_polygon
Files Coverage
R 95.33%
inst/include/sfheaders 98.48%
src 96.67%
Project Totals (73 files) 98.30%
1
comment: false
2

3
coverage:
4
  status:
5
    project:
6
      default:
7
        target: auto
8
        threshold: 1%
9
    patch:
10
      default:
11
        target: auto
12
        threshold: 1%
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading