tests/testthat/test-samples.R

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

test_that("Sample", {
    data(cerrado_2classes)

    data <- sits_sample(cerrado_2classes, frac = 0.1)
    expect_true(nrow(dplyr::filter(data, label == "Cerrado")) == 40)
    expect_true(nrow(dplyr::filter(data, label == "Pasture")) == 34)

    data2 <- sits_sample(cerrado_2classes, frac = 1.3, oversample = TRUE)
    expect_true(nrow(data2) > nrow(cerrado_2classes))
})

test_that("Sample reduce imbalance", {
    # print the labels summary for a sample set
    sum_ori_samples <- summary(samples_modis_ndvi)
    # reduce the sample imbalance
    new_samples <- sits_reduce_imbalance(samples_modis_ndvi,
        n_samples_over = 200, n_samples_under = 200,
        multicores = 1
    )
    # print the labels summary for the rebalanced set
    sum_new_samples <- summary(new_samples)
    expect_true(nrow(new_samples) < nrow(samples_modis_ndvi))
    expect_true(sd(sum_new_samples[["count"]]) < sd(sum_ori_samples[["count"]]))
})

test_that("Sampling design", {
    # create a random forest model
    rfor_model <- sits_train(samples_modis_ndvi, sits_rfor())
    # create a data cube from local files
    data_dir <- system.file("extdata/raster/mod13q1", package = "sits")
    cube <- sits_cube(
        source = "BDC",
        collection = "MOD13Q1-6",
        data_dir = data_dir
    )
    # classify a data cube
    probs_cube <- sits_classify(
        data = cube, ml_model = rfor_model, output_dir = tempdir()
    )
    # label the probability cube
    label_cube <- sits_label_classification(
        probs_cube,
        output_dir = tempdir()
    )
    # estimated UA for classes
    expected_ua <- c(Cerrado = 0.75, Forest = 0.9,
                     Pasture = 0.8, Soy_Corn = 0.8)
    sampling_design <- sits_sampling_design(label_cube, expected_ua)

    expect_true(all(c("prop", "expected_ua", "std_dev", "equal",
                      "alloc_100", "alloc_75", "alloc_50", "alloc_prop")
                %in% colnames(sampling_design)))

    # select samples
    shp_file <- paste0(tempdir(),"/strata.shp")
    overhead <- 1.2
    samples <- sits_stratified_sampling(cube = label_cube,
                                        sampling_design = sampling_design,
                                        overhead = overhead,
                                        alloc = "alloc_prop",
                                        shp_file = shp_file)
    expect_true(file.exists(shp_file))

    sd <- unlist(sampling_design[,5], use.names = FALSE)
    expect_equal(sum(ceiling(sd*overhead)), nrow(samples), tolerance = 10)

    sf_shp <- sf::st_read(shp_file)
    expect_true(all(sf::st_geometry_type(sf_shp) == "POINT"))
})