Skip to content

Commit 8d99772

Browse files
M3nin0M3nin0
committed
Merge branch 'sits-dev' of https://github.com/M3nin0/sits into sits-dev
2 parents 4f47c8e + ec7b5c4 commit 8d99772

12 files changed

+122
-49
lines changed

‎R/api_check.R

+2-1
Original file line numberDiff line numberDiff line change
@@ -2358,7 +2358,8 @@
23582358
.check_require_packages("cols4all")
23592359
# set caller to show in errors
23602360
.check_set_caller(".check_palette")
2361-
c4a_palette <- cols4all::c4a_info(palette, no.match = "null")
2361+
c4a_palette <- suppressWarnings(cols4all::c4a_info(palette,
2362+
no.match = "null"))
23622363
.check_that(.has(c4a_palette))
23632364
return(invisible(palette))
23642365
}

‎R/api_classify.R

+2-5
Original file line numberDiff line numberDiff line change
@@ -106,8 +106,6 @@
106106
# Should bbox of resulting tile be updated?
107107
update_bbox <- nrow(chunks) != nchunks
108108
}
109-
# Compute fractions probability
110-
probs_fractions <- 1 / length(.ml_labels(ml_model))
111109
# Process jobs in parallel
112110
block_files <- .jobs_map_parallel_chr(chunks, function(chunk) {
113111
# Job block
@@ -171,10 +169,9 @@
171169
scale <- .scale(band_conf)
172170
if (.has(scale) && scale != 1) {
173171
values <- values / scale
174-
probs_fractions <- probs_fractions / scale
175172
}
176-
# Mask NA pixels with same probabilities for all classes
177-
values[na_mask, ] <- probs_fractions
173+
# Put NA back in the result
174+
values[na_mask, ] <- NA
178175
# Log
179176
.debug_log(
180177
event = "start_block_data_save",

‎R/api_plot_raster.R

+5-5
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@
4242
.tile_filter_bands(bands = band) |>
4343
.tile_filter_dates(dates = date) |>
4444
.crop(roi = roi,
45-
output_dir = tempdir(),
45+
output_dir = .rand_sub_tempdir(),
4646
progress = FALSE)
4747
}
4848

@@ -131,7 +131,7 @@
131131
.tile_filter_bands(bands = band) |>
132132
.tile_filter_dates(dates = dates) |>
133133
.crop(roi = roi,
134-
output_dir = tempdir(),
134+
output_dir = .rand_sub_tempdir(),
135135
progress = FALSE)
136136
}
137137
# select the files to be plotted
@@ -200,7 +200,7 @@
200200
.tile_filter_bands(bands = c(red, green, blue)) |>
201201
.tile_filter_dates(dates = date) |>
202202
.crop(roi = roi,
203-
output_dir = tempdir(),
203+
output_dir = .rand_sub_tempdir(),
204204
progress = FALSE)
205205
}
206206

@@ -330,7 +330,7 @@
330330
if (.has(roi)) {
331331
tile <- tile |>
332332
.crop(roi = roi,
333-
output_dir = tempdir(),
333+
output_dir = .rand_sub_tempdir(),
334334
progress = FALSE)
335335
}
336336
# size of data to be read
@@ -412,7 +412,7 @@
412412
if (.has(roi)) {
413413
tile <- tile |>
414414
.crop(roi = roi,
415-
output_dir = tempdir(),
415+
output_dir = .rand_sub_tempdir(),
416416
progress = FALSE)
417417
}
418418
# size of data to be read

‎R/api_tmap_v4.R

