forked from e-sensing/sits
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathapi_space_time_operations.R
156 lines (151 loc) · 4.91 KB
/
api_space_time_operations.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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
#' @title Coordinate transformation (lat/long to X/Y)
#' @name .proj_from_latlong
#' @keywords internal
#' @noRd
#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
#'
#' @description Transform a latitude and longitude coordinate to XY coordinate
#'
#' @param longitude Longitude of the chosen location.
#' @param latitude Latitude of the chosen location.
#' @param crs Projection definition to be converted to.
#' @return Tibble with X and Y coordinates.
.proj_from_latlong <- function(longitude,
latitude,
crs) {
t <- tibble::tibble(long = longitude, lat = latitude) |>
sf::st_as_sf(coords = c("long", "lat"), crs = 4326) |>
sf::st_transform(crs = crs) |>
sf::st_coordinates() |>
tibble::as_tibble()
colnames(t) <- c("X", "Y")
return(t)
}
#' @title Coordinate transformation (X/Y to lat/long)
#' @name .proj_to_latlong
#' @keywords internal
#' @noRd
#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
#'
#' @description Transform a XY coordinate to a latitude and longitude
#'
#' @param x X coordinate of the chosen location.
#' @param y Y coordinate of the chosen location.
#' @param crs Projection definition to be converted from.
#' @return Matrix with latlong coordinates.
.proj_to_latlong <- function(x, y, crs) {
ll <- tibble::tibble(xc = x, yc = y) |>
sf::st_as_sf(coords = c("xc", "yc"), crs = crs) |>
sf::st_transform(crs = "EPSG:4326") |>
sf::st_coordinates()
colnames(ll) <- c("longitude", "latitude")
return(ll)
}
#' @title Spatial intersects
#' @noRd
#'
#' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}
#'
#' @description
#' This function is based on sf::st_intersects(). It projects y
#' to the CRS of x before compute intersection. For each geometry of x,
#' returns TRUE if it intersects with any geometry of y,
#' otherwise it returns FALSE.
#'
#' @param x,y sf geometries.
#'
#' @returns A vector indicating which geometries of x
#' intersect geometries of y.
#'
#' @examples
#' if (sits_run_examples()) {
#' x <- .bbox_as_sf(c(xmin = 1, xmax = 2, ymin = 3, ymax = 4, crs = 4326))
#' y <- .roi_as_sf(c(lon_min = 1.5, lon_max = 3,
#' lat_min = 3.5, lat_max = 5))
#' .intersects(x, y) # TRUE
#' }
#'
.intersects <- function(x, y) {
as_crs <- sf::st_crs(x)
y <- sf::st_transform(y, crs = as_crs)
apply(suppressMessages(sf::st_intersects(x, y, sparse = FALSE)), 1, any)
}
#' @title Spatial within
#' @noRd
#'
#' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}
#'
#' @description
#' This function is based on sf::st_within(). It projects y
#' to the CRS of x before compute within. For each geometry of x,
#' returns TRUE if it is within any geometry of y,
#' otherwise it returns FALSE.
#'
#' @param x,y sf geometries.
#'
#' @returns A vector indicating which geometries of x
#' is within geometries of y.
#'
#' @examples
#' if (sits_run_examples()) {
#' x <- .bbox_as_sf(c(xmin = 1, xmax = 2, ymin = 3, ymax = 4, crs = 4326))
#' y <- .roi_as_sf(c(lon_min = 0, lon_max = 3, lat_min = 2, lat_max = 5))
#' .within(x, y) # TRUE
#' }
#'
.within <- function(x, y) {
as_crs <- sf::st_crs(x)
y <- sf::st_transform(y, crs = as_crs)
apply(suppressMessages(sf::st_within(x, y, sparse = FALSE)), 1, any)
}
#' @title Spatial contains
#' @noRd
#'
#' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}
#' @author Felipe Carvalho, \email{felipe.carvalho@@inpe.br}
#'
#' @description
#' This function is based on sf::st_contains(). It projects y
#' to the CRS of x before compute contains operation. For each geometry of x,
#' returns TRUE if it is contained any geometry of y,
#' otherwise it returns FALSE.
#'
#' @param x,y sf geometries.
#'
#' @returns A vector indicating which geometries of x
#' is contained geometries of y.
#'
#' @examples
#' if (sits_run_examples()) {
#' x <- .roi_as_sf(c(lon_min = 0, lon_max = 3, lat_min = 2, lat_max = 5))
#' y <- .bbox_as_sf(c(xmin = 1, xmax = 2, ymin = 3, ymax = 4, crs = 4326))
#' .contains(x, y) # TRUE
#' }
#'
.contains <- function(x, y) {
as_crs <- sf::st_crs(x)
y <- sf::st_transform(y, crs = as_crs)
apply(sf::st_contains(x, y, sparse = FALSE), 1, any)
}
#' @title Find the closest points.
#'
#' @author Alber Sanchez, \email{alber.ipia@@inpe.br}
#' @keywords internal
#' @noRd
#' @description
#' For each point in x, find the closest point in y (and their distance).
#'
#' @param x An `sf` object (points).
#' @param y An `sf` object (points).
#'
#' @return A data.frame with the columns from (row number in a), b
#' (row number in b), and distance (in meters).
.find_closest <- function(x, y = x) {
dist_xy <- sf::st_distance(x, y)
class(dist_xy) <- setdiff(class(dist_xy), "units")
attr(dist_xy, "units") <- NULL
dist_xy[dist_xy == 0] <- Inf
min_dist <- apply(dist_xy, MARGIN = 1, FUN = min)
dist_df <- tibble::tibble(distance = min_dist)
return(dist_df)
}