/
filter-Spat.R
148 lines (134 loc) · 4.09 KB
/
filter-Spat.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
#' Subset cells/geometries of `Spat*` objects
#'
#' @description
#' The `filter()` function is used to subset `Spat*` objects, retaining all
#' cells/geometries that satisfy your conditions. To be retained, the
#' cell/geometry must produce a value of `TRUE` for all conditions.
#'
#' **It is possible to filter a `SpatRaster` by its geographic coordinates**.
#' You need to use `filter(.data, x > 42)`. Note that `x` and `y` are reserved
#' names on \CRANpkg{terra}, since they refer to the geographic coordinates of
#' the layer.
#'
#' See **Examples** and section **About layer names** on [as_tibble.Spat()].
#'
#' @export
#' @rdname filter.Spat
#' @name filter.Spat
#'
#' @seealso [dplyr::filter()]
#'
#' @family single table verbs
#' @family dplyr.rows
#' @family dplyr.methods
#'
#' @importFrom dplyr filter
#' @inheritParams select.Spat
#' @param ... <[`data-masking`][rlang::args_data_masking]> Expressions that
#' return a logical value, and are defined in terms of the layers/attributes
#' in `.data`. If multiple expressions are included, they are combined with
#' the `&` operator. Only cells/geometries for which all conditions evaluate
#' to `TRUE` are kept. See **Methods**.
#' @param .preserve Ignored for `Spat*` objects.
#' @param .keep_extent Should the extent of the resulting `SpatRaster` be kept?
#' On `FALSE`, [terra::trim()] is called so the extent of the result may be
#' different of the extent of the output. See also [drop_na.SpatRaster()].
#'
#' @return A `Spat*` object of the same class than `.data`. See **Methods**.
#'
#' @section Methods:
#'
#' Implementation of the **generic** [dplyr::filter()] function.
#'
#' ## `SpatRaster`
#'
#' Cells that do not fulfill the conditions on `...` are returned with value
#' `NA`. On a multi-layer `SpatRaster` the `NA` is propagated across all the
#' layers.
#'
#' If `.keep_extent = TRUE` the returning `SpatRaster` has the same crs, extent,
#' resolution and hence the same number of cells than `.data`. If
#' `.keep_extent = FALSE` the outer `NA` cells are trimmed with [terra::trim()],
#' so the extent and number of cells may differ. The output would present in
#' any case the same crs and resolution than `.data`.
#'
#' `x` and `y` variables (i.e. the longitude and latitude of the `SpatRaster`)
#' are also available internally for filtering. See **Examples**.
#'
#' ## `SpatVector`
#'
#' The result is a `SpatVector` with all the geometries that produce a value of
#' `TRUE` for all conditions.
#'
#'
#' @examples
#'
#' library(terra)
#' f <- system.file("extdata/cyl_temp.tif", package = "tidyterra")
#'
#' r <- rast(f) %>% select(tavg_04)
#'
#' plot(r)
#'
#'
#' # Filter temps
#' r_f <- r %>% filter(tavg_04 > 11.5)
#'
#' # Extent is kept
#' plot(r_f)
#'
#'
#' # Filter temps and extent
#' r_f2 <- r %>% filter(tavg_04 > 11.5, .keep_extent = FALSE)
#'
#' # Extent has changed
#' plot(r_f2)
#'
#'
#' # Filter by geographic coordinates
#' r2 <- project(r, "epsg:4326")
#'
#' r2 %>% plot()
#'
#' r2 %>%
#' filter(
#' x > -4,
#' x < -2,
#' y > 42
#' ) %>%
#' plot()
filter.SpatRaster <- function(.data, ..., .preserve = FALSE,
.keep_extent = TRUE) {
df <- as_tbl_internal(.data)
xy <- dplyr::select(df, 1:2)
values <- df
# Filter
filtered <- dplyr::filter(values, ...)
# Rebuild raster
rebuild_df <- dplyr::left_join(xy, filtered,
by = c("x", "y")
)
# For dtplyr
rebuild_df <- data.table::as.data.table(rebuild_df)
attributes(rebuild_df) <- attributes(df)
newrast <- as_spat_internal(rebuild_df)
if (!isTRUE(.keep_extent)) newrast <- terra::trim(newrast)
if (any(terra::has.colors(.data))) {
terra::coltab(newrast) <- terra::coltab(.data)
}
return(newrast)
}
#' @export
#' @rdname filter.Spat
filter.SpatVector <- function(.data, ..., .preserve = FALSE) {
# Use own method
tbl <- as_tibble(.data)
var_index <- make_safe_index("tterra_index", tbl)
tbl[[var_index]] <- seq_len(nrow(tbl))
filtered <- dplyr::filter(tbl, ..., .preserve = .preserve)
vend <- .data[as.integer(filtered[[var_index]]), ]
vend <- group_prepare_spat(vend, filtered)
return(vend)
}
#' @export
dplyr::filter