new "sftable<-"

[mdsumner]

the dream is back

  x <- silicate::inlandwaters
#x <- silicate::minimal_mesh
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(sf)
#> Linking to GEOS 3.8.0, GDAL 2.4.0, PROJ 5.2.0
#> WARNING: different compile-time and runtime versions for GEOS found:
#> Linked against: 3.8.0-CAPI-1.13.1  compiled against: 3.7.1-CAPI-1.11.1
#> It is probably a good idea to reinstall sf, and maybe rgeos and rgdal too
library(sfheaders)


sftable <- function(x, ...) {
  tibble::as_tibble(sfheaders::sf_to_df(x))
}

sfc_class <- function(x, ...) {
  classes <-   c("sfc_MULTIPOLYGON", "sfc_POLYGON", 
                 "sfc_MULTILINESTRING", "sfc_LINESTRING", 
                 "sfc_MULTIPOINT", "sfc_POINT")
 classes[na.omit(match(x, classes))]
}

std_mpoly <- function(x, ...) {
  sfheaders::sf_multipolygon(x, 
                             x = "x", y = "y",
                             linestring_id = "linestring_id", 
                             polygon_id = "polygon_id", 
                             multipolygon_id = "multipolygon_id")
}
std_poly <- function(x, ...) {
  sfheaders::sf_polygon(x, 
                             x = "x", y = "y",
                             linestring_id = "linestring_id", 
                             polygon_id = "polygon_id")
}
std_mline <- function(x, ...) {
  sfheaders::sf_multilinestring(x, 
                        x = "x", y = "y",
                        linestring_id = "linestring_id", 
                        multilinestring_id = "multilinestring_id")
}
std_line <- function(x, ...) {
  sfheaders::sf_linestring(x, 
                                x = "x", y = "y",
                                linestring_id = "linestring_id")
}
std_mpoint <- function(x, ...) {
  sfheaders::sf_multipoint(x, 
                           x = "x", y = "y",
                           point_id = "point_id",
                           multipoint_id = "multipoint_id")
}
std_point <- function(x, ...) {
  sfheaders::sf_point(x, 
                           x = "x", y = "y",
                           point_id = "point_id")
}


'sftable<-' <- function(x, ..., value) {
  switch(sfc_class(class(x[[attr(x, "sf_column")]])), 
         sfc_MULTIPOLYGON = std_mpoly(value), 
         sfc_POLYGON = std_poly(value), 
         sfc_MULTILINESTRING = std_mline(value),
         sfc_LINESTRING = std_line(value),
         sfc_MULTIPOINT = std_mpoint(value), 
         sfc_POINT = std_point(value))
}

         

## then hole-removing tidy stuff like above has a general basis to modify with
## replacement 
sftable(x) <- sftable(x)  %>% 
  group_by(multipolygon_id, polygon_id)  %>% 
  filter(linestring_id == 1)  
plot(x)

x <- silicate::inlandwaters
## What about, keep only *polygons* that have holes (we lose ACT, Macquarie Island, Lord Howe, King, Flinders)
sftable(x) <- sftable(x) %>% group_by(multipolygon_id, polygon_id) %>% 
  mutate(nn = max(linestring_id)) %>% dplyr::filter(nn > 1)
plot(x)

^{Created on 2020-03-05 by the reprex package (v0.3.0)}