Skip to content

Commit 30f95e1

Browse files
gilbertocamaragilbertocamara
committed
adjustments for RTC cube
1 parent d7b059e commit 30f95e1

12 files changed

+119
-166
lines changed

‎NAMESPACE

+2-4
Original file line numberDiff line numberDiff line change
@@ -310,10 +310,9 @@ S3method(sits_cluster_dendro,sits)
310310
S3method(sits_combine_predictions,average)
311311
S3method(sits_combine_predictions,default)
312312
S3method(sits_combine_predictions,uncertainty)
313-
S3method(sits_cube,"mpc_cube_sentinel-1-grd")
314-
S3method(sits_cube,"mpc_cube_sentinel-1-rtc")
315313
S3method(sits_cube,default)
316314
S3method(sits_cube,local_cube)
315+
S3method(sits_cube,sar_cube)
317316
S3method(sits_cube,stac_cube)
318317
S3method(sits_get_data,csv)
319318
S3method(sits_get_data,data.frame)
@@ -347,11 +346,10 @@ S3method(sits_reclassify,class_cube)
347346
S3method(sits_reclassify,default)
348347
S3method(sits_reduce,raster_cube)
349348
S3method(sits_reduce,sits)
350-
S3method(sits_regularize,"mpc_cube_sentinel-1-grd")
351-
S3method(sits_regularize,"mpc_cube_sentinel-1-rtc")
352349
S3method(sits_regularize,default)
353350
S3method(sits_regularize,derived_cube)
354351
S3method(sits_regularize,raster_cube)
352+
S3method(sits_regularize,sar_cube)
355353
S3method(sits_select,default)
356354
S3method(sits_select,patterns)
357355
S3method(sits_select,raster_cube)

‎R/api_cube.R

+14-3
Original file line numberDiff line numberDiff line change
@@ -330,13 +330,24 @@ NULL
330330
}
331331
#' @export
332332
.cube_s3class.raster_cube <- function(cube) {
333-
s3_class <- .source_s3class(source = .cube_source(cube = cube))
333+
334+
source <- .cube_source(cube = cube)
335+
collection <- .tile_collection(cube)
336+
s3_class <- .source_s3class(source = source)
334337
col_class <- paste(
335338
s3_class[[1]],
336-
tolower(.tile_collection(cube)),
339+
tolower(collection),
337340
sep = "_"
338341
)
339-
unique(c(col_class, s3_class, class(cube)))
342+
sar_cube <- .try({
343+
.conf("sources", source, "collections", collection, "sar_cube")
344+
},
345+
.default = FALSE
346+
)
347+
if (sar_cube)
348+
unique(c(col_class, "sar_cube", s3_class, class(cube)))
349+
else
350+
unique(c(col_class, s3_class, class(cube)))
340351
}
341352
#' @export
342353
.cube_s3class.default <- function(cube) {

‎R/api_regularize.R

+14-12
Original file line numberDiff line numberDiff line change
@@ -129,23 +129,25 @@
129129
)
130130
}
131131