+15-5
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,9 @@
1010
tmap_params){
1111

1212
# recover palette name used by cols4all
13-
cols4all_name <- cols4all::c4a_info(palette)$fullname
13+
cols4all_name <- suppressWarnings(
14+
cols4all::c4a_info(palette)$fullname
15+
)
1416
# reverse order of colors?
1517
if (rev)
1618
cols4all_name <- paste0("-", cols4all_name)
@@ -55,7 +57,9 @@
5557
.tmap_dem_map.tmap_v4 <- function(r, band,
5658
palette, rev,
5759
scale, tmap_params){
58-
cols4all_name <- cols4all::c4a_info(palette)$fullname
60+
cols4all_name <- suppressWarnings(
61+
cols4all::c4a_info(palette)$fullname
62+
)
5963
# reverse order of colors?
6064
if (rev)
6165
cols4all_name <- paste0("-", cols4all_name)
@@ -136,7 +140,9 @@
136140
tmap_params){
137141

138142
# recover palette name used by cols4all
139-
cols4all_name <- cols4all::c4a_info(palette)$fullname
143+
cols4all_name <- suppressWarnings(
144+
cols4all::c4a_info(palette)$fullname
145+
)
140146
# reverse order of colors?
141147
if (rev)
142148
cols4all_name <- paste0("-", cols4all_name)
@@ -184,7 +190,9 @@
184190
labels, labels_plot,
185191
scale, tmap_params){
186192

187-
cols4all_name <- cols4all::c4a_info(palette)$fullname
193+
cols4all_name <- suppressWarnings(
194+
cols4all::c4a_info(palette)$fullname
195+
)
188196
# reverse order of colors?
189197
if (rev)
190198
cols4all_name <- paste0("-", cols4all_name)
@@ -303,7 +311,9 @@
303311
.tmap_vector_uncert.tmap_v4 <- function(sf_seg, palette, rev,
304312
type, scale, tmap_params){
305313
# recover palette name used by cols4all
306-
cols4all_name <- cols4all::c4a_info(palette)$fullname
314+
cols4all_name <- suppressWarnings(
315+
cols4all::c4a_info(palette)$fullname
316+
)
307317
# reverse order of colors?
308318
if (rev)
309319
cols4all_name <- paste0("-", cols4all_name)

‎R/api_utils.R

+17
Original file line numberDiff line numberDiff line change
@@ -349,3 +349,20 @@ NULL
349349
.map_dfc <- function(x, fn, ...) {
350350
purrr::list_cbind(lapply(x, fn, ...))
351351
}
352+
#' @title Function that returns a random subdirectory of tempdir()
353+
#' @description Generates a random subdir
354+
#' @noRd
355+
#' @keywords internal
356+
#' @returns Name of a valid subdir of tempdir()
357+
#'
358+
.rand_sub_tempdir <- function() {
359+
new_dir <- FALSE
360+
while (!new_dir) {
361+
new_temp_dir <- paste0(tempdir(), "/", sample(1:10000, size = 1))
362+
if (!dir.exists(new_temp_dir)) {
363+
dir.create(new_temp_dir)
364+
new_dir <- TRUE
365+
}
366+
}
367+
return(new_temp_dir)
368+
}

‎R/sits_active_learning.R

+2
Original file line numberDiff line numberDiff line change
@@ -156,6 +156,8 @@ sits_uncertainty_sampling <- function(uncert_cube,
156156
result_tile[["label"]] <- "NoClass"
157157
return(result_tile)
158158
})
159+
samples_tb <- dplyr::rename(samples_tb, uncertainty = value)
160+
159161
return(samples_tb)
160162
}
161163
#' @title Suggest high confidence samples to increase the training set.

‎R/sits_plot.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -676,7 +676,7 @@ plot.dem_cube <- function(x, ...,
676676
tile <- tile |>
677677
.tile_filter_bands(bands = band) |>
678678
.crop(roi = roi,
679-
output_dir = tempdir(),
679+
output_dir = .rand_sub_tempdir(),
680680
progress = FALSE)
681681
}
682682
# select the file to be plotted

‎R/zzz.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ sits_env[["model_formula"]] <- "log"
2323
utils::globalVariables(c(
2424
".x", ".y", ":=", # dplyr
2525
"self", "ctx", "super", "private", # torch
26-
"uniform", "choice", "randint", "geometry",
26+
"uniform", "choice", "randint", "geometry", "value",
2727
"normal", "lognormal", "loguniform", # sits_tuning_random
2828
"sar:frequency_band", "sar:instrument_mode", "sat:orbit_state" # S1 stac
2929
))

‎tests/testthat/test-active_learning.R

+3-3
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ test_that("Suggested samples have low confidence, high entropy", {
99
)
1010
set.seed(123)
1111
rfor_model <- sits_train(samples_modis_ndvi,
12-
ml_method = sits_xgboost(verbose = FALSE)
12+
ml_method = sits_rfor()
1313
)
1414
output_dir <- paste0(tempdir(), "/al")
1515
if (!dir.exists(output_dir)) {
@@ -41,9 +41,9 @@ test_that("Suggested samples have low confidence, high entropy", {
4141

4242
expect_true(nrow(samples_df) <= 100)
4343
expect_true(all(colnames(samples_df) %in% c(
44-
"longitude", "latitude",
44+
"longitude", "latitude", "uncertainty",
4545
"start_date", "end_date",
46-
"label", "uncertainty"
46+
"label"
4747
)))
4848
expect_true(all(samples_df[["label"]] == "NoClass"))
4949
expect_true(all(samples_df[["uncertainty"]] >= 0.3))

‎tests/testthat/test-classification.R

+74
Original file line numberDiff line numberDiff line change
@@ -56,3 +56,77 @@ test_that("Classify error bands 1", {
5656
)
5757
)
5858
})
59+
60+
test_that("Classify with NA values", {
61+
# load cube
62+
data_dir <- system.file("extdata/raster/mod13q1", package = "sits")
63+
raster_cube <- sits_cube(
64+
source = "BDC",
65+
collection = "MOD13Q1-6.1",
66+
data_dir = data_dir,
67+
tiles = "012010",
68+
bands = "NDVI",
69+
start_date = "2013-09-14",
70+
end_date = "2014-08-29",
71+
multicores = 2,
72+
progress = FALSE
73+
)
74+
# preparation - create directory to save NA
75+
data_dir <- paste0(tempdir(), "/na-cube")
76+
dir.create(data_dir, recursive = TRUE, showWarnings = FALSE)
77+
# preparation - insert NA in cube
78+
raster_cube <- sits_apply(
79+
data = raster_cube,
80+
NDVI_NA = ifelse(NDVI > 0.5, NA, NDVI),
81+
output_dir = data_dir
82+
)
83+
raster_cube <- sits_select(raster_cube, bands = "NDVI_NA")
84+
.fi(raster_cube) <- .fi(raster_cube) |>
85+
dplyr::mutate(band = "NDVI")
86+
# preparation - create a random forest model
87+
rfor_model <- sits_train(samples_modis_ndvi, sits_rfor(num_trees = 40))
88+
# test classification with NA
89+
class_map <- sits_classify(
90+
data = raster_cube,
91+
ml_model = rfor_model,
92+
output_dir = tempdir(),
93+
progress = FALSE
94+
)
95+
class_map_rst <- terra::rast(class_map[["file_info"]][[1]][["path"]])
96+
expect_true(anyNA(class_map_rst[]))
97+
})
98+
99+
test_that("Classify with exclusion mask", {
100+
# load cube
101+
data_dir <- system.file("extdata/raster/mod13q1", package = "sits")
102+
raster_cube <- sits_cube(
103+
source = "BDC",
104+
collection = "MOD13Q1-6.1",
105+
data_dir = data_dir,
106+
tiles = "012010",
107+
bands = "NDVI",
108+
start_date = "2013-09-14",
109+
end_date = "2014-08-29",
110+
multicores = 2,
111+
progress = FALSE
112+
)
113+
# preparation - create a random forest model
114+
rfor_model <- sits_train(samples_modis_ndvi, sits_rfor(num_trees = 40))
115+
# test classification with NA
116+
class_map <- suppressWarnings(
117+
sits_classify(
118+
data = raster_cube,
119+
ml_model = rfor_model,
120+
output_dir = tempdir(),
121+
exclusion_mask = c(
122+
xmin = -55.63478,
123+
ymin = -11.63328,
124+
xmax = -55.54080,
125+
ymax = -11.56978
126+
),
127+
progress = FALSE
128+
)
129+
)
130+
class_map_rst <- terra::rast(class_map[["file_info"]][[1]][["path"]])
131+
expect_true(anyNA(class_map_rst[]))
132+
})

‎tests/testthat/test-clustering.R

-1
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,6 @@ test_that("Creating a dendrogram and clustering the results", {
1616
)
1717
})
1818
# test message
19-
expect_true(grepl("desired", messages[3]))
2019
dendro <- .cluster_dendrogram(cerrado_2classes,
2120
bands = c("NDVI", "EVI")
2221
)

‎tests/testthat/test-color.R

-27
Original file line numberDiff line numberDiff line change
@@ -43,33 +43,6 @@ test_that("color errors", {
4343
expect_equal(colors[16,1]$name, "Water_Bodies")
4444
})
4545

46-
test_that("plot colors", {
47-
data_dir <- system.file("extdata/raster/classif", package = "sits")
48-
ro_class <- sits_cube(
49-
source = "MPC",
50-
collection = "SENTINEL-2-L2A",
51-
data_dir = data_dir,
52-
parse_info = c(
53-
"X1", "X2", "tile", "start_date", "end_date",
54-
"band", "version"
55-
),
56-
bands = "class",
57-
labels = c(
58-
"1" = "Clear_Cut_Burned_Area", "2" = "Clear_Cut_Bare_Soil",
59-
"3" = "Clear_Cut_Vegetation", "4" = "Forest"
60-
),
61-
progress = FALSE
62-
)
63-
p <- plot(ro_class)
64-
expect_equal(p$tm_shape$line.center, "midpoint")
65-
expect_equal(p$tm_layout$legend.bg.color, "white")
66-
expect_equal(
67-
unname(p$tm_raster$labels),
68-
c("Clear_Cut_Burned_Area", "Clear_Cut_Bare_Soil",
69-
"Clear_Cut_Vegetation", "Forest")
70-
)
71-
})
72-
7346
test_that("colors_get", {
7447
labels <- c("Forest", "Cropland", "Pasture")
7548
colors <- suppressWarnings(sits:::.colors_get(labels,

0 commit comments

Comments
 (0)