-
Notifications
You must be signed in to change notification settings - Fork 76
/
api_raster_sub_image.R
129 lines (117 loc) · 3.86 KB
/
api_raster_sub_image.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
#' @title Find the dimensions and location of a spatial ROI in a data cube
#' @name .raster_sub_image
#' @keywords internal
#' @noRd
#' @param tile tile of data cube.
#' @param sf_roi sf object with spatial region of interest
#' @return vector with information on the subimage
#'
.raster_sub_image <- function(tile, sf_roi) {
.check_set_caller(".raster_sub_image")
# pre-condition
.check_int_parameter(nrow(tile), min = 1, max = 1)
# calculate the intersection between the bbox of the ROI and the cube
# transform the tile bbox to sf
sf_tile <- .bbox_as_sf(.tile_bbox(tile))
if (sf::st_crs(sf_tile) != sf::st_crs(sf_roi)) {
sf_roi <- sf::st_transform(sf_roi, crs = .tile_crs(tile))
}
geom <- sf::st_intersection(sf_tile, sf_roi)
# get bbox of subimage
sub_image_bbox <- .bbox(geom)
# return the sub_image
sub_image <- .raster_sub_image_from_bbox(sub_image_bbox, tile)
return(sub_image)
}
#' @title Extract a sub_image from a bounding box and a cube
#' @name .raster_sub_image_from_bbox
#' @keywords internal
#' @noRd
#' @author Gilberto Camara, \email{gilberto.camara@@inpe.br}
#'
#' @param bbox bounding box for a region of interest
#' @param tile tile of data cube
#' @return sub_image with additional info on first row,
#' first col, nrows, ncols
#'
.raster_sub_image_from_bbox <- function(bbox, tile) {
.check_set_caller(".raster_sub_image_from_bbox")
# pre-condition
n_tiles <- nrow(tile)
.check_int_parameter(n_tiles, min = 1, max = 1)
# tolerance added to handle edge cases
tolerance <- 0.0001
# pre-conditions
.check_that(
bbox[["xmin"]] < bbox[["xmax"]] &&
bbox[["ymin"]] < bbox[["ymax"]] + tolerance &&
bbox[["xmin"]] >= tile[["xmin"]] - tolerance &&
bbox[["xmax"]] <= tile[["xmax"]] + tolerance &&
bbox[["ymin"]] >= tile[["ymin"]] - tolerance &&
bbox[["ymax"]] <= tile[["ymax"]] + tolerance
)
# tile template
r_obj <- .raster_new_rast(
nrows = .tile_nrows(tile),
ncols = .tile_ncols(tile),
xmin = tile[["xmin"]],
xmax = tile[["xmax"]],
ymin = tile[["ymin"]],
ymax = tile[["ymax"]],
nlayers = 1,
crs = tile[["crs"]]
)
# compute block
r_crop <- .raster_crop_metadata(r_obj, bbox = bbox)
row <- .raster_row(r_obj,
y = .raster_ymax(r_crop) - 0.5 * .raster_yres(r_crop)
)
col <- .raster_col(r_obj,
x = .raster_xmin(r_crop) + 0.5 * .raster_xres(r_crop)
)
# set initial values
si <- list(
row = row,
col = col,
nrows = .raster_nrows(r_crop),
ncols = .raster_ncols(r_crop),
xmin = .raster_xmin(r_crop),
xmax = .raster_xmax(r_crop),
ymin = .raster_ymin(r_crop),
ymax = .raster_ymax(r_crop),
crs = tile[["crs"]]
)
tolerance <- .conf(
"sources", .cube_source(tile),
"collections", .cube_collection(tile),
"ext_tolerance"
)
# pre-conditions
.check_that(si[["xmin"]] < si[["xmax"]])
.check_that(si[["ymin"]] < si[["ymax"]])
subimage_xmin <- si[["xmin"]]
.check_num_parameter(subimage_xmin,
min = tile[["xmin"]],
max = tile[["xmax"]],
tolerance = tolerance
)
subimage_max <- si[["xmax"]]
.check_num_parameter(subimage_max,
min = tile[["xmin"]],
max = tile[["xmax"]],
tolerance = tolerance
)
subimage_ymin <- si[["ymin"]]
.check_num_parameter(subimage_ymin,
min = tile[["ymin"]],
max = tile[["ymax"]],
tolerance = tolerance
)
subimage_ymax <- si[["ymax"]]
.check_num(subimage_ymax,
min = tile[["ymin"]],
max = tile[["ymax"]],
tolerance = tolerance
)
return(si)
}