Commit 3ae97489 authored by Andreas Tille's avatar Andreas Tille

New upstream version 0.7-2+dfsg

parent d54153bc
Package: sf
Version: 0.7-1
Version: 0.7-2
Date: 2018-11-24
Title: Simple Features for R
Authors@R:
c(person(given = "Edzer",
......@@ -46,15 +47,16 @@ BugReports: https://github.com/r-spatial/sf/issues/
Depends: methods, R (>= 3.3.0)
Imports: classInt (>= 0.2-1), DBI (>= 0.8), graphics, grDevices, grid,
magrittr, Rcpp, stats, tools, units (>= 0.6-0), utils
Suggests: covr, dplyr (>= 0.7-0), ggplot2, knitr, lwgeom (>= 0.1-2),
maps, maptools, mapview, microbenchmark, odbc, pillar, pool,
raster, rgdal, rgeos, rlang, rmarkdown, RPostgres (>= 1.1.0),
RPostgreSQL, RSQLite, sp (>= 1.2-4), spatstat, stars, testthat,
tibble (>= 1.4.1), tidyr (>= 0.7-2), tidyselect, tmap (>= 2.0)
Suggests: blob, covr, dplyr (>= 0.7-0), ggplot2, knitr, lwgeom (>=
0.1-5), maps, maptools, mapview, microbenchmark, odbc, pillar,
pool, raster, rgdal, rgeos, rlang, rmarkdown, RPostgres (>=
1.1.0), RPostgreSQL, RSQLite, sp (>= 1.2-4), spatstat, stars
(>= 0.2-0), testthat, tibble (>= 1.4.1), tidyr (>= 0.7-2),
tidyselect, tmap (>= 2.0)
LinkingTo: Rcpp
VignetteBuilder: knitr
Encoding: UTF-8
RoxygenNote: 6.1.0
RoxygenNote: 6.1.1
SystemRequirements: C++11, GDAL (>= 2.0.1), GEOS (>= 3.4.0), PROJ (>=
4.8.0)
Collate: 'RcppExports.R' 'init.R' 'crs.R' 'bbox.R' 'read.R' 'db.R'
......@@ -65,7 +67,7 @@ Collate: 'RcppExports.R' 'init.R' 'crs.R' 'bbox.R' 'read.R' 'db.R'
'collection_extract.R' 'jitter.R' 'sgbp.R' 'spatstat.R'
'stars.R' 'crop.R' 'gdal_utils.R' 'nearest.R' 'deprecated.R'
NeedsCompilation: yes
Packaged: 2018-10-24 12:11:05 UTC; edzer
Packaged: 2018-12-20 08:55:02 UTC; edzer
Author: Edzer Pebesma [aut, cre] (<https://orcid.org/0000-0001-8049-7069>),
Roger Bivand [ctb] (<https://orcid.org/0000-0003-2392-6140>),
Etienne Racine [ctb],
......@@ -78,4 +80,4 @@ Author: Edzer Pebesma [aut, cre] (<https://orcid.org/0000-0001-8049-7069>),
Kirill Müller [ctb]
Maintainer: Edzer Pebesma <edzer.pebesma@uni-muenster.de>
Repository: CRAN
Date/Publication: 2018-10-24 16:10:03 UTC
Date/Publication: 2018-12-20 10:10:03 UTC
This diff is collapsed.
......@@ -154,6 +154,8 @@ S3method(st_coordinates,sfc)
S3method(st_coordinates,sfg)
S3method(st_crop,sf)
S3method(st_crop,sfc)
S3method(st_crs,Raster)
S3method(st_crs,Spatial)
S3method(st_crs,bbox)
S3method(st_crs,character)
S3method(st_crs,crs)
......@@ -294,6 +296,7 @@ export(st_dimension)
export(st_disjoint)
export(st_distance)
export(st_drivers)
export(st_drop_geometry)
export(st_equals)
export(st_equals_exact)
export(st_geometry)
......
# version 0.7-2
* feature IDs are no longer returned as names on the geometry list column, but optionally returned by `st_read` as attribute column; #812
* plot.sf adds a (single, common) key if `key.pos` is set
* allow for setting precision in distance units; #901
* support log-scale in color legend by setting `logz` to `TRUE` in `plot.sf`
* `st_intersects` etc. will prepare `y` when `y` is polygons and `x` is points; #885 by Dan Baston
* `st_write` (and `write_sf`) now returns its first argument, invisibly; #889
# version 0.7-1
* fix bug that broke n-ary `st_intersection`; #867
* fix bug that broke n-ary `st_intersection` on platforms using clang; #867
# version 0.7-0
......
......@@ -5,74 +5,6 @@ CPL_get_bbox <- function(sf, depth = 0L) {
.Call('_sf_CPL_get_bbox', PACKAGE = 'sf', sf, depth)
}
CPL_area <- function(sfc) {
.Call('_sf_CPL_area', PACKAGE = 'sf', sfc)
}
CPL_gdal_dimension <- function(sfc, NA_if_empty = TRUE) {
.Call('_sf_CPL_gdal_dimension', PACKAGE = 'sf', sfc, NA_if_empty)
}
CPL_length <- function(sfc) {
.Call('_sf_CPL_length', PACKAGE = 'sf', sfc)
}
CPL_gdal_segmentize <- function(sfc, dfMaxLength = 0.0) {
.Call('_sf_CPL_gdal_segmentize', PACKAGE = 'sf', sfc, dfMaxLength)
}
CPL_gdal_linestring_sample <- function(sfc, distLst) {
.Call('_sf_CPL_gdal_linestring_sample', PACKAGE = 'sf', sfc, distLst)
}
CPL_get_layers <- function(datasource, options, do_count = FALSE) {
.Call('_sf_CPL_get_layers', PACKAGE = 'sf', datasource, options, do_count)
}
CPL_read_ogr <- function(datasource, layer, query, options, quiet, toTypeUser, promote_to_multi = TRUE, int64_as_string = FALSE) {
.Call('_sf_CPL_read_ogr', PACKAGE = 'sf', datasource, layer, query, options, quiet, toTypeUser, promote_to_multi, int64_as_string)
}
CPL_gdalinfo <- function(obj, options) {
.Call('_sf_CPL_gdalinfo', PACKAGE = 'sf', obj, options)
}
CPL_gdalwarp <- function(src, dst, options) {
.Call('_sf_CPL_gdalwarp', PACKAGE = 'sf', src, dst, options)
}
CPL_gdalrasterize <- function(src, dst, options) {
.Call('_sf_CPL_gdalrasterize', PACKAGE = 'sf', src, dst, options)
}
CPL_gdaltranslate <- function(src, dst, options) {
.Call('_sf_CPL_gdaltranslate', PACKAGE = 'sf', src, dst, options)
}
CPL_gdalvectortranslate <- function(src, dst, options) {
.Call('_sf_CPL_gdalvectortranslate', PACKAGE = 'sf', src, dst, options)
}
CPL_gdalbuildvrt <- function(src, dst, options) {
.Call('_sf_CPL_gdalbuildvrt', PACKAGE = 'sf', src, dst, options)
}
CPL_gdaldemprocessing <- function(src, dst, options, processing, colorfilename) {
.Call('_sf_CPL_gdaldemprocessing', PACKAGE = 'sf', src, dst, options, processing, colorfilename)
}
CPL_gdalnearblack <- function(src, dst, options) {
.Call('_sf_CPL_gdalnearblack', PACKAGE = 'sf', src, dst, options)
}
CPL_gdalgrid <- function(src, dst, options) {
.Call('_sf_CPL_gdalgrid', PACKAGE = 'sf', src, dst, options)
}
CPL_write_ogr <- function(obj, dsn, layer, driver, dco, lco, geom, dim, quiet = FALSE, update = FALSE, delete_dsn = FALSE, delete_layer = FALSE) {
.Call('_sf_CPL_write_ogr', PACKAGE = 'sf', obj, dsn, layer, driver, dco, lco, geom, dim, quiet, update, delete_dsn, delete_layer)
}
CPL_gdal_init <- function() {
invisible(.Call('_sf_CPL_gdal_init', PACKAGE = 'sf'))
}
......@@ -145,6 +77,74 @@ CPL_gdal_with_geos <- function() {
.Call('_sf_CPL_gdal_with_geos', PACKAGE = 'sf')
}
CPL_area <- function(sfc) {
.Call('_sf_CPL_area', PACKAGE = 'sf', sfc)
}
CPL_gdal_dimension <- function(sfc, NA_if_empty = TRUE) {
.Call('_sf_CPL_gdal_dimension', PACKAGE = 'sf', sfc, NA_if_empty)
}
CPL_length <- function(sfc) {
.Call('_sf_CPL_length', PACKAGE = 'sf', sfc)
}
CPL_gdal_segmentize <- function(sfc, dfMaxLength = 0.0) {
.Call('_sf_CPL_gdal_segmentize', PACKAGE = 'sf', sfc, dfMaxLength)
}
CPL_gdal_linestring_sample <- function(sfc, distLst) {
.Call('_sf_CPL_gdal_linestring_sample', PACKAGE = 'sf', sfc, distLst)
}
CPL_get_layers <- function(datasource, options, do_count = FALSE) {
.Call('_sf_CPL_get_layers', PACKAGE = 'sf', datasource, options, do_count)
}
CPL_read_ogr <- function(datasource, layer, query, options, quiet, toTypeUser, fid_column_name, promote_to_multi = TRUE, int64_as_string = FALSE) {
.Call('_sf_CPL_read_ogr', PACKAGE = 'sf', datasource, layer, query, options, quiet, toTypeUser, fid_column_name, promote_to_multi, int64_as_string)
}
CPL_gdalinfo <- function(obj, options) {
.Call('_sf_CPL_gdalinfo', PACKAGE = 'sf', obj, options)
}
CPL_gdalwarp <- function(src, dst, options) {
.Call('_sf_CPL_gdalwarp', PACKAGE = 'sf', src, dst, options)
}
CPL_gdalrasterize <- function(src, dst, options) {
.Call('_sf_CPL_gdalrasterize', PACKAGE = 'sf', src, dst, options)
}
CPL_gdaltranslate <- function(src, dst, options) {
.Call('_sf_CPL_gdaltranslate', PACKAGE = 'sf', src, dst, options)
}
CPL_gdalvectortranslate <- function(src, dst, options) {
.Call('_sf_CPL_gdalvectortranslate', PACKAGE = 'sf', src, dst, options)
}
CPL_gdalbuildvrt <- function(src, dst, options) {
.Call('_sf_CPL_gdalbuildvrt', PACKAGE = 'sf', src, dst, options)
}
CPL_gdaldemprocessing <- function(src, dst, options, processing, colorfilename) {
.Call('_sf_CPL_gdaldemprocessing', PACKAGE = 'sf', src, dst, options, processing, colorfilename)
}
CPL_gdalnearblack <- function(src, dst, options) {
.Call('_sf_CPL_gdalnearblack', PACKAGE = 'sf', src, dst, options)
}
CPL_gdalgrid <- function(src, dst, options) {
.Call('_sf_CPL_gdalgrid', PACKAGE = 'sf', src, dst, options)
}
CPL_write_ogr <- function(obj, dsn, layer, driver, dco, lco, geom, dim, fids, quiet = FALSE, update = FALSE, delete_dsn = FALSE, delete_layer = FALSE) {
.Call('_sf_CPL_write_ogr', PACKAGE = 'sf', obj, dsn, layer, driver, dco, lco, geom, dim, fids, quiet, update, delete_dsn, delete_layer)
}
CPL_geos_binop <- function(sfc0, sfc1, op, par = 0.0, pattern = "", prepared = FALSE) {
.Call('_sf_CPL_geos_binop', PACKAGE = 'sf', sfc0, sfc1, op, par, pattern, prepared)
}
......@@ -281,8 +281,8 @@ CPL_read_gdal <- function(fname, options, driver, read_data, NA_value, RasterIO_
.Call('_sf_CPL_read_gdal', PACKAGE = 'sf', fname, options, driver, read_data, NA_value, RasterIO_parameters)
}
CPL_write_gdal <- function(x, fname, driver, options, Type, dims, gt, p4s, na_val) {
invisible(.Call('_sf_CPL_write_gdal', PACKAGE = 'sf', x, fname, driver, options, Type, dims, gt, p4s, na_val))
CPL_write_gdal <- function(x, fname, driver, options, Type, dims, from, gt, p4s, na_val, create = TRUE, only_create = FALSE) {
invisible(.Call('_sf_CPL_write_gdal', PACKAGE = 'sf', x, fname, driver, options, Type, dims, from, gt, p4s, na_val, create, only_create))
}
CPL_read_wkb <- function(wkb_list, EWKB = FALSE, spatialite = FALSE) {
......
......@@ -55,7 +55,7 @@ aggregate.sf = function(x, by, FUN, ..., do_union = TRUE, simplify = TRUE,
a_na[a$Group.1,] = a
a = a_na
}
a$Group.1 = NULL
a$Group.1 = NULL # remove
row.names(a) = row.names(by)
st_set_geometry(a, st_geometry(by))
} else {
......
......@@ -5,6 +5,8 @@
#' @param e2 numeric, or object of class \code{sfg}; in case \code{e1} is of class \code{sfc} also an object of class \code{sfc} is allowed
#'
#' @details in case \code{e2} is numeric, +, -, *, /, %% and %/% add, subtract, multiply, divide, modulo, or integer-divide by \code{e2}. In case \code{e2} is an n x n matrix, * matrix-multiplies and / multiplies by its inverse. If \code{e2} is an \code{sfg} object, |, /, & and %/% result in the geometric union, difference, intersection and symmetric difference respectively, and \code{==} and \code{!=} return geometric (in)equality, using \link{st_equals}.
#'
#' If \code{e1} is of class \code{sfc}, and \code{e2} is a length 2 numeric, then it is considered a two-dimensional point (and if needed repeated as such) only for operations \code{+} and \code{-}, in other cases the individual numbers are repeated; see commented examples.
#'
#' @return object of class \code{sfg}
#' @export
......@@ -30,6 +32,9 @@
#' p = function(m) { plot(c(a,b)); plot(eval(parse(text=m)), col=grey(.9), add = TRUE); title(m) }
#' lapply(c('a | b', 'a / b', 'a & b', 'a %/% b'), p)
#' par(opar)
#' sfc = st_sfc(st_point(0:1), st_point(2:3))
#' sfc + c(2,3) # added to EACH geometry
#' sfc * c(2,3) # first geometry multiplied by 2, second by 3
Ops.sfg <- function(e1, e2) {
if (nargs() == 1) {
......@@ -120,7 +125,7 @@ Ops.sfc <- function(e1, e2) {
if ((is.matrix(e2) && ncol(e2) == 2) || (is.numeric(e2) && length(e2) == 2))
e1 = st_zm(e1) # drop z and/or m
if (!is.list(e2))
if (!is.list(e2) && ((.Generic %in% c("+", "-") && length(e2) == 2) || is.matrix(e2)))
e2 = list(e2)
ret = switch(.Generic,
......
......@@ -123,6 +123,12 @@ st_cast_sfc_default = function(x) {
structure(st_sfc(x), ids = ids)
}
copy_sfc_attributes_from = function(x, ret) {
structure(ret, precision = attr(x, "precision"),
bbox = attr(x, "bbox"), crs = attr(x, "crs"), n_empty = attr(x, "n_empty"))
}
#' @name st_cast
#' @param ids integer vector, denoting how geometries should be grouped (default: no grouping)
#' @param group_or_split logical; if TRUE, group or split geometries; if FALSE, carry out a 1-1 per-geometry conversion.
......@@ -150,7 +156,7 @@ st_cast.sfc = function(x, to, ..., ids = seq_along(x), group_or_split = TRUE) {
st_cast(st_cast(x, "MULTIPOINT"), "POINT")
else if (to == "MULTIPOINT") {
ret = lapply(x, function(y) structure(as.matrix(y), class = c(class(y)[1], to, "sfg")))
attributes(ret) = attributes(x)
ret = copy_sfc_attributes_from(x, ret)
reclass(ret, to, FALSE)
} else
#st_cast(st_cast(x, "MULTILINESTRING"), to)
......@@ -160,13 +166,13 @@ st_cast.sfc = function(x, to, ..., ids = seq_along(x), group_or_split = TRUE) {
lapply(unname(split(x, ids)), function(y) structure(do.call(rbind, y), class = class(x[[1]])))
else
lapply(unname(split(x, ids)), function(y) structure(y, class = class(x[[1]])))
attributes(ret) = attributes(x)
ret = copy_sfc_attributes_from(x, ret)
reclass(ret, to, need_close(to))
} else if (from_col == 3 && to == "MULTILINESTRING") {
ret = lapply(x, unlist, recursive = FALSE) # unlist one level deeper; one MULTIPOLYGON -> one MULTILINESTRING
if (length(ret))
class(ret[[1]]) = class(x[[1]]) # got dropped
attributes(ret) = attributes(x) # bbox, crs
ret = copy_sfc_attributes_from(x, ret)
structure(reclass(ret, to, FALSE))
} else { # "horizontal", to the left: split
ret = if (from_col == 1) # LINESTRING or MULTIPOINT to POINT
......@@ -174,7 +180,7 @@ st_cast.sfc = function(x, to, ..., ids = seq_along(x), group_or_split = TRUE) {
else
unlist(x, recursive = FALSE)
ret = lapply(ret, function(y) structure(y, class = class(x[[1]]))) # will be reset by reclass()
attributes(ret) = attributes(x)
ret = copy_sfc_attributes_from(x, ret)
structure(reclass(ret, to, need_close(to)), ids = get_lengths(x))
}
}
......
......@@ -318,3 +318,15 @@ print.crs = function(x, ...) {
cat(" proj4string: \"", x$proj4string, "\"\n", sep = "")
}
}
#' @export
st_crs.Raster = function(x, ...) {
st_crs(x@crs@projargs) # nocov
}
#' @export
st_crs.Spatial = function(x, ...) {
if (! requireNamespace("sp", quietly = TRUE))
stop("package sp required, please install it first")
st_crs(sp::proj4string(x)) # nocov
}
......@@ -121,19 +121,23 @@ st_geos_binop = function(op, x, y, par = 0.0, pattern = NA_character_,
stopifnot(st_crs(x) == st_crs(y))
if (isTRUE(st_is_longlat(x)) && !(op %in% c("equals", "equals_exact", "polygonize")))
message_longlat(paste0("st_", op))
ret = CPL_geos_binop(st_geometry(x), st_geometry(y), op, par, pattern, prepared)
if (length(ret) == 0 || is.null(dim(ret[[1]]))) {
id = if (is.null(row.names(x)))
as.character(1:length(ret))
if (prepared && isTRUE(st_dimension(x) == 0) && isTRUE(st_dimension(y) == 2))
t(st_geos_binop(op, y, x, par = par, pattern = pattern, sparse = sparse, prepared = prepared))
else {
ret = CPL_geos_binop(st_geometry(x), st_geometry(y), op, par, pattern, prepared)
if (length(ret) == 0 || is.null(dim(ret[[1]]))) {
id = if (is.null(row.names(x)))
as.character(1:length(ret))
else
row.names(x)
sgbp = sgbp(ret, predicate = op, region.id = id, ncol = length(st_geometry(y)))
if (! sparse)
as.matrix(sgbp)
else
row.names(x)
sgbp = sgbp(ret, predicate = op, region.id = id, ncol = length(st_geometry(y)))
if (! sparse)
as.matrix(sgbp)
else
sgbp
} else # CPL_geos_binop returned a matrix, e.g. from op = "relate"
ret[[1]]
sgbp
} else # CPL_geos_binop returned a matrix, e.g. from op = "relate"
ret[[1]]
}
}
#' Compute geometric measurements
......@@ -232,6 +236,8 @@ st_relate = function(x, y, pattern = NA_character_, sparse = !is.na(pattern)) {
#' @param x object of class \code{sf}, \code{sfc} or \code{sfg}
#' @param y object of class \code{sf}, \code{sfc} or \code{sfg}; if missing, \code{x} is used
#' @param sparse logical; should a sparse index list be returned (TRUE) or a dense logical matrix? See below.
#' @param prepared logical; prepare geometry for x, before looping over y? See Details.
#' @details If \code{prepared} is \code{TRUE}, and \code{x} contains POINT geometries and \code{y} contains polygons, then the polygon geometries are prepared, rather than the points.
#' @return If \code{sparse=FALSE}, \code{st_predicate} (with \code{predicate} e.g. "intersects") returns a dense logical matrix with element \code{i,j} \code{TRUE} when \code{predicate(x[i], y[j])} (e.g., when geometry of feature i and j intersect); if \code{sparse=TRUE}, an object of class \code{\link{sgbp}} with a sparse list representation of the same matrix, with list element \code{i} an integer vector with all indices j for which \code{predicate(x[i],y[j])} is \code{TRUE} (and hence \code{integer(0)} if none of them is \code{TRUE}). From the dense matrix, one can find out if one or more elements intersect by \code{apply(mat, 1, any)}, and from the sparse list by \code{lengths(lst) > 0}, see examples below.
#' @details For most predicates, a spatial index is built on argument \code{x}; see \url{http://r-spatial.org/r/2017/06/22/spatial-index.html}.
#' Specifically, \code{st_intersects}, \code{st_disjoint}, \code{st_touches} \code{st_crosses}, \code{st_within}, \code{st_contains}, \code{st_contains_properly}, \code{st_overlaps}, \code{st_equals}, \code{st_covers} and \code{st_covered_by} all build spatial indexes for more efficient geometry calculations. \code{st_relate}, \code{st_equals_exact}, and \code{st_is_within_distance} do not.
......@@ -285,7 +291,6 @@ st_within = function(x, y, sparse = TRUE, prepared = TRUE)
#' @name geos_binary_pred
#' @export
#' @param prepared logical; prepare geometry for x, before looping over y?
st_contains = function(x, y, sparse = TRUE, prepared = TRUE)
st_geos_binop("contains", x, y, sparse = sparse, prepared = prepared)
......@@ -367,7 +372,7 @@ st_is_within_distance = function(x, y, dist, sparse = TRUE) {
#' Geometric unary operations on simple feature geometry sets
#'
#' Geometric unary operations on simple feature geometry sets. These are all generics, with methods for \code{sfg}, \code{sfc} and \code{sf} objects, returning an object of the same class.
#' Geometric unary operations on simple feature geometries. These are all generics, with methods for \code{sfg}, \code{sfc} and \code{sf} objects, returning an object of the same class. All operations work on a per-feature basis, ignoring all other features.
#' @name geos_unary
#' @param x object of class \code{sfg}, \code{sfg} or \code{sf}
#' @param dist numeric; buffer distance for all, or for each of the elements in \code{x}; in case
......@@ -467,10 +472,10 @@ st_buffer.sfc = function(x, dist, nQuadSegs = 30,
endCapStyle = rep(styles$endCapStyle, length.out = length(x))
joinStyle = rep(styles$joinStyle, length.out = length(x))
mitreLimit = rep(styles$mitreLimit, length.out = length(x))
if (any(endCapStyle == 2) && (st_geometry_type(x) == "POINT" || st_geometry_type(x) == "MULTIPOINT")) {
if (any(endCapStyle == 2) && any(st_geometry_type(x) == "POINT" | st_geometry_type(x) == "MULTIPOINT")) {
stop("Flat capstyle is incompatible with POINT/MULTIPOINT geometries") # nocov
}
if (dist < 0 && !st_geometry_type(x) %in% c("POLYGON", "MULTIPOLYGON")) {
if (any(dist < 0) && !any(st_geometry_type(x) %in% c("POLYGON", "MULTIPOLYGON"))) {
stop("Negative width values may only be used with POLYGON or MULTIPOLYGON geometries") # nocov
}
......@@ -535,7 +540,7 @@ st_convex_hull.sf = function(x) {
#' @name geos_unary
#' @export
#' @details \code{st_simplify} simplifies lines by removing vertices
#' @param preserveTopology logical; carry out topology preserving simplification? May be specified for each, or for all feature geometries.
#' @param preserveTopology logical; carry out topology preserving simplification? May be specified for each, or for all feature geometries. Note that topology is preserved only for single feature geometries, not for sets of them.
#' @param dTolerance numeric; tolerance parameter, specified for all or for each feature geometry.
st_simplify = function(x, preserveTopology = FALSE, dTolerance = 0.0)
UseMethod("st_simplify")
......@@ -788,7 +793,7 @@ st_node.sf = function(x) {
#' @name geos_unary
#' @details \code{st_segmentize} adds points to straight lines
#' @export
#' @param dfMaxLength maximum length of a line segment. If \code{x} has geographical coordinates (long/lat), \code{dfMaxLength} is either a numeric expressed in meter, or an object of class \code{units} with length units or unit \code{rad} or \code{degree}; segmentation takes place along the great circle, using \link[lwgeom]{st_geod_segmentize}.
#' @param dfMaxLength maximum length of a line segment. If \code{x} has geographical coordinates (long/lat), \code{dfMaxLength} is either a numeric expressed in meter, or an object of class \code{units} with length units \code{rad} or \code{degree}; segmentation in the long/lat case takes place along the great circle, using \link[lwgeom]{st_geod_segmentize}.
#' @param ... ignored
#' @examples
#' sf = st_sf(a=1, geom=st_sfc(st_linestring(rbind(c(0,0),c(1,1)))), crs = 4326)
......
......@@ -177,10 +177,16 @@ graticule_attributes = function(df) {
if (nrow(df) == 0)
return(df)
xy = cbind(
do.call(rbind, lapply(object, function(x) { y = x[[1]]; y[1,] } )),
do.call(rbind, lapply(object, function(x) { y = x[[length(x)]]; y[nrow(y),] } ))
)
xy = matrix(NA, nrow = length(object), ncol = 4)
for (i in seq_along(object)) {
o = object[[i]]
if (length(o) == 1) {
pts = o[[1]]
xy[i, 1:2] = pts[1,] # start
xy[i, 3:4] = pts[nrow(pts),] # end
} else
xy[i, ] = st_bbox(o)
}
df$x_start = xy[,1]
df$y_start = xy[,2]
df$x_end = xy[,3]
......
......@@ -77,6 +77,7 @@ setOldClass("sfg")
packageStartupMessage(paste(
"Linked against:", CPL_geos_version(TRUE, TRUE),
"compiled against:", CPL_geos_version(FALSE, TRUE)))
packageStartupMessage("It is probably a good idea to reinstall sf, and maybe rgeos and rgdal too")
} # nocov end
}
......
This diff is collapsed.
......@@ -176,6 +176,7 @@ process_cpl_read_ogr = function(x, quiet = FALSE, ..., check_ring_dir = FALSE,
}
#' @name st_read
#' @param fid_column_name character; name of column to write feature IDs to; defaults to not doing this
#' @note The use of \code{system.file} in examples make sure that examples run regardless where R is installed:
#' typical users will not use \code{system.file} but give the file name directly, either with full path or relative
#' to the current working directory (see \link{getwd}). "Shapefiles" consist of several files with the same basename
......@@ -183,7 +184,7 @@ process_cpl_read_ogr = function(x, quiet = FALSE, ..., check_ring_dir = FALSE,
#' @export
st_read.character = function(dsn, layer, ..., query = NA, options = NULL, quiet = FALSE, geometry_column = 1L, type = 0,
promote_to_multi = TRUE, stringsAsFactors = default.stringsAsFactors(),
int64_as_string = FALSE, check_ring_dir = FALSE) {
int64_as_string = FALSE, check_ring_dir = FALSE, fid_column_name = character(0)) {
layer = if (missing(layer))
character(0)
......@@ -196,7 +197,8 @@ st_read.character = function(dsn, layer, ..., query = NA, options = NULL, quiet
if (length(promote_to_multi) > 1)
stop("`promote_to_multi' should have length one, and applies to all geometry columns")
x = CPL_read_ogr(dsn, layer, query, as.character(options), quiet, type, promote_to_multi, int64_as_string)
x = CPL_read_ogr(dsn, layer, query, as.character(options), quiet, type, fid_column_name,
promote_to_multi, int64_as_string)
process_cpl_read_ogr(x, quiet, check_ring_dir = check_ring_dir,
stringsAsFactors = stringsAsFactors, geometry_column = geometry_column, ...)
}
......@@ -295,10 +297,12 @@ abbreviate_shapefile_names = function(x) {
#' to update (append to) the existing data source, e.g. adding a table to an existing database.
#' @param delete_dsn logical; delete data source \code{dsn} before attempting to write?
#' @param delete_layer logical; delete layer \code{layer} before attempting to write? (not yet implemented)
#' @param fid_column_name character, name of column with feature IDs; if specified, this column is no longer written as feature attribute.
#' @details columns (variables) of a class not supported are dropped with a warning. When deleting layers or
#' data sources is not successful, no error is emitted. \code{delete_dsn} and \code{delete_layers} should be
#' handled with care; the former may erase complete directories or databases.
#' @seealso \link{st_drivers}
#' @return \code{obj}, invisibly; in case \code{obj} is of class \code{sfc}, it is returned as an \code{sf} object.
#' @examples
#' nc = st_read(system.file("shape/nc.shp", package="sf"))
#' st_write(nc, "nc.shp")
......@@ -332,7 +336,8 @@ st_write.sfc = function(obj, dsn, layer, ...) {
st_write.sf = function(obj, dsn, layer = NULL, ...,
driver = guess_driver_can_write(dsn),
dataset_options = NULL, layer_options = NULL, quiet = FALSE, factorsAsCharacter = TRUE,
update = driver %in% db_drivers, delete_dsn = FALSE, delete_layer = FALSE) {
update = driver %in% db_drivers, delete_dsn = FALSE, delete_layer = FALSE,
fid_column_name = NULL) {
if (missing(dsn))
stop("dsn should specify a data source or filename")
......@@ -345,8 +350,9 @@ st_write.sf = function(obj, dsn, layer = NULL, ...,
}
if (is.null(layer))
layer = deparse(substitute(obj))
return(dbWriteTable(dsn, name = layer, value = obj, ...,
factorsAsCharacter = factorsAsCharacter))
dbWriteTable(dsn, name = layer, value = obj, ...,
factorsAsCharacter = factorsAsCharacter)
return(invisible(obj))
} else if (!inherits(dsn, "character")) { # add methods for other dsn classes here...
stop(paste("no st_write method available for dsn of class", class(dsn)[1]))
}
......@@ -380,23 +386,30 @@ st_write.sf = function(obj, dsn, layer = NULL, ...,
else
class(geom[[1]])[1]
fids = if (!is.null(fid_column_name)) {
fids = as.character(obj[[fid_column_name]])
obj[[fid_column_name]] = NULL
fids
} else
character(0)
ret = CPL_write_ogr(obj, dsn, layer, driver,
as.character(dataset_options), as.character(layer_options),
geom, dim, quiet, update, delete_dsn, delete_layer)
geom, dim, fids, quiet, update, delete_dsn, delete_layer)
if (ret == 1) { # try through temp file:
tmp = tempfile(fileext = paste0(".", tools::file_ext(dsn))) # nocov start
if (!quiet)
message(paste("writing first to temporary file", tmp))
if (CPL_write_ogr(obj, tmp, layer, driver,
as.character(dataset_options), as.character(layer_options),
geom, dim, quiet, update, delete_dsn, delete_layer) == 1)
geom, dim, fids, quiet, update, delete_dsn, delete_layer) == 1)
stop(paste("failed writing to temporary file", tmp))
if (!file.copy(tmp, dsn, overwrite = update || delete_dsn || delete_layer))
stop(paste("copying", tmp, "to", dsn, "failed"))
if (!file.remove(tmp))
warning(paste("removing", tmp, "failed"))
} # nocov end
invisible(NULL)
invisible(obj)
}
#' @name st_write
......
......@@ -225,7 +225,7 @@ st_sf = function(..., agr = NA_agr_, row.names,
all_sfc_columns = which(unlist(all_sfc_columns))
# set names if not present:
all_sfc_names = if (!is.null(names(x)) && nzchar(names(x)[all_sfc_columns]))
all_sfc_names = if (!is.null(names(x)) && any(nzchar(names(x)[all_sfc_columns])))
names(x)[all_sfc_columns]
else {
object = as.list(substitute(list(...)))[-1L]
......@@ -255,7 +255,8 @@ st_sf = function(..., agr = NA_agr_, row.names,
x[-all_sfc_columns]
else
cbind(data.frame(row.names = row.names),
data.frame(x[-all_sfc_columns], stringsAsFactors = stringsAsFactors))
as.data.frame(x[-all_sfc_columns],
stringsAsFactors = stringsAsFactors, optional = TRUE))
for (i in seq_along(all_sfc_names))
df[[ all_sfc_names[i] ]] = st_sfc(x[[ all_sfc_columns[i] ]], check_ring_dir = check_ring_dir)
......@@ -426,3 +427,12 @@ as.data.frame.sf = function(x, ...) {
class(x) <- setdiff(class(x), "sf")
NextMethod()
}
#' @export
#' @name st_geometry
#' @details \code{st_drop_geometry} drops the geometry of its argument, and reclasses it accordingly
st_drop_geometry = function(x) {
if (!inherits(x, "sf"))
stop("st_drop_geometry only works with objects of class sf")
st_set_geometry(x, NULL)
}
......@@ -119,10 +119,9 @@ sfg_is_empty = function(x) {
#' @export
"[.sfc" = function(x, i, j, ..., op = st_intersects) {
old = x
if (!missing(i) && (inherits(i, "sf") || inherits(i, "sfc") || inherits(i, "sfg")))
i = lengths(op(x, i, ...)) != 0
st_sfc(NextMethod(), crs = st_crs(old), precision = st_precision(old))
st_sfc(NextMethod(), crs = st_crs(x), precision = st_precision(x))
}
......@@ -347,11 +346,14 @@ st_precision.sfc <- function(x) {
#' Set precision
#'
#' @name st_precision
#' @param precision numeric; see \link{st_as_binary} for how to do this.
#' @details Setting a \code{precision} has no direct effect on coordinates of geometries, but merely set an attribute tag to an \code{sfc} object. The effect takes place in \link{st_as_binary} or, more precise, in the C++ function \code{CPL_write_wkb}, where simple feature geometries are being serialized to well-known-binary (WKB). This happens always when routines are called in GEOS library (geometrical operations or predicates), for writing geometries using \link{st_write} or \link{write_sf}, \code{st_make_valid} in package \code{lwgeom}; also \link{aggregate} and \link{summarise} by default union geometries, which calls a GEOS library function. Routines in these libraries receive rounded coordinates, and possibly return results based on them. \link{st_as_binary} contains an example of a roundtrip of \code{sfc} geometries through WKB, in order to see the rounding happening to R data.
#' @param precision numeric, or object of class \code{units} with distance units (but see details); see \link{st_as_binary} for how to do this.
#' @details If \code{precision} is a \code{units} object, the object on which we set precision must have a coordinate reference system with compatible distance units.
#'
#' Setting a \code{precision} has no direct effect on coordinates of geometries, but merely set an attribute tag to an \code{sfc} object. The effect takes place in \link{st_as_binary} or, more precise, in the C++ function \code{CPL_write_wkb}, where simple feature geometries are being serialized to well-known-binary (WKB). This happens always when routines are called in GEOS library (geometrical operations or predicates), for writing geometries using \link{st_write} or \link{write_sf}, \code{st_make_valid} in package \code{lwgeom}; also \link{aggregate} and \link{summarise} by default union geometries, which calls a GEOS library function. Routines in these libraries receive rounded coordinates, and possibly return results based on them. \link{st_as_binary} contains an example of a roundtrip of \code{sfc} geometries through WKB, in order to see the rounding happening to R data.
#'
#' The reason to support precision is that geometrical operations in GEOS or liblwgeom may work better at reduced precision. For writing data from R to external resources it is harder to think of a good reason to limiting precision.
#' @seealso \link{st_as_binary} for an explanation of what setting precision actually does.
#'
#' @seealso \link{st_as_binary} for an explanation of what setting precision does, and the examples therein.
#' @examples
#' x <- st_sfc(st_point(c(pi, pi)))
#' st_precision(x)
......@@ -367,6 +369,15 @@ st_set_precision.sfc <- function(x, precision) {
if (length(precision) != 1) {
stop("Precision applies to all dimensions and must be of length 1.", call. = FALSE)
}
if (inherits(precision, "units")) {
u = st_crs(x, parameters=TRUE)$ud_unit
if (is.null(u) || !inherits(u, "units"))
stop("cannot use precision expressed as units when target object has no units (CRS) set")
units(precision) = 1/u # convert
precision = as.numeric(precision)
}
if (is.na(precision) || !is.numeric(precision)) {
stop("Precision must be numeric", call. = FALSE)
}
......@@ -479,15 +490,15 @@ st_as_sfc.list = function(x, ..., crs = NA_crs_) {
return(st_sfc(crs = crs))
if (is.raw(x[[1]]))
st_as_sfc(structure(x, class = "WKB"), ...)
st_as_sfc.WKB(as_wkb(x), ..., crs = crs)
else if (inherits(x[[1]], "sfg"))
st_sfc(x, crs = crs)
else if (is.character(x[[1]])) { # hex wkb or wkt:
ch12 = substr(x[[1]], 1, 2)
if (ch12 == "0x" || ch12 == "00" || ch12 == "01") # hex wkb
st_as_sfc(structure(x, class = "WKB"), ...)
st_as_sfc.WKB(as_wkb(x), ..., crs = crs)
else
st_as_sfc(unlist(x), ...) # wkt
st_as_sfc(unlist(x), ..., crs = crs) # wkt
} else
stop(paste("st_as_sfc.list: don't know what to do with list with elements of class", class(x[[1]])))
}
......
......@@ -85,7 +85,7 @@ st_as_sf.Spatial = function(x, ...) {
st_as_sfc = function(x, ...) UseMethod("st_as_sfc")
handle_bbox = function(sfc, sp) {
bb = structure(bb_wrap(as.vector(sp::bbox(sp))), class = "bbox")
bb = structure(bb_wrap(as.vector(sp::bbox(sp)[1:2,])), class = "bbox")
structure(sfc, "bbox" = bb)
}
......
......@@ -18,15 +18,45 @@ gdal_read = function(x, ..., options = character(0), driver = character(0), read
#' @export
#' @param type gdal write type