-
Notifications
You must be signed in to change notification settings - Fork 3
/
aoi_utilities.R
102 lines (85 loc) 路 2.39 KB
/
aoi_utilities.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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
#' @title Is Inside
#' @description A check to see if one object is inside another
#' @param obj object 1
#' @param AOI object 2
#' @param total boolean.
#' If \code{TRUE} then check if obj is completely
#' inside the AOI (and vice versa: order doesn't matter).
#' If \code{FALSE}, then check if at least part
#' of obj is in the AOI.
#' @return boolean value
#' @export
#' @importFrom sf st_intersects st_intersection st_transform st_crs
aoi_inside <- function(AOI, obj, total = TRUE) {
AOI <- make_sf(AOI)
obj <- st_transform(make_sf(obj), st_crs(AOI))
int <- suppressMessages(st_intersects(obj, AOI))
if (!apply(int, 1, any)) {
return(FALSE)
} else {
x <- suppressWarnings(
suppressMessages(sf::st_intersection(obj, AOI))
)
inside <- any(x$geometry == AOI$geometry, x$geometry == obj$geometry)
if (total) {
return(inside)
} else {
return(TRUE)
}
}
}
#' @title Convert raster and sp objects to sf
#' @description Convert raster and sp objects to sf
#' @param x any spatial object
#' @return an sf object
#' @keywords internal
#' @importFrom sf st_as_sf
make_sf <- function(x) {
if (inherits(x, "SpatRaster")) {
x <- bbox_get(x)
} else if (inherits(x, "Spatial")) {
x <- sf::st_as_sf(x)
} else if (inherits(x, "data.frame")) {
x <- sf::st_as_sf(x)
} else {
x <- NULL
}
x
}
rename_geometry = function(g, name) {
current = attr(g, "sf_column")
names(g)[names(g) == current] = name
attr(g, "sf_column") <- name
g
}
#' Returns a data.frame of valid states with abbreviations and regions
#'
#' @return data.frame of states with abbreviation and region
#' @export
#' @examples
#' \dontrun{
#' list_states()
#' }
list_states <- function() {
return(data.frame(
state_abbr = datasets::state.abb,
name = datasets::state.name,
region = datasets::state.region
))
}
#' Returns a sf data.frame of fipio data
#' @param state State names, state abbreviations, or one of the following: "all", "conus", "territories"
#' @param county County names or "all"
#' @return sf data.frame
#' @export
#' @examples
#' \dontrun{
#' fip_meta()
#' }
#' @importFrom sf st_as_sf
#' @importFrom fipio as_fips fips_metadata
fip_meta <- function(state, county = NULL) {
fipio::as_fips(county = county, state = state) %>%
fipio::fips_metadata(geometry = TRUE) %>%
st_as_sf()
}