-
Notifications
You must be signed in to change notification settings - Fork 76
/
api_label_class.R
177 lines (175 loc) · 5.93 KB
/
api_label_class.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
#' @title Build a classified map from a tile
#' @noRd
#' @param tile Tile of data cube
#' @param band Spectral band
#' @param label_fn Function to be used for labelling
#' @param output_dir Directory where file will be saved
#' @param version Version name
#' @param progress Show progress bar?
#' @returns File path for derived file
.label_tile <- function(tile, band, label_fn, output_dir, version, progress) {
# Output file
out_file <- .file_derived_name(
tile = tile, band = band, version = version, output_dir = output_dir
)
# Resume feature
if (file.exists(out_file)) {
.check_recovery(tile[["tile"]])
class_tile <- .tile_derived_from_file(
file = out_file,
band = "class",
base_tile = tile,
derived_class = "class_cube",
labels = .tile_labels(tile),
update_bbox = FALSE
)
return(class_tile)
}
# Create chunks as jobs
chunks <- .tile_chunks_create(tile = tile, overlap = 0)
# Process jobs in parallel
block_files <- .jobs_map_parallel_chr(chunks, function(chunk) {
# Get job block
block <- .block(chunk)
# Output file name
block_file <- .file_block_name(
pattern = .file_pattern(out_file),
block = block,
output_dir = output_dir
)
# Resume processing in case of failure
if (.raster_is_valid(block_file)) {
return(block_file)
}
# Read and preprocess values
values <- .tile_read_block(
tile = tile, band = .tile_bands(tile), block = block
)
# Apply the labeling function to values
values <- label_fn(values)
# Prepare probability to be saved
band_conf <- .conf_derived_band(
derived_class = "class_cube", band = band
)
offset <- .offset(band_conf)
if (.has(offset) && offset != 0) {
values <- values - offset
}
scale <- .scale(band_conf)
if (.has(scale) && scale != 1) {
values <- values / scale
}
# Prepare and save results as raster
.raster_write_block(
files = block_file, block = block, bbox = .bbox(chunk),
values = values, data_type = .data_type(band_conf),
missing_value = .miss_value(band_conf),
crop_block = NULL
)
# Free memory
gc()
# Returned value
block_file
}, progress = progress)
# Merge blocks into a new class_cube tile
class_tile <- .tile_derived_merge_blocks(
file = out_file,
band = band,
labels = .tile_labels(tile),
base_tile = tile,
block_files = block_files,
derived_class = "class_cube",
multicores = .jobs_multicores(),
update_bbox = FALSE
)
# Return class tile
class_tile
}
#' @title Build a classified vector segments from a tile
#' @noRd
#' @param tile Tile of data cube
#' @param band Spectral band
#' @param output_dir Directory where file will be saved
#' @param version Version name
#' @return Classified vector tile
.label_vector_tile <- function(tile, band, version, output_dir) {
# Output file
out_file <- .file_derived_name(
tile = tile, band = "class", version = version,
output_dir = output_dir, ext = "gpkg"
)
# Resume feature
if (.segments_is_valid(out_file)) {
.check_recovery(out_file)
# Create tile based on template
class_tile <- .tile_segments_from_file(
file = out_file,
band = "class",
base_tile = tile,
labels = .tile_labels(tile),
vector_class = "class_vector_cube",
update_bbox = FALSE
)
# Return classified vector tile
return(class_tile)
}
# Get tile labels
tile_labels <- unname(.tile_labels(tile))
# Read probability segments
probs_segments <- .segments_read_vec(tile)
# Segment labels
segment_labels <- setdiff(
colnames(probs_segments), c("supercells", "x", "y", "pol_id", "geom")
)
# Necessary when not all labels are present on the tile
labels <- intersect(tile_labels, segment_labels)
# Classify each segment by majority probability
probs_segments <- probs_segments |>
dplyr::rowwise() |>
dplyr::filter(!anyNA(dplyr::c_across(dplyr::all_of(labels)))) |>
dplyr::mutate(class = labels[which.max(
dplyr::c_across(dplyr::all_of(labels)))]) |>
dplyr::mutate(pol_id = as.numeric(.data[["pol_id"]]))
# Write all segments
.vector_write_vec(v_obj = probs_segments, file_path = out_file)
# Create tile based on template
class_tile <- .tile_segments_from_file(
file = out_file,
band = "class",
base_tile = tile,
labels = .tile_labels(tile),
vector_class = "class_vector_cube",
update_bbox = FALSE
)
# Return classified vector tile
return(class_tile)
}
#' @name .label_fn_majority
#' @description Build a classified map from probs cube
#' based on maximal probability
#' @noRd
#' @returns Function to be used to labelling
.label_fn_majority <- function() {
label_fn <- function(values) {
# Used to check values (below)
input_pixels <- nrow(values)
values <- C_label_max_prob(values)
# Are the results consistent with the data input?
.check_processed_values(values, input_pixels)
# Return values
values
}
# Return closure
label_fn
}
#' @name .label_gpkg_file
#' @description Extract the labels required by sits from GPKG file
#' @param gpkg_file File in GPKG format
#' @noRd
#' @returns labels required by sits
.label_gpkg_file <- function(gpkg_file) {
sf <- sf::st_read(gpkg_file, quiet = TRUE)
labels <- setdiff(colnames(sf), c("supercells", "x", "y",
"pol_id", "geom", "class"))
return(labels)
}