test_that("One-year, multicore classification with ROI", {
rfor_model <- sits_train(samples_modis_ndvi, sits_rfor(num_trees = 30))
data_dir <- system.file("extdata/raster/mod13q1", package = "sits")
sinop <- sits_cube(
source = "BDC",
collection = "MOD13Q1-6.1",
data_dir = data_dir,
progress = FALSE
)
bbox <- .bbox(sinop)
bbox[["xmax"]] <- (bbox[["xmax"]] - bbox[["xmin"]]) / 2 + bbox[["xmin"]]
bbox[["ymax"]] <- (bbox[["ymax"]] - bbox[["ymin"]]) / 2 + bbox[["ymin"]]
expect_error(.bbox_type(sinop$crs))
expect_warning(.bbox_from_tbl(samples_modis_ndvi))
bbox_samples <- sits_bbox(samples_modis_ndvi)
sinop_probs <- .try(
{
sits_classify(
data = sinop,
ml_model = rfor_model,
output_dir = tempdir(),
roi = bbox,
memsize = 4,
multicores = 2,
progress = FALSE
)
},
.default = NULL
)
if (purrr::is_null(sinop_probs)) {
skip("Unable to allocated multicores")
}
expect_true(all(file.exists(unlist(sinop_probs$file_info[[1]]$path))))
rc_obj <- .raster_open_rast(sinop_probs$file_info[[1]]$path[[1]])
bbox_p <- sits_bbox(sinop_probs)
expect_lte(bbox[["xmax"]], bbox_p[["xmax"]])
expect_lte(bbox[["xmin"]], bbox_p[["xmin"]])
expect_lte(bbox[["ymax"]], bbox_p[["ymax"]])
expect_lte(bbox[["ymin"]], bbox_p[["ymin"]])
max_lyr2 <- max(.raster_get_values(rc_obj)[, 2])
expect_true(max_lyr2 <= 10000)
max_lyr3 <- max(.raster_get_values(rc_obj)[, 3])
expect_true(max_lyr3 > 7000)
expect_true(all(file.remove(unlist(sinop_probs$file_info[[1]]$path))))
})
test_that("Bbox in WGS 84", {
data_dir <- system.file("extdata/raster/mod13q1", package = "sits")
sinop <- sits_cube(
source = "BDC",
collection = "MOD13Q1-6.1",
data_dir = data_dir,
progress = FALSE
)
bbox <- sits_bbox(sinop, as_crs = "EPSG:4326")
expect_true(all(names(bbox) %in% c("xmin", "ymin", "xmax", "ymax", "crs")))
})
test_that("bbox as sf", {
# create a raster cube
s2_cube_s2a <- .try(
{
sits_cube(
source = "MPC",
collection = "SENTINEL-2-L2A",
tiles = c("20LKP", "21LTF"),
bands = c("B05"),
start_date = as.Date("2018-07-18"),
end_date = as.Date("2018-08-23"),
progress = FALSE
)
},
.default = NULL
)
testthat::skip_if(purrr::is_null(s2_cube_s2a),
message = "MPC is not accessible"
)
expect_warning(sits_bbox(s2_cube_s2a))
})
test_that("Functions that work with ROI", {
data_dir <- system.file("extdata/raster/mod13q1", package = "sits")
cube <- sits_cube(
source = "BDC",
collection = "MOD13Q1-6.1",
data_dir = data_dir,
progress = FALSE
)
# create a roi
roi <- sits_bbox(cube)
roi[["xmax"]] <- (roi[["xmax"]] - roi[["xmin"]]) / 2 + roi[["xmin"]]
roi[["ymax"]] <- (roi[["ymax"]] - roi[["ymin"]]) / 2 + roi[["ymin"]]
# retrieve the bounding box for this ROI
bbox_1 <- .bbox(roi, as_crs = .cube_crs(cube))
expect_true(.is_bbox(.bbox_intersection(bbox_1, .cube_bbox(cube))))
# read a set of lat long coordinates
csv_file <- system.file("extdata/samples/samples_sinop_crop.csv",
package = "sits"
)
sf_obj <- csv_file |>
read.csv(stringsAsFactors = FALSE) |>
tibble::as_tibble() |>
dplyr::select(longitude, latitude) |>
sf::st_as_sf(coords = c("longitude", "latitude"), crs = 4326)
# read a bbox as an sf object
bbox_2 <- .bbox(sf_obj, as_crs = .cube_crs(cube))
expect_true(.is_bbox(.bbox_intersection(bbox_2, .cube_bbox(cube))))
# extract the bounding box from a set of lat/long points
sf_bbox <- sf::st_bbox(sf_obj)
names(sf_bbox) <- c("lon_min", "lat_min", "lon_max", "lat_max")
class(sf_bbox) <- c("numeric")
bbox_3 <- .bbox(.roi_as_sf(sf_bbox, as_crs = .cube_crs(cube)))
expect_true(.is_bbox(.bbox_intersection(bbox_3, .cube_bbox(cube))))
})
test_that("Internal functions in ROI", {
data_dir <- system.file("extdata/raster/mod13q1", package = "sits")
cube <- sits_cube(
source = "BDC",
collection = "MOD13Q1-6.1",
data_dir = data_dir,
progress = FALSE
)
# create a roi
roi <- sits_bbox(cube)
x_size <- as.numeric(roi[["xmax"]] - roi[["xmin"]])
y_size <- as.numeric(roi[["ymax"]] - roi[["ymin"]])
roi_2size <- roi
roi_2size["xmax"] <- roi[["xmax"]] - 2 * x_size
roi_2size["xmin"] <- roi[["xmin"]] - 2 * x_size
expect_null(.bbox_intersection(.bbox(roi_2size), .bbox(cube)))
bbox <- sits_bbox(cube)
bbox[["xmax"]] <- bbox[["xmax"]] + x_size
bbox[["xmin"]] <- bbox[["xmin"]] - x_size
bbox[["ymax"]] <- bbox[["ymax"]] + x_size
bbox[["ymin"]] <- bbox[["ymin"]] - x_size
int_bbox <- .bbox_intersection(.bbox(bbox), .bbox(cube))
expect_true(all(int_bbox == sits_bbox(cube)))
bb <- sits_bbox(cube)
bb[["xmin"]] <- bb[["xmin"]] + x_size / 4
bb[["ymin"]] <- bb[["ymin"]] + x_size / 4
si <- .raster_sub_image_from_bbox(bb, cube)
expect_equal(si[["col"]], 64)
expect_equal(si[["row"]], 1)
expect_equal(si[["ncols"]], 192)
expect_equal(si[["nrows"]], 84)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.