Enforces twdtw arguments in model build. Adds stars vignette.

.Rbuildignore

@@ -24,3 +24,5 @@ examples_x64
 ^LICENSE\.md$
 ^dtwSat\.Rproj$
 ^\.github$
+^doc$
+^Meta$

.gitignore

@@ -37,3 +37,5 @@ CRAN-SUBMISSION
 src/symbols.rds
 *.o
 *.so
+/doc/
+/Meta/

DESCRIPTION

@@ -35,6 +35,8 @@ License: GPL (>= 3)
 URL: https://github.com/vwmaus/dtwSat/
 BugReports: https://github.com/vwmaus/dtwSat/issues/
 Maintainer: Victor Maus <[email protected]>
+VignetteBuilder: 
+    knitr
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
@@ -47,10 +49,9 @@ Imports:
     mgcv,
     stats,
     tidyr,
-    rlang,
     proxy
 Suggests:
-    rbenchmark,
+    knitr,
     testthat (>= 3.0.0)
 Config/testthat/edition: 3
 Collate: 

NAMESPACE

@@ -12,7 +12,6 @@ importFrom(mgcv,gam)
 importFrom(mgcv,predict.gam)
 importFrom(mgcv,s)
 importFrom(proxy,dist)
-importFrom(rlang,.data)
 importFrom(stats,as.formula)
 importFrom(stats,predict)
 importFrom(stats,setNames)

R/predict.R

@@ -8,6 +8,7 @@
 #' @param newdata A data frame or similar object containing the new observations 
 #' (time series data) to be predicted.
 #' @param ... Additional arguments passed to the \link[twdtw]{twdtw} function.
+#' If provided, they will overwrite twdtw arguments previously passed to \link[dtwSat]{twdtw_knn1}.
 #'
 #' @return A vector of predicted classes for the `newdata`.
 #'
