final dev release before commit of version 1.5.1 to CRAN

DESCRIPTION

@@ -202,6 +202,7 @@ Collate:
     'api_tile.R'
     'api_timeline.R'
     'api_tmap.R'
+    'api_tmap_v3.R'
     'api_torch.R'
     'api_torch_psetae.R'
     'api_ts.R'

NAMESPACE

@@ -10,6 +10,11 @@ S3method("sits_labels<-",class_cube)
 S3method("sits_labels<-",default)
 S3method("sits_labels<-",probs_cube)
 S3method("sits_labels<-",sits)
+S3method(.accuracy_get_validation,csv)
+S3method(.accuracy_get_validation,data.frame)
+S3method(.accuracy_get_validation,gpkg)
+S3method(.accuracy_get_validation,sf)
+S3method(.accuracy_get_validation,shp)
 S3method(.band_rename,raster_cube)
 S3method(.band_rename,sits)
 S3method(.check_samples,default)

R/api_accuracy.R

@@ -119,3 +119,71 @@
         )
     )
 }
+#' @title    Get validation samples
+#' @name .accuracy_get_validation
+#' @description Retrieves and checks validation data
+#' @keywords internal
+#' @noRd
+#' @param validation  validation (CSV file, SHP file, SF object, data.frame)
+#' @return samples for validation
+#'
+.accuracy_get_validation <- function(validation){
+    # handle validation data as files
+    if (is.character(validation)) {
+        val_class <- tolower(.file_ext(validation))
+        class(validation) <- c(val_class, validation)
+    }
+    UseMethod(".accuracy_get_validation", validation)
+}
+#' @export
+.accuracy_get_validation.csv <- function(validation){
+    # Read sample information from CSV file and put it in a tibble
+    valid_samples <- .csv_get_validation_samples(validation)
+    return(valid_samples)
+}
+#' @export
+.accuracy_get_validation.shp <- function(validation){
+    validation_sf <- sf::st_read(validation)
+    .check_that(all(sf::st_geometry_type(validation_sf) == "POINT"))
+    valid_samples <- .accuracy_get_validation(validation_sf)
+    return(valid_samples)
+}
+#' @export
+.accuracy_get_validation.gpkg <- function(validation){
+    validation_sf <- sf::st_read(validation)
+    .check_that(all(sf::st_geometry_type(validation_sf) == "POINT"))
+    valid_samples <- .accuracy_get_validation(validation_sf)
+    return(valid_samples)
+}
+#' @export
+.accuracy_get_validation.sf <- function(validation){
+    # Pre-condition - check for the required columns
+    .check_chr_contains(colnames(validation), c("label"))
+    # transform the `sf` object in a valid
+    valid_samples <- validation |>
+        dplyr::mutate(
+            geom = sf::st_geometry(validation)
+        ) |>
+        dplyr::mutate(
+            geom = sf::st_centroid(.data[["geom"]])
+        ) |>
+        dplyr::mutate(
+            coords = sf::st_coordinates(.data[["geom"]])
+        ) |>
+        dplyr::mutate(
+            longitude = .data[["coords"]][, 1],
+            latitude  = .data[["coords"]][, 2]
+        ) |>
+        dplyr::select(
+            "label", "longitude", "latitude"
+        )
+    return(valid_samples)
+}
+#' @export
+`.accuracy_get_validation.data.frame` <- function(validation){
+    # handle data frames
+    .check_chr_contains(colnames(validation),
+                        c("label", "longitude", "latitude")
+    )
+    return(validation)
+}

R/api_csv.R

@@ -30,3 +30,30 @@
     class(samples) <- c("sits", class(samples))
     return(samples)
 }
+
+#' @title Transform a CSV with labelled points for accuracy assessmentinto a samples file
+#' @name .csv_get_validation_samples
+#' @author Gilberto Camara
+#' @keywords internal
+#' @noRd
+#' @param csv_file        CSV that describes the data to be retrieved.
+#' @return                A tibble with information the samples to be retrieved
+#'
+.csv_get_validation_samples <- function(csv_file) {
+    # read sample information from CSV file and put it in a tibble
+    samples <- tibble::as_tibble(
+        utils::read.csv(
+            file = csv_file,
+            stringsAsFactors = FALSE
+        )
+    )
+    # pre-condition - check if CSV file is correct
+    .check_samples(samples)
+    # select valid columns
+    samples <- dplyr::select(
+        samples,
+        c("longitude", "latitude", "label")
+    )
+    class(samples) <- c("sits", class(samples))
+    return(samples)
+}

R/api_samples.R

@@ -350,6 +350,8 @@
             dplyr::filter(.data[["label"]] == lab) |>
             dplyr::slice_sample(n = samples_label)
     })
+    # transform to sf object
+    samples <- sf::st_as_sf(samples)
 
     return(samples)
 }