132-
.reg_s2tile_convert <- function(cube, roi) {
133-
# TODO: check cube
132+
.reg_s2tile_convert <- function(cube, roi = NULL, tiles = NULL) {
134133

135134
# generate Sentinel-2 tiles and intersects it with doi
136-
tiles <- .s2tile_open(roi)
137-
tiles <- tiles[.intersects(tiles, .roi_as_sf(roi)), ]
138-
139-
# prepare a sf object representing the bbox of each image in file_info
140-
fi_bbox <- .bbox_as_sf(.bbox(
141-
x = cube$file_info[[1]],
142-
default_crs = .crs(cube),
143-
by_feature = TRUE
144-
))
135+
tiles_mgrs <- .s2tile_open(roi, tiles)
145136

146137
# create a new cube according to Sentinel-2 MGRS
147138
cube_class <- .cube_s3class(cube)
148-
cube <- tiles |>
139+
140+
# prepare a sf object representing the bbox of each image in file_info
141+
cube_mgrs <- slider::slide_dfr(tiles_mgrs, function(tile){
142+
cube_tile <- dplyr::filter(cube, .data[["crs"]] == tile$crs)
143+
fi_bbox <- .bbox_as_sf(.bbox(
144+
x = cube_tile$file_info[[1]],
145+
default_crs = .crs(tile),
146+
by_feature = TRUE
147+
))
148+
})
149+
150+
cube <- tiles_mgrs |>
149151
dplyr::rowwise() |>
150152
dplyr::group_map(~{
151153
file_info <- .fi(cube)[.intersects({{fi_bbox}}, .x), ]

‎R/api_s2tile.R

+33-21
Original file line numberDiff line numberDiff line change
@@ -3,35 +3,43 @@
33
#' @keywords internal
44
#' @noRd
55
#' @return a simple feature containing all Sentinel-2 tiles
6-
.s2tile_open <- function(roi) {
6+
.s2tile_open <- function(roi, tiles) {
7+
# check
8+
.check_roi_tiles(roi, tiles)
9+
# if tiles, convert to roi
10+
711
# define dummy local variables to stop warnings
812
epsg <- xmin <- ymin <- xmax <- ymax <- NULL
913

1014
# open ext_data tiles.rds file
1115
s2_file <- system.file("extdata/s2-tiles/tiles.rds", package = "sits")
1216
s2_tb <- readRDS(s2_file)
1317

14-
# create a sf of points
15-
epsg_lst <- unique(s2_tb$epsg)
16-
points_sf <- sf::st_cast(purrr::map_dfr(epsg_lst, function(epsg) {
17-
tiles <- dplyr::filter(s2_tb, epsg == {{epsg}})
18-
sfc <- matrix(c(tiles$xmin, tiles$ymin), ncol = 2) |>
19-
sf::st_multipoint(dim = "XY") |>
20-
sf::st_sfc(crs = epsg) |>
21-
sf::st_transform(crs = "EPSG:4326")
22-
sf::st_sf(geom = sfc)
23-
}), "POINT")
24-
25-
# change roi to 1.5 degree to west and south
26-
roi <- .bbox_as_sf(
27-
dplyr::mutate(
28-
.bbox(.roi_as_sf(roi, as_crs = "EPSG:4326")),
29-
xmin = xmin - 1.5,
30-
ymin = ymin - 1.5
31-
))
18+
if (is.character(tiles)) {
19+
s2_tb <- dplyr::filter(s2_tb, .data[["tile_id"]] %in% tiles)
20+
}
21+
else {
22+
# create a sf of points
23+
epsg_lst <- unique(s2_tb$epsg)
24+
points_sf <- sf::st_cast(purrr::map_dfr(epsg_lst, function(epsg) {
25+
tiles <- dplyr::filter(s2_tb, epsg == {{epsg}})
26+
sfc <- matrix(c(tiles$xmin, tiles$ymin), ncol = 2) |>
27+
sf::st_multipoint(dim = "XY") |>
28+
sf::st_sfc(crs = epsg) |>
29+
sf::st_transform(crs = "EPSG:4326")
30+
sf::st_sf(geom = sfc)
31+
}), "POINT")
3232

33-
# filter points
34-
s2_tb <- s2_tb[.intersects(points_sf, roi), ]
33+
# change roi to 1.5 degree to west and south
34+
roi_search <- .bbox_as_sf(
35+
dplyr::mutate(
36+
.bbox(.roi_as_sf(roi, as_crs = "EPSG:4326")),
37+
xmin = xmin - 1.5,
38+
ymin = ymin - 1.5
39+
))
40+
# filter points
41+
s2_tb <- s2_tb[.intersects(points_sf, roi_search), ]
42+
}
3543

3644
# creates a list of simple features
3745
epsg_lst <- unique(s2_tb$epsg)
@@ -65,6 +73,10 @@
6573
)
6674
})
6775

76+
# if roi is given, filter tiles by desired roi
77+
if (.has(roi))
78+
s2_tiles <- s2_tiles[.intersects(s2_tiles, .roi_as_sf(roi)), ]
79+
6880
return(s2_tiles)
6981
}
7082
#' @title Convert MGRS tile information to ROI in WGS84

‎R/api_source.R

+12-2
Original file line numberDiff line numberDiff line change
@@ -69,8 +69,18 @@ NULL
6969
class(source) <- unique(c(classes, class(source)))
7070

7171
if (!is.null(collection)) {
72-
classes <- paste(classes[[1]], tolower(collection), sep = "_")
73-
class(source) <- unique(c(classes, class(source)))
72+
# is this a collection of SAR data?
73+
sar_cube <- .try({
74+
.conf("sources", source, "collections", collection, "sar_cube")
75+
},
76+
.default = FALSE
77+
)
78+
# if this is a SAR collection, add "sar_cube" to the class
79+
if (sar_cube)
80+
class(source) <- c("sar_cube", class(source))
81+
# add a class combining source and collection
82+
class_source_col <- paste(classes[[1]], tolower(collection), sep = "_")
83+
class(source) <- unique(c(class_source_col, class(source)))
7484
}
7585
return(source)
7686
}

‎R/sits_cube.R

+10-37
Original file line numberDiff line numberDiff line change
@@ -286,16 +286,16 @@ sits_cube <- function(source, collection, ...) {
286286
#' @rdname sits_cube
287287
#'
288288
#' @export
289-
`sits_cube.mpc_cube_sentinel-1-grd` <- function(source,
290-
collection, ...,
291-
orbit = "ascending",
292-
bands = NULL,
293-
tiles = NULL,
294-
roi = NULL,
295-
start_date = NULL,
296-
end_date = NULL,
297-
platform = NULL,
298-
progress = TRUE) {
289+
sits_cube.sar_cube <- function(source,
290+
collection, ...,
291+
orbit = "ascending",
292+
bands = NULL,
293+
tiles = NULL,
294+
roi = NULL,
295+
start_date = NULL,
296+
end_date = NULL,
297+
platform = NULL,
298+
progress = TRUE) {
299299

300300
sits_cube.stac_cube(
301301
source = source,
@@ -310,33 +310,6 @@ sits_cube <- function(source, collection, ...) {
310310
orbit = orbit
311311
)
312312
}
313-
#' @rdname sits_cube
314-
#'
315-
#' @export
316-
`sits_cube.mpc_cube_sentinel-1-rtc` <- function(source,
317-
collection, ...,
318-
orbit = "ascending",
319-
bands = NULL,
320-
tiles = NULL,
321-
roi = NULL,
322-
start_date = NULL,
323-
end_date = NULL,
324-
platform = NULL,
325-
progress = TRUE) {
326-
`sits_cube.mpc_cube_sentinel-1-grd`(
327-
source = source,
328-
collection = collection,
329-
bands = bands,
330-
tiles = tiles,
331-
roi = roi,
332-
start_date = start_date,
333-
end_date = end_date,
334-
platform = platform,
335-
progress = progress,
336-
orbit = orbit
337-
)
338-
}
339-
340313
#' @rdname sits_cube
341314
#'
342315
#' @export

‎R/sits_plot.R

+8-1
Original file line numberDiff line numberDiff line change
@@ -373,8 +373,15 @@ plot.raster_cube <- function(x, ...,
373373
bw <- FALSE
374374
else
375375
bw <- TRUE
376-
if (bw)
376+
if (bw) {
377377
band = .default(band, .cube_bands(x, add_cloud = FALSE)[1])
378+
if ("sar_cube" %in% class(x)) {
379+
palette <- "Greys"
380+
style <- "order"
381+
n_colors <- 10
382+
}
383+
}
384+
378385
# only one tile at a time
379386
.check_chr_parameter(tile)
380387
# is tile inside the cube?

‎R/sits_regularize.R

+9-34
Original file line numberDiff line numberDiff line change
@@ -171,14 +171,14 @@ sits_regularize.raster_cube <- function(cube, ...,
171171
}
172172
#' @rdname sits_regularize
173173
#' @export
174-
`sits_regularize.mpc_cube_sentinel-1-grd` <- function(cube, ...,
175-
period,
176-
res,
177-
output_dir,
178-
roi = NULL,
179-
tiles = NULL,
180-
multicores = 2L,
181-
progress = TRUE) {
174+
sits_regularize.sar_cube <- function(cube, ...,
175+
period,
176+
res,
177+
output_dir,
178+
roi = NULL,
179+
tiles = NULL,
180+
multicores = 2L,
181+
progress = TRUE) {
182182
# Preconditions
183183
.check_raster_cube_files(cube)
184184
.period_check(period)
@@ -189,10 +189,6 @@ sits_regularize.raster_cube <- function(cube, ...,
189189
.check_progress(progress)
190190
# Check for ROI and tiles
191191
.check_roi_tiles(roi, tiles)
192-
if (is.character(tiles)) {
193-
roi <- .s2_mgrs_to_roi(tiles)
194-
}
195-
roi <- .roi_as_sf(roi)
196192
# Display warning message in case STAC cube
197193
if (!.cube_is_local(cube)) {
198194
if (.check_warnings()) {
@@ -207,7 +203,7 @@ sits_regularize.raster_cube <- function(cube, ...,
207203
.parallel_start(workers = multicores)
208204
on.exit(.parallel_stop(), add = TRUE)
209205
# Convert input sentinel1 cube to sentinel2 grid
210-
cube <- .reg_s2tile_convert(cube = cube, roi = roi)
206+
cube <- .reg_s2tile_convert(cube = cube, roi = roi, tiles = tiles)
211207
.check_that(
212208
nrow(cube) > 0,
213209
msg = "Spatial region does not intersect cube"
@@ -229,27 +225,6 @@ sits_regularize.raster_cube <- function(cube, ...,
229225
}
230226
#' @rdname sits_regularize
231227
#' @export
232-
`sits_regularize.mpc_cube_sentinel-1-rtc` <- function(cube, ...,
233-
period,
234-
res,
235-
output_dir,
236-
roi = NULL,
237-
tiles = NULL,
238-
multicores = 2L,
239-
progress = TRUE) {
240-
`sits_regularize.mpc_cube_sentinel-1-grd`(
241-
cube = cube,
242-
period = period,
243-
res = res,
244-
output_dir = output_dir,
245-
roi = roi,
246-
tiles = tiles,
247-
multicores = multicores,
248-
progress = progress, ...
249-
)
250-
}
251-
#' @rdname sits_regularize
252-
#' @export
253228
sits_regularize.derived_cube <- function(cube, ...) {
254229
stop("sits_regularize only works with non-processed cubes")
255230
}

‎inst/extdata/config.yml

+2
Original file line numberDiff line numberDiff line change
@@ -1255,6 +1255,7 @@ sources:
12551255
SENTINEL-1A: "Sentinel-1A"
12561256
SENTINEL-1B: "Sentinel-1B"
12571257
collection_name: "sentinel-1-grd"
1258+
sar_cube: true
12581259
open_data: true
12591260
open_data_token: false
12601261
metadata_search: "feature"
@@ -1281,6 +1282,7 @@ sources:
12811282
SENTINEL-1A: "Sentinel-1A"
12821283
SENTINEL-1B: "Sentinel-1B"
12831284
collection_name: "sentinel-1-rtc"
1285+
sar_cube: true
12841286
open_data: false
12851287
open_data_token: false
12861288
metadata_search: "feature"

‎man/sits_cube.Rd

+2-17
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)