@@ -18,14 +19,18 @@
 #' @export
 predict.twdtw_knn1 <- function(object, newdata, ...){
 
+  # Update twdtw_args with new arguments passed via ...
+  new_twdtw_args <- list(...)
+  matching_twdtw_args <- intersect(names(new_twdtw_args), names(object$twdtw_args))
+  object$twdtw_args[matching_twdtw_args] <- new_twdtw_args[matching_twdtw_args]
 
   # Convert newdata to time series
   newdata_ts <- prepare_time_series(newdata)
 
   # Compute TWDTW distances
   distances <- sapply(object$data$observations, function(pattern){
     sapply(newdata_ts$observations, function(ts) {
-      proxy::dist(x = as.data.frame(ts), y = as.data.frame(pattern), method = 'twdtw', ...)
+      do.call(proxy::dist, c(list(x = as.data.frame(ts), y = as.data.frame(pattern), method = 'twdtw'), object$twdtw_args))
     })
   })
 

R/train.R

@@ -6,14 +6,18 @@
 #'
 #' @param x A two-dimensional stars object (x, y) with time and bands as attributes.
 #' @param y An sf object with the coordinates of the training points.
+#' @param time_weight A numeric vector with length two (steepness and midpoint of logistic weight) or a function.
+#' See details in \link[twdtw]{twdtw}.
+#' @param cycle_length The length of the cycle, e.g. phenological cycles. Details in \link[twdtw]{twdtw}.
+#' @param time_scale Specifies the time scale for the observations. Details in \link[twdtw]{twdtw}.
 #' @param formula Either NULL or a formula to reduce samples of the same label using Generalized Additive Models (GAM).
 #' Default is \code{band ~ s(time)}. See details.
 #' @param start_column Name of the column in y that indicates the start date. Default is 'start_date'.
 #' @param end_column Name of the column in y that indicates the end date. Default is 'end_date'.
 #' @param label_colum Name of the column in y containing land use labels. Default is 'label'.
 #' @param sampling_freq The time frequency for sampling, including the unit (e.g., '16 day').
 #' If NULL, the function will infer the frequency. This parameter is only used if a formula is provided.
-#' @param ... Additional arguments passed to the GAM function.
+#' @param ... Additional arguments passed to the \link[mgcv]{gam} function and to \link[twdtw]{twdtw} function.
 #'
 #' @details If \code{formula} is NULL, the KNN-1 model will retain all training samples. If a formula is passed (e.g., \code{band ~ \link[mgcv]{s}(time)}),
 #' then samples of the same label (land cover class) will be resampled using GAM.
@@ -49,24 +53,26 @@
 #' # Create a knn1-twdtw model
 #' m <- twdtw_knn1(x = dc,
 #'                 y = samples,
+#'                 cycle_length = 'year',
+#'                 time_scale = 'day',
+#'                 time_weight = c(steepness = 0.1, midpoint = 50),
 #'                 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))
-#' )
+#' system.time(lu <- predict(dc, model = m))
+#'
+#' # Visualise land use classification
+#' ggplot() +
+#'   geom_stars(data = lu) +
+#'   theme_minimal()
 #'
 #' }
 #' @export
-twdtw_knn1 <- function(x, y, formula = NULL, start_column = 'start_date',
+twdtw_knn1 <- function(x, y, time_weight, cycle_length, time_scale,
+                       formula = NULL, start_column = 'start_date',
                        end_column = 'end_date', label_colum = 'label',
                        sampling_freq = NULL, ...){
 
@@ -80,6 +86,11 @@ twdtw_knn1 <- function(x, y, formula = NULL, start_column = 'start_date',
     stop("y must be an sf object with point geometry")
   }
 
+  # check for minimum set of twdtw arguments
+  if (!(is.function(time_weight) || (is.numeric(time_weight) && length(time_weight) == 2))) stop("'time_weight' should be either a function or a numeric vector with length two")
+  if (is.null(cycle_length)) stop("The 'cycle_length' argument is missing.")
+  if (is.null(time_scale)) stop("The 'time_scale' argument is missing for 'cycle_length' type character.")
+
   # Check for required columns in y
   required_columns <- c(start_column, end_column, label_colum)
   missing_columns <- setdiff(required_columns, names(y))
@@ -140,6 +151,17 @@ twdtw_knn1 <- function(x, y, formula = NULL, start_column = 'start_date',
   model$call <- match.call()
   model$formula <- formula
   model$data <- ts_data
+  # add twdtw arguments to model
+  model$twdtw_args <- list(time_weight = time_weight,
+                           cycle_length = cycle_length,
+                           time_scale = time_scale,
+                           origin = NULL,
+                           max_elapsed = Inf,
+                           version = "f90")
+  new_twdtw_args <- list(...)
+  matching_twdtw_args <- intersect(names(model$twdtw_args), names(new_twdtw_args))
+  model$twdtw_args[matching_twdtw_args] <- new_twdtw_args[matching_twdtw_args]
+
   class(model) <- "twdtw_knn1"
 
   return(model)

R/zzz.R

@@ -4,7 +4,6 @@
 #' @import ggplot2
 #' @importFrom stats as.formula predict setNames
 #' @importFrom mgcv gam s predict.gam
-#' @importFrom rlang .data
 #' @importFrom tidyr pivot_longer pivot_wider nest unnest
 #' @importFrom proxy dist
 #' 

inst/REFERENCES.bib

@@ -23,47 +23,6 @@ @article{Maus:2019
   month={Jan}
 }
 
-@article{Olofsson:2014,
- title = {Good Practices for Estimating Area and Assessing Accuracy of Land Change},
- journal = {Remote Sensing of Environment},
- volume = {148},
- pages = {42--57},
- year = {2014},
- issn = {0034--4257},
- doi = {10.1016/j.rse.2014.02.015},
- author = {Pontus Olofsson and Giles M. Foody and Martin Herold and Stephen V. Stehman and Curtis E. Woodcock and Michael A. Wulder}
-}
-
-@article{Olofsson:2013,
-    author = {Pontus Olofsson and Giles M. Foody and Stephen V. Stehman and Curtis E. Woodcock},
-    title = {Making Better Use of Accuracy Aata in Land Change Studies: Estimating Accuracy and Area and Quantifying Uncertainty Using Stratified Estimation},
-    journal = {Remote Sensing of Environment},
-    volume = {129},
-    pages = {122--131},
-    year = {2013},
-    doi = {10.1016/j.rse.2012.10.031}
-}
-
-@article{Giorgino:2009,
-  author = {Toni Giorgino},
-  title = {Computing and Visualizing Dynamic Time Warping Alignments in {R}: The dtw Package},
-  journal = {Journal of Statistical Software},
-  year = {2009},
-  volume = {31},
-  pages = {1--24},
-  number = {7},
-  doi = {10.18637/jss.v031.i07}
-}
-
-@book{Muller:2007,
-  title = {Information Retrieval for Music and Motion},
-  publisher = {Springer-Verlag},
-  year = {2007},
-  author = {Meinard Muller},
-  pages = {64-84},
-  address = {London}
-}
-
 @misc{Didan:2015,
   author = {Kamel Didan},
   title =  {{MOD13Q1 MODIS/Terra Vegetation Indices 16-Day L3 Global