/
filter.R
86 lines (78 loc) · 2.22 KB
/
filter.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
#' Filter to Intersecting Pieces
#'
#' @param from Required. sf dataframe. the geography to subset
#' @param to Required. sf dataframe. the geography that from must intersect
#' @param bool Optional, defaults to FALSE. Should this just return a logical vector?
#' @templateVar epsg TRUE
#' @template template
#'
#' @return sf data frame or logical vector if bool == TRUE
#' @export
#'
#' @concept datatable
#'
#' @examples
#' \dontrun{
#' # Needs Census Bureau API
#' data(towns)
#' block <- create_block_table('NY', 'Rockland')
#' geo_filter(block, towns)
#' }
#'
#' data(towns)
#' data(rockland)
#' sub <- geo_filter(rockland, towns)
#'
geo_filter <- function(from, to, bool = FALSE, epsg = 3857) {
pairs <- make_planar_pair(from, to, epsg = epsg)
from <- pairs$x
to <- pairs$y
ints <- geos::geos_intersects(
from,
geos::geos_unary_union(geos::geos_make_collection(to))
)
if (bool) {
return(ints)
}
from[ints, ]
}
#' Trim Away Small Pieces
#'
#' @param from Required. sf dataframe. the geography to subset
#' @param to Required. sf dataframe. the geography that from must intersect
#' @param thresh Percent as decimal of an area to trim away. Default is .01, which is 1%.
#' @param bool Optional, defaults to FALSE. Should this just return a logical vector?
#' @templateVar epsg TRUE
#' @template template
#'
#' @return sf data frame or logical vector if bool=TRUE
#' @export
#'
#' @concept datatable
#' @examples \dontrun{
#' # Needs Census Bureau API
#' data(towns)
#' block <- create_block_table('NY', 'Rockland')
#' geo_trim(block, towns, thresh = 0.05)
#' }
#'
#' data(towns)
#' data(rockland)
#' sub <- geo_filter(rockland, towns)
#' rem <- geo_trim(sub, towns, thresh = 0.05)
#'
geo_trim <- function(from, to, thresh = 0.01, bool = FALSE, epsg = 3857) {
pairs <- make_planar_pair(from, to, epsg = epsg)
from <- pairs$x
to <- pairs$y
ints <- geos::geos_intersection(from, geos::geos_unary_union(geos::geos_make_collection(to)))
area <- geos::geos_area(from)
areaints <- rep(0, nrow(from))
areaints <- geos::geos_area(geos::geos_make_valid(ints)) # , NA_on_exception = TRUE in valid
keep <- as.numeric(areaints / area) > thresh
keep[is.na(keep)] <- FALSE
if (bool) {
return(keep)
}
from[keep, ]
}