Fixes documentation and adds tests

DESCRIPTION

@@ -2,7 +2,7 @@ Package: dtwSat
 Type: Package
 Title: Time-Weighted Dynamic Time Warping for Satellite Image Time Series Analysis
 Version: 1.0.0
-Date: 2023-09-03
+Date: 2023-09-20
 Authors@R:
     c(person(given = "Victor",
              family = "Maus",
@@ -24,14 +24,13 @@ Authors@R:
              )
 Description: Provides a robust approach to land use mapping using multi-dimensional 
     (multi-band) satellite image time series. By leveraging the Time-Weighted Dynamic 
-    Time Warping (TWDTW) distance metric in tandem with a 1-NN classifier, the package 
-    provides functions to produce land use maps based on distinct seasonality patterns, 
-    typically observed in the phenological cycles of vegetation. The TWDTW algorithm is 
-    described in Maus et al. (2016) <doi:10.1109/JSTARS.2016.2517118> and 
-    Maus et al. (2019) <doi:10.18637/jss.v088.i05>. A key strength of TWDTW is its ability 
-    to recognize patterns with only a minimal training set, achieving notable accuracy. 
-    The package features tools for generating temporal patterns for various land cover types, 
-    conducting land use mapping, and visualizing the outcomes.
+    Time Warping (TWDTW) distance metric in tandem with a 1 Nearest-Neighbor (1-NN) Classifier,
+    this package offers functions to produce land use maps based on distinct seasonality patterns, 
+    commonly observed in the phenological cycles of vegetation. The approach is described in 
+    Maus et al. (2016) <doi:10.1109/JSTARS.2016.2517118> and Maus et al. (2019) <doi:10.18637/jss.v088.i05>.
+    A primary advantage of TWDTW is its capability to handle irregularly sampled and noisy time series, 
+    while also requiring minimal training sets. The package includes tools for training the 1-NN-TWDTW model, 
+    visualizing temporal patterns, producing land use maps, and visualizing the results.
 License: GPL (>= 3)
 URL: https://github.com/vwmaus/dtwSat/
 BugReports: https://github.com/vwmaus/dtwSat/issues/
@@ -54,3 +53,10 @@ Suggests:
     rbenchmark,
     testthat (>= 3.0.0)
 Config/testthat/edition: 3
+Collate: 
+    'plot_patterns.R'
+    'predict.R'
+    'prepare_time_series.R'
+    'shift_dates.R'
+    'train.R'
+    'zzz.R'

R/plot_patterns.R

@@ -20,6 +20,10 @@
 #'
 #' @return A \code{\link[ggplot2]{ggplot}} object displaying the time series patterns.
 #'
+#' @seealso knn1_twdtw
+#'
+#' @inherit knn1_twdtw examples
+#'
 #' @export
 plot.knn1_twdtw <- function(x, n = 12, ...) {
 
@@ -30,9 +34,9 @@ plot.knn1_twdtw <- function(x, n = 12, ...) {
   df <- pivot_longer(df, !c('label', 'time'), names_to = "band", values_to = "value")
 
   # Construct the ggplot
-  gp <- ggplot(df, aes(x = 'time', y = 'value', colour = 'band')) +
+  gp <- ggplot(df, aes(x = .data$time, y = .data$value, colour = .data$band)) +
     geom_line() +
-    facet_wrap(~'label') +
+    facet_wrap(~label) +
     theme(legend.position = "bottom") +
     guides(colour = guide_legend(title = "Bands")) +
     ylab("Value") +

R/predict.R

@@ -11,6 +11,9 @@
 #'
 #' @return A vector of predicted classes for the `newdata`.
 #'
+#' @seealso knn1_twdtw
+#'
+#' @inherit knn1_twdtw examples
 #'
 #' @export
 predict.knn1_twdtw <- function(object, newdata, ...){

R/prepare_time_series.R

@@ -52,12 +52,12 @@ prepare_time_series <- function(x) {
   if (!'label' %in% names(x)) {
     x$label <- NA
   }
-  x <- pivot_longer(x, !c(.data$ts_id, .data$label), names_to = "band_date", values_to = "value")
+  x <- pivot_longer(x, !c('ts_id', 'label'), names_to = 'band_date', values_to = 'value')
   x$band <- rep(date_band$band, ns)
   x$time <- rep(date_band$time, ns)
   x$band_date <- NULL
   result_df <- pivot_wider(x, id_cols = c('ts_id', 'label', 'time'), names_from = 'band', values_from = 'value')
-  result_df <- nest(result_df, .by = c(.data$ts_id, .data$label), .key = "observations")
+  result_df <- nest(result_df, .by = c('ts_id', 'label'), .key = 'observations')
 
   return(result_df)
 

R/train.R

@@ -22,9 +22,47 @@
 #' @return A 'knn1_twdtw' model containing the trained model information and the data used.
 #'
 #' @examples
+#' \dontrun{
+#' # Read training samples
+#' samples <-
+#'   system.file("mato_grosso_brazil/samples.gpkg", package = "dtwSat") |>
+#'   st_read(quiet = TRUE)
 #'
-#' # Example will be added once the function is properly implemented and tested.
-#' 
+#' # Get satellite image time sereis files
+#' tif_files <- system.file("mato_grosso_brazil", package = "dtwSat") |>
+#'   dir(pattern = "\\.tif$", full.names = TRUE)
+#'
+#' # Get acquisition dates
+#' acquisition_date <- regmatches(tif_files, regexpr("[0-9]{8}", tif_files)) |>
+#'   as.Date(format = "%Y%m%d")
+#'
+#' # Create a 2D datacube
+#' dc <- read_stars(tif_files,
+#'                  proxy = FALSE,
+#'                  along = list(time = acquisition_date),
+#'                  RasterIO = list(bands = 1:6)) |>
+#'       st_set_dimensions(3, c("EVI", "NDVI", "RED", "BLUE", "NIR", "MIR")) |>
+#'       split(c("band")) |>
+#'       split(c("time"))
+#'
+#' # Create a knn1-twdtw model
+#' m <- knn1_twdtw(x = dc,
+#'                 y = samples,
+#'                 formula = band ~ s(time))
+#'
+#' # Visualize model patterns
+#' plot(m)
+#'
+#' # Classify satellite images
+#' system.time(
+#'   lu <- predict(dc,
+#'                 model = m,
+#'                 drop_dimensions = TRUE,
+#'                 cycle_length = 'year',
+#'                 time_scale = 'day',
+#'                 time_weight = c(steepness = 0.1, midpoint = 50))
+#' )
+#' }
 #' @export
 knn1_twdtw <- function(x, y, formula = NULL, start_column = 'start_date',
                        end_column = 'end_date', label_colum = 'label',
@@ -74,7 +112,7 @@ knn1_twdtw <- function(x, y, formula = NULL, start_column = 'start_date',
 
     # Split data frame by label
     ts_data <- unnest(ts_data, cols = 'observations')
-    ts_data <- nest(ts_data, .by = .data$label, .key = "observations")
+    ts_data <- nest(ts_data, .by = 'label', .key = "observations")
 
     # Define GAM function
     gam_fun <- function(band, t, pred_t, formula, ...){
@@ -106,34 +144,15 @@ knn1_twdtw <- function(x, y, formula = NULL, start_column = 'start_date',
 
 }
 
-#' Compute the Most Common Sampling Frequency in a Stars Object
+#' Compute the Most Common Sampling Frequency across all observations
 #'
-#' This function calculates the most common difference between consecutive time points in a stars object. 
-#' This can be useful for determining the sampling frequency of the time series data.
+#' This function calculates the most common difference between consecutive time points.
+#' This can be useful for determining the aproximate sampling frequency of the time series data.
 #'
-#' @param x A stars object containing time series data.
+#' @param x A data frame including a column called `observations`` with the time series 
 #'
 #' @return A difftime object representing the most common time difference between consecutive samples.
 #'
-#'
-get_stars_time_freq <- function(x) {
-
-  # Extract the time dimension
-  time_values <- st_get_dimension_values(x, "time")
-
-  # Compute the differences between consecutive time points
-  time_diffs <- diff(time_values)
-
-  # Convert differences to days (while retaining the difftime class)
-  time_diffs <- as.difftime(time_diffs, units = "days")
-
-  # Identify the mode
-  mode_val_index <- which.max(tabulate(match(time_diffs, unique(time_diffs))))
-  freq <- diff(time_values[mode_val_index:(mode_val_index+1)])
-
-  return(freq)
-}
-
 get_time_series_freq <- function(x) {
 
   # Extract the time dimension
@@ -151,4 +170,4 @@ get_time_series_freq <- function(x) {
 
   return(freq)
 
-}
+}