test_that("Plot Time Series and Images", {
cerrado_ndvi <- sits_select(cerrado_2classes, "NDVI")
p <- plot(cerrado_ndvi[1, ])
expect_equal(p$labels$title, "location (-14.05, -54.23) - Cerrado")
cerrado_ndvi_1class <- dplyr::filter(cerrado_ndvi, label == "Cerrado")
p1 <- plot(cerrado_ndvi_1class)
expect_equal(
p1$labels$title,
"Samples (400) for class Cerrado in band = NDVI"
)
p2 <- plot(sits_patterns(cerrado_2classes))
expect_equal(p2$theme$legend.position, "bottom")
p3 <- cerrado_2classes |>
sits_patterns() |>
sits_select(bands = "EVI") |>
plot()
expect_equal(as.Date(p3$data$Time[1]), as.Date("2000-09-13"))
expect_equal(p3$data$Pattern[1], "Cerrado")
expect_equal(p3$data$name[1], "EVI")
p4 <- cerrado_2classes |>
sits_patterns() |>
plot(bands = "NDVI")
expect_equal(as.Date(p4$data$Time[1]), as.Date("2000-09-13"))
expect_equal(p4$data$Pattern[1], "Cerrado")
expect_equal(p4$data$name[1], "NDVI")
point_ndvi <- sits_select(point_mt_6bands, bands = "NDVI")
set.seed(290356)
rfor_model <- sits_train(samples_modis_ndvi, ml_method = sits_rfor())
point_class <- sits_classify(point_ndvi, rfor_model, progress = FALSE)
p3 <- plot(point_class)
expect_equal(p3[[1]]$labels$y, "Value")
expect_equal(p3[[1]]$labels$x, "Time")
expect_equal(p3[[1]]$theme$legend.position, "bottom")
data_dir <- system.file("extdata/raster/mod13q1", package = "sits")
sinop <- sits_cube(
source = "BDC",
collection = "MOD13Q1-6.1",
data_dir = data_dir,
progress = FALSE
)
p <- plot(sinop, band = "NDVI", palette = "RdYlGn")
expect_equal(p$tm_shape$shp_name, "st")
expect_equal(p$tm_raster$palette, "RdYlGn")
expect_equal(p$tm_grid$grid.projection, 4326)
p_rgb <- plot(sinop, red = "NDVI", green = "NDVI", blue = "NDVI")
expect_equal(p_rgb$tm_shape$shp_name, "rgb_st")
expect_equal(p_rgb$tm_grid$grid.projection, 4326)
sinop_probs <- suppressMessages(
sits_classify(
sinop,
ml_model = rfor_model,
memsize = 2,
multicores = 2,
output_dir = tempdir(),
progress = FALSE
)
)
p_probs <- plot(sinop_probs)
expect_equal(p_probs$tm_raster$palette, "YlGn")
expect_equal(length(p_probs$tm_raster$title), 4)
expect_equal(p_probs$tm_layout$legend.bg.color, "white")
p_probs_f <- plot(sinop_probs, labels = "Forest")
expect_equal(p_probs_f$tm_raster$palette, "YlGn")
expect_equal(length(p_probs_f$tm_raster$title), 1)
expect_equal(p_probs_f$tm_layout$legend.bg.color, "white")
sinop_uncert <- sits_uncertainty(sinop_probs,
output_dir = tempdir()
)
p_uncert <- plot(sinop_uncert, palette = "Reds", rev = FALSE)
expect_equal(p_uncert$tm_raster$palette, "Reds")
expect_equal(length(p_uncert$tm_raster$title), 1)
expect_equal(p_uncert$tm_layout$legend.bg.color, "white")
sinop_labels <- sits_label_classification(
sinop_probs,
output_dir = tempdir(),
progress = FALSE
)
p4 <- plot(sinop_labels)
expect_equal(p4$tm_grid$grid.projection, 4326)
expect_equal(p4$tm_raster$n, 5)
expect_true(p4$tm_shape$check_shape)
})
test_that("Plot class cube from STAC", {
to_class <- .try(
{
sits_cube(
source = "TERRASCOPE",
collection = "WORLD-COVER-2021",
bands = "CLASS",
roi = c("lon_min" = -62.7,
"lon_max" = -62.5,
"lat_min" = -8.83 ,
"lat_max" = -8.70
),
progress = FALSE
)
},
.default = NULL
)
testthat::skip_if(purrr::is_null(to_class),
message = "TERRASCOPE is not accessible"
)
p1 <- plot(to_class)
expect_equal(p1$tm_grid$grid.projection, 4326)
expect_equal(p1$tm_raster$n, 5)
expect_true(p1$tm_shape$check_shape)
})
test_that("Plot Accuracy", {
# show accuracy for a set of samples
train_data <- sits_sample(samples_modis_ndvi, frac = 0.5)
test_data <- sits_sample(samples_modis_ndvi, frac = 0.5)
# compute a random forest model
rfor_model <- sits_train(train_data, sits_rfor())
# classify training points
points_class <- sits_classify(test_data, rfor_model, progress = FALSE)
# calculate accuracy
acc <- sits_accuracy(points_class)
# plot accuracy
p <- plot(acc)
expect_equal(p$labels$title, "Confusion matrix")
expect_equal(p$labels$x, "Class")
expect_equal(p$labels$y, "Agreement with reference")
expect_equal(p$theme$line$colour, "black")
})
test_that("Plot Models", {
set.seed(290356)
rfor_model <- sits_train(samples_modis_ndvi, ml_method = sits_rfor())
p_model <- plot(rfor_model)
expect_true(all(p_model$data$variable %in% c(
"NDVI1", "NDVI2", "NDVI3",
"NDVI4", "NDVI5", "NDVI6",
"NDVI7", "NDVI8", "NDVI9",
"NDVI10", "NDVI11", "NDVI12"
)))
expect_true(all(p_model$data$minimal_depth[1:2] %in% c(0, 1)))
xgb_model <- sits_train(samples_modis_ndvi, ml_method = sits_xgboost())
p_xgb <- plot(xgb_model)
expect_equal(p_xgb$x$config$engine, "dot")
expect_false(p_xgb$sizingPolicy$browser$fill)
expect_false(p_xgb$sizingPolicy$browser$external)
})
test_that("Dendrogram Plot", {
samples <- sits_cluster_dendro(cerrado_2classes,
bands = c("NDVI", "EVI"))
cluster <- .cluster_dendrogram(
samples = samples,
bands = c("NDVI", "EVI")
)
best_cut <- .cluster_dendro_bestcut(samples, cluster)
dend <- plot(samples,
cluster = cluster,
cutree_height = best_cut["height"],
palette = "RdYlGn"
)
expect_equal(class(dend), "dendrogram")
})
test_that("Plot torch model", {
model <- sits_train(
samples_modis_ndvi,
sits_mlp(
layers = c(128, 128),
dropout_rates = c(0.5, 0.4),
epochs = 50
)
)
pk <- plot(model)
expect_true(length(pk$layers) == 2)
expect_true(pk$labels$colour == "data")
expect_true(pk$labels$x == "epoch")
expect_true(pk$labels$y == "value")
})
test_that("Plot series with NA", {
cerrado_ndvi <- cerrado_2classes |>
sits_select(bands = "NDVI") |>
dplyr::filter(label == "Cerrado")
cerrado_ndvi_1 <- cerrado_ndvi[1, ]
ts <- cerrado_ndvi_1$time_series[[1]]
ts[1, 2] <- NA
ts[10, 2] <- NA
cerrado_ndvi_1$time_series[[1]] <- ts
pna <- suppressWarnings(plot(cerrado_ndvi_1))
expect_true(pna$labels$x == "Index")
expect_true(pna$labels$y == "value")
})
test_that("SOM map plot", {
set.seed(1234)
som_map <-
suppressWarnings(sits_som_map(
cerrado_2classes,
grid_xdim = 5,
grid_ydim = 5
))
p <- suppressWarnings(plot(som_map))
expect_true(all(names(p$rect) %in% c("w", "h", "left", "top")))
pc <- plot(som_map, type = "mapping")
expect_true(all(names(pc$rect) %in% c("w", "h", "left", "top")))
})
test_that("SOM evaluate cluster plot", {
set.seed(1234)
som_map <-
suppressWarnings(sits_som_map(
cerrado_2classes,
grid_xdim = 5,
grid_ydim = 5
))
cluster_purity_tb <- sits_som_evaluate_cluster(som_map)
p <- plot(cluster_purity_tb)
expect_equal(p$labels$title, "Confusion by cluster")
expect_equal(p$labels$y, "Percentage of mixture")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.