tests/testthat/test-roi.R

In e-sensing/sits: Satellite Image Time Series Analysis for Earth Observation Data Cubes

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",
        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",
        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",
        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",
        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)
})