-
Notifications
You must be signed in to change notification settings - Fork 76
/
api_chunks.R
190 lines (188 loc) · 7.09 KB
/
api_chunks.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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
#' @title Chunks API
#' @noRd
#'
#' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}
#'
#' @description
#' A chunk is a tibble of rectangular regions defining a matrix and
#' its corresponding geographical area. So, each region contains a
#' block and a bbox information. chunks can be used to access
#' specific raster image regions and optimize memory usage.
#'
#' Generally, chunks are created from an actual image that is divided
#' into small blocks. The chunks also provide overlapping support, that is,
#' chunks that intersects its neighbors by some amount of pixels.
#'
#' @examples
#' if (sits_run_examples()) {
#' chunks <- .chunks_create(
#' block = c(ncols = 512, nrows = 512),
#' overlap = 2,
#' image_size = c(ncols = 4000, nrows = 4000),
#' image_bbox = c(xmin = 1, xmax = 2, ymin = 3, ymax = 4, crs = 4326)
#' )
#' # remove overlaps from chunks
#' cropped <- .chunks_no_overlap(chunks)
#' # removing overlaps from a non overlapped chunks produces identical bbox
#' identical(.bbox(cropped), .bbox(.chunks_no_overlap(cropped)))
#' # blocks from 'cropped' can be used to remove any overlap from rasters
#' # produced from 'chunks'.
#' .chunks_filter_spatial(
#' chunks = chunks,
#' roi = c(lon_min = 1.3, lon_max = 1.7, lat_min = 3.3, lat_max = 3.7)
#' )
#' }
NULL
#' @title Create chunks
#' @noRd
#' @param block A block to represent the common chunk size.
#' @param overlap An overlapping size in pixels.
#' @param image_size A block with original image size.
#' @param image_bbox A bbox with original image bbox.
#' @returns A tibble with chunks.
.chunks_create <- function(block, overlap, image_size, image_bbox) {
# Generate all starting block points (col, row)
chunks <- tidyr::expand_grid(
col = seq(1, .ncols(image_size), .ncols(block)),
row = seq(1, .nrows(image_size), .nrows(block))
)
# Adjust col and row to do overlap
chunks[["col"]] <- .as_int(pmax(1, .col(chunks) - overlap))
chunks[["row"]] <- .as_int(pmax(1, .row(chunks) - overlap))
# Adjust ncols and nrows to do overlap
chunks[["ncols"]] <- .as_int(
pmin(.ncols(image_size),
.col(chunks) + .ncols(block) + overlap - 1) - .col(chunks) + 1
)
chunks[["nrows"]] <- .as_int(
pmin(.nrows(image_size),
.row(chunks) + .nrows(block) + overlap - 1) - .row(chunks) + 1
)
# Chunk of entire image
entire_image <- c(image_size, image_bbox)
# Prepare a raster as template to crop bbox
t_obj <- .chunks_as_raster(chunk = entire_image, nlayers = 1)
# Generate chunks' bbox
chunks <- slider::slide_dfr(chunks, function(chunk) {
# Crop block from template
r_obj <- .raster_crop_metadata(r_obj = t_obj, block = .block(chunk))
# Add bbox information
.xmin(chunk) <- .raster_xmin(r_obj = r_obj)
.xmax(chunk) <- .raster_xmax(r_obj = r_obj)
.ymin(chunk) <- .raster_ymin(r_obj = r_obj)
.ymax(chunk) <- .raster_ymax(r_obj = r_obj)
.crs(chunk) <- .raster_crs(r_obj = r_obj)
chunk
})
# Overlapping support
chunks[["overlap"]] <- .as_int(overlap)
# Chunk size without overlap
chunks[["crop_ncols"]] <- .as_int(pmin(
.ncols(image_size) - .col(chunks) + 1, .ncols(block)
))
chunks[["crop_nrows"]] <- .as_int(pmin(
.nrows(image_size) - .row(chunks) + 1, .nrows(block)
))
# Return chunks
chunks
}
#' @title Convert chunk into raster
#' @noRd
#' @param chunk A tibble with chunks
#' @param nlayers Number of layers in the raster
#' @return An empty raster object based on the on a chunk.
.chunks_as_raster <- function(chunk, nlayers) {
.raster_new_rast(
nrows = .nrows(chunk)[[1]],
ncols = .ncols(chunk)[[1]],
xmin = .xmin(chunk)[[1]],
xmax = .xmax(chunk)[[1]],
ymin = .ymin(chunk)[[1]],
ymax = .ymax(chunk)[[1]],
nlayers = nlayers,
crs = .crs(chunk)[[1]]
)
}
#' @title Remove overlaps from chunks
#' @noRd
#' @param chunk A tibble with chunks
#' @returns A tibble with chunks without overlap.
.chunks_no_overlap <- function(chunks) {
# Generate blocks
cropped <- tibble::tibble(
col = .as_int(pmin(chunks[["overlap"]] + 1, .col(chunks))),
row = .as_int(pmin(chunks[["overlap"]] + 1, .row(chunks)))
)
# Adjust blocks size
.ncols(cropped) <- pmin(
.ncols(chunks) - .col(cropped) + 1, .as_int(chunks[["crop_ncols"]])
)
.nrows(cropped) <- pmin(
.nrows(chunks) - .row(cropped) + 1, .as_int(chunks[["crop_nrows"]])
)
# Generate bbox for each chunk
cropped <- slider::slide2_dfr(chunks, cropped, function(chunk, crop) {
# Prepare a raster as template to crop bbox
t_obj <- .chunks_as_raster(chunk = chunk, nlayers = 1)
# Crop block from template
r_obj <- .raster_crop_metadata(r_obj = t_obj, block = .block(crop))
# Add bbox information
.xmin(crop) <- .raster_xmin(r_obj = r_obj)
.xmax(crop) <- .raster_xmax(r_obj = r_obj)
.ymin(crop) <- .raster_ymin(r_obj = r_obj)
.ymax(crop) <- .raster_ymax(r_obj = r_obj)
.crs(crop) <- .raster_crs(r_obj = r_obj)
crop
})
# Finish cropped chunks
cropped[["overlap"]] <- 0
cropped[["crop_ncols"]] <- chunks[["crop_ncols"]]
cropped[["crop_nrows"]] <- chunks[["crop_nrows"]]
# Return cropped chunks
cropped
}
#' @title Filter chunks that intersects a given roi
#' @noRd
#' @param chunks A data frame with chunks
#' @param roi Region of interest
#' @returns A tibble with filtered chunks
.chunks_filter_spatial <- function(chunks, roi) {
chunks_sf <- .bbox_as_sf(.bbox(chunks, by_feature = TRUE))
chunks[.intersects(chunks_sf, .roi_as_sf(roi)), ]
}
#' @title Filter chunks that intersects segments
#' @noRd
#' @param chunks A data frame with chunks
#' @param tile A cube tile
#' @param output_dir Output directory
#' @returns A tibble with filtered segments
.chunks_filter_segments <- function(chunks, tile, output_dir) {
# Read segments from tile
segments <- .segments_read_vec(tile)
# Transform each chunk in sf object
sf_chunks <- .bbox_as_sf(
.bbox(chunks, by_feature = TRUE, default_crs = .tile_crs(tile))
)
# Find segments in chunks
idx_intersects <- sf::st_intersects(sf_chunks, segments, sparse = TRUE) |>
purrr::imap_dfr(
~dplyr::as_tibble(.x) |> dplyr::mutate(id = .y)
) |>
dplyr::distinct(.data[["value"]], .keep_all = TRUE) |>
dplyr::group_by(.data[["id"]]) |>
tidyr::nest() |>
tibble::deframe()
chunks[["segments"]] <- purrr::map(seq_along(idx_intersects), function(i) {
idx <- unname(as.vector(idx_intersects[[i]]))
idx <- idx[[1]]
block_file <- .file_block_name(
pattern = "chunk_seg",
block = .block(chunks[i, ]),
output_dir = output_dir,
ext = "gpkg"
)
.vector_write_vec(segments[idx, ], block_file)
return(block_file)
})
return(chunks)
}