1suppressPackageStartupMessages(library(sf)) 2library(testthat) 3 4p = st_point(c(1/3,1/6)) 5st_sfc(p, precision = 1000) 6st_as_sfc(st_as_binary(st_sfc(p, precision = 0L))) 7st_as_sfc(st_as_binary(st_sfc(p, precision = 1000))) 8st_as_sfc(st_as_binary(st_sfc(p, precision = 1000000))) 9st_as_sfc(st_as_binary(st_sfc(p, precision = 10L))) 10st_as_sfc(st_as_binary(st_sfc(p, precision = -1))) 11 12d = data.frame(a = 1:2) 13d$geom = c("POINT(0 0)", "POINT(1 1)") 14 15st_as_sf(d, wkt = "geom") 16st_as_sf(d, wkt = 2) 17st_as_sf(d, wkt = "geom", remove = FALSE) 18 19st_as_sfc(c("POINT(0 0)", "POINT(1 1)")) 20st_as_sfc(c("POINT(0 0)", "POINT(1 1)", "POLYGON((0 0,1 1,0 1,0 0))")) 21st_as_sfc(character(0)) 22x = st_as_sfc(character(0), 4326) 23y = st_as_sfc(character(0), crs = 4326) 24all.equal(x, y) 25st_as_sfc(c("POINT(0 0)", "POINT(1 1)", "POLYGON((0 0,1 1,0 1,0 0))"), 26 "+proj=longlat +datum=WGS84") 27dg = st_as_sf(d, wkt = "geom") 28print(dg, n = 1) 29head(st_as_sf(d, wkt = "geom"), 1) 30 31d$geom = st_as_sfc(d$geom) 32d1 = d 33attr(d1, "sf_col") = "geom" 34st_geometry(d1) = d$geom 35 36d$geometry = d$geom # second geometry list-column 37expect_warning(st_geometry(d) <- d$geom) 38d 39 40x = st_sfc(list(st_point(0:1), st_point(0:1)), crs = 4326) 41# don't warn when replacing crs with identical value: 42st_sfc(x, crs = 4326) 43y = st_sfc(x, crs = "+proj=longlat +datum=WGS84 +no_defs") 44# but do when it changes: 45y = st_sfc(x, crs = 3857) 46 47p = st_point(0:1) 48st_cast(p, "MULTIPOINT") 49mp = st_multipoint(rbind(c(0,1), c(2,2))) 50st_cast(mp, "POINT") 51st_cast(mp, "MULTIPOINT") 52 53# geometry collection to its elements: 54st_cast(st_geometrycollection(list(mp)), "POINT") 55st_cast(st_geometrycollection(list(mp)), "MULTIPOINT") 56st_cast(st_geometrycollection(list(p,mp)), "MULTIPOINT") 57 58mp = st_multipoint(rbind(c(0,1))) 59x = st_sfc(p, mp) 60st_cast(x, "POINT") 61 62sf = st_sf(a = 3:2, geom = x) 63st_cast(sf, "POINT") 64 65suppressPackageStartupMessages( library(dplyr) ) 66 67x %>% st_cast("POINT") 68 69# points: 70mp = st_multipoint(rbind(c(0,1))) # single-point multipoint 71st_sfc(p,mp) %>% st_cast("POINT") 72st_sfc(p,mp) %>% st_cast("MULTIPOINT") 73 74# lines: 75pts = rbind(c(0,0), c(1,1), c(2,1)) 76st_sfc(st_linestring(pts), st_multilinestring(list(pts))) %>% st_cast("LINESTRING") 77st_sfc(st_linestring(pts), st_multilinestring(list(pts))) %>% st_cast("MULTILINESTRING") 78 79# polygons: 80pts = rbind(c(0,0), c(1,1), c(0,1), c(0,0)) 81st_sfc(st_polygon(list(pts)), st_multipolygon(list(list(pts)))) %>% st_cast("POLYGON") 82st_sfc(st_polygon(list(pts)), st_multipolygon(list(list(pts)))) %>% st_cast("MULTIPOLYGON") 83 84 85st_sfc(st_geometrycollection(list(p)), st_geometrycollection(list(mp))) %>% st_cast() 86st_sfc(st_geometrycollection(list(p)), st_geometrycollection(list(mp))) %>% 87 st_cast() %>% 88 st_cast("POINT") 89 90p = rbind(c(0,0),c(1,0),c(1,1),c(0,1),c(0,0)) 91pol = st_polygon(list(p)) 92# plot(pol) 93try(plot(st_polygonize(pol))) # --> breaks 94st_length(st_sfc(st_point(c(0,0)))) 95 96try(as(st_sfc(st_linestring(matrix(1:9,3))), "Spatial")) 97 98# check conus is present: 99x = st_sfc(st_point(c(-90,35)), st_point(c(-80,36)), 100 crs = "+proj=longlat +datum=NAD27") 101y = st_transform(x, 3857) 102 103sf_extSoftVersion()[1:3] 104 105# Ops.sfc: 106ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1)))) 107ls * 2 108ls - 2 109(ls + 2) %% 3 110ls / ls 111p_ = st_point(0:1) 112ll = st_sfc(ls[[1]], p_) 113ll & st_sfc(p_) 114ll | st_sfc(p_) 115ll %/% st_sfc(p_) 116ll == st_sfc(p_) 117ll != st_sfc(p_) 118 119 120str(x) 121nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE) 122str(nc) 123bb = st_as_sfc(st_bbox(nc)) 124format(st_bbox(nc)) 125 126st_agr("constant") 127st_agr() 128x <- st_sf(a = 1:2, b = 3:4, geom = x, agr = c("constant", "aggregate")) 129suppressPackageStartupMessages(library(dplyr)) 130y <- x %>% st_set_agr("constant") 131y 132 133sf1 <- st_sf(a = c("x", "y"), geom = st_sfc(st_point(3:4), st_point(3:4))) 134sf1[names(sf1)] 135 136st_bbox(sf1) 137bb = st_bbox(nc) 138bb 139st_crs(bb) 140st_bbox(c(xmin = 16.1, xmax = 16.6, ymin = 48.6, ymax = 47.9), crs = st_crs(4326)) 141st_bbox(c(xmin = 16.1, xmax = 16.6, ymin = 48.6, ymax = 47.9), crs = 4326) 142 143bb$xrange 144bb$yrange 145bb$xmin 146bb$ymin 147bb$xmax 148bb$ymax 149try(bb$foo) 150 151# merge: 152a = data.frame(a = 1:3, b = 5:7) 153st_geometry(a) = st_sfc(st_point(c(0,0)), st_point(c(1,1)), st_point(c(2,2))) 154b = data.frame(x = c("a", "b", "c"), b = c(2,5,6)) 155merge(a, b) 156merge(a, b, all = TRUE) 157 158# joins: 159inner_join(a, b) 160left_join(a, b) 161right_join(a, b) 162full_join(a, b) 163semi_join(a, b) 164anti_join(a, b) 165left_join(a, data.frame(b, geometry = 1), by = "b") 166 167# st_joins: 168a = st_sf(a = 1:3, 169 geom = st_sfc(st_point(c(1,1)), st_point(c(2,2)), st_point(c(3,3)))) 170b = st_sf(a = 11:14, 171 geom = st_sfc(st_point(c(10,10)), st_point(c(2,2)), st_point(c(2,2)), st_point(c(3,3)))) 172st_join(a, b) 173st_join(a, b, left = FALSE) 174# st_join, largest = TRUE: 175nc <- st_transform(st_read(system.file("shape/nc.shp", package="sf")), 2264) 176gr = st_sf( 177 label = apply(expand.grid(1:10, LETTERS[10:1])[,2:1], 1, paste0, collapse = " "), 178 geom = st_make_grid(st_as_sfc(st_bbox(nc)))) 179gr$col = sf.colors(10, categorical = TRUE, alpha = .3) 180# cut, to check, NA's work out: 181gr = gr[-(1:30),] 182st_join(nc, gr, largest = TRUE) 183 184# rbind: 185x = st_sf(a = 1:2, geom = st_sfc(list(st_point(0:1), st_point(0:1)), crs = 4326)) 186rbind(x, x, x) 187nc2 = rbind(nc[1:50, ], nc[51:100, ]) 188all.equal(nc, nc2) 189 190# st_sample: 191suppressWarnings(RNGversion("3.5.3")) 192set.seed(131) 193options(digits=6) 194x = st_sfc(st_polygon(list(rbind(c(0,1),c(90,1),c(90,90),c(0,90),c(0,1)))), crs = st_crs(4326)) 195#if (sf_extSoftVersion()["proj.4"] >= "4.9.0") 196 (p <- st_sample(x, 10)) 197 p <- st_sample(x[[1]], 10) # sfg method 198x = st_sfc(st_polygon(list(rbind(c(0,0),c(90,0),c(90,90),c(0,90),c(0,0))))) # NOT long/lat: 199p <- st_sample(x, 10) 200x = st_sfc(st_polygon(list(rbind(c(-180,-90),c(180,-90),c(180,90),c(-180,90),c(-180,-90)))), 201 crs=st_crs(4326)) 202#FIXME: 203# if (sf_extSoftVersion()["proj.4"] >= "4.9.0") # lwgeom breaks on this 204# (p <- st_sample(x, 10)) 205pt = st_multipoint(matrix(1:20,,2)) 206st_sample(p, 3) 207try(st_sample(p, 3.3)) 208ls = st_sfc(st_linestring(rbind(c(0,0),c(0,1))), 209 st_linestring(rbind(c(0,0),c(.1,0))), 210 st_linestring(rbind(c(0,1),c(.1,1))), 211 st_linestring(rbind(c(2,2),c(2,2.00001)))) 212st_sample(ls, 80) 213st_sample(nc[1:2,], size = c(10,20)) 214# try with LINES, LongLat, should generate a warning: 215nc[1:2,] %>% st_transform(4326) %>% st_cast("MULTILINESTRING") %>% st_sample(size = c(10,20)) 216st_sample(ls, 80, type = "regular") 217p_sample = lapply(1:10, function(i) st_sample(nc[i, ], 100, exact = FALSE)) 218lengths(p_sample) 219p_sample_exact = lapply(1:10, function(i) st_sample(nc[i, ], 100, exact = TRUE)) 220lengths(p_sample_exact) 221#plot(nc$geometry[1]) 222#plot(p_sample[[1]], add = TRUE) 223#plot(p_sample_exact[[1]], add = TRUE) 224 225#class(st_bind_cols(nc, as.data.frame(nc)[1:3])) 226class(dplyr::bind_cols(nc, as.data.frame(nc)[1:3])) 227class(rbind(nc, nc)) 228class(cbind(nc, nc)) 229 230x = st_sfc(st_point(0:1), st_point(2:3)) 231x[c(NA,1,NA,2,NA)] 232 233# jitter 234pts = st_centroid(st_geometry(nc)) 235plot(pts) 236plot(st_jitter(pts, .05), add = TRUE, col = 'red') 237plot(st_geometry(nc)) 238plot(st_jitter(st_geometry(nc), factor = .01), add = TRUE, col = '#ff8888') 239st_jitter(st_sfc(st_point(0:1)), amount = .1) 240 241# st_bbox: 242library(sp) 243demo(meuse, ask = FALSE, echo = FALSE) 244suppressWarnings(st_bbox(meuse)) 245crs = suppressWarnings(st_crs(meuse)) 246library(raster) 247suppressWarnings(st_bbox(raster(meuse.grid))) 248st_bbox(extent(raster())) 249 250# st_to_s2 251if (FALSE) { # stops working with GDAL 2.3.0 / PROJ 5.0.1: 252 x = sf:::st_to_s2(nc) 253 x1 = st_geometry(x) 254 cc = st_coordinates(x1) 255 summary(sqrt(cc[,1]^2+cc[,2]^2+cc[,3]^2)) 256} 257 258# check_ring_dir 259m = rbind(c(0,0), c(0,1), c(1,1), c(1,0), c(0,0)) 260mi = m[nrow(m):1,] 261pol = st_polygon(list(m * 10, m + .5, mi + 1.5, mi + 3.5, m + 5, mi + 6.5)) 262st_sfc(pol) 263x = st_sfc(pol, check_ring_dir=TRUE) 264y = st_sf(a = 1, geom = st_sfc(pol), check_ring_dir=TRUE) 265str(x) 266x = st_sfc(st_polygon(), st_polygon(), check_ring_dir=TRUE) 267str(x) 268# empty ring/zero area: 269x = st_sfc(st_polygon(list(m[c(1,3,1),])), check_ring_dir=TRUE) 270 271mp = st_multipolygon(list(pol, pol)) 272try(x <- st_sfc(mp, st_polygon(), check_ring_dir=TRUE)) 273x <- st_sfc(mp, pol) %>% st_cast("MULTIPOLYGON") %>% st_sfc(check_ring_dir=TRUE) 274x 275str(x) 276 277x = st_sfc(st_linestring(rbind(c(-179,0),c(179,0))), crs = 4326) 278st_wrap_dateline(st_sf(a = 1, geometry = x)) 279st_wrap_dateline(x) 280st_wrap_dateline(x[[1]]) 281 282geo <- c("{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.68152563269095,36.43764870908927]}", 283 "{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.67408758213843,36.43366018922779]}", 284 "{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.67708346361097,36.44208638659282]}", 285 "{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.67886661944996,36.44110273135671]}", 286 "{\"geodesic\":true,\"type\":\"Point\",\"coordinates\":[-118.68089232041565,36.44173155205561]}") 287st_as_sfc(geo, GeoJSON = TRUE) 288st_as_sfc(geo, GeoJSON = TRUE, crs = 4326) 289 290st_as_sfc(st_as_binary(st_sfc(st_point(0:1)))[[1]], crs = 4326) 291 292x = nc 293x$geom = NULL 294class(x) 295 296st_as_sfc(list(st_point(0:1)), crs = 4326) 297 298# crop: 299box = c(xmin = 0, ymin = 0, xmax = 1, ymax = 1) 300 301pol = st_sfc(st_buffer(st_point(c(.5, .5)), .65)) 302pol_sf = st_sf(a=1, geom=pol) 303 304st_crop(pol, box) 305st_crop(pol, st_bbox(box)) 306st_crop(pol_sf, box) 307st_crop(pol_sf, st_bbox(box)) 308 309# new sample methods: 310x = st_sfc(st_polygon(list(rbind(c(0,0),c(90,0),c(90,90),c(0,90),c(0,0))))) # NOT long/lat: 311p <- st_sample(x, 10, type = "regular") 312p <- st_sample(x, 10, type = "hexagonal") 313 314all.equal(st_drop_geometry(pol_sf), st_set_geometry(pol_sf, NULL)) 315 316# https://github.com/r-spatial/sf/issues/1024 317shape1 <-st_sfc(st_polygon(list(rbind(c(0,0), c(1,0), c(3,2), c(2,4), c(1,4), c(0,0))))) 318shape2 <- st_sfc(st_polygon()) 319shape3 <- st_sfc(st_polygon()) 320 321shape4 = st_intersection(shape2, shape3) # has zero features 322 323st_difference(shape1, shape4) 324st_difference(shape4, shape1) 325st_sym_difference(shape1, shape4) 326st_union(shape1, shape4) 327st_union(shape4, shape1) 328 329# transform empty: 330tr = st_sf(geom=st_sfc()) %>% st_set_crs(3587) %>% st_transform(4326) 331 332# NA values are converted to empty; #1114: 333x <- data.frame(name=LETTERS) 334y <- data.frame(name=LETTERS[1:13], letters[14:26]) 335y$geometry <- st_sfc(st_point(c(0,0))) 336y <- st_sf(y) 337out = merge(x, y, all.x=TRUE) 338class(out) 339 340st_as_sf(st_sfc(st_point(0:1))) 341