From 9ef5f1a20293fe68f7e70a4c974a2307d8600f77 Mon Sep 17 00:00:00 2001
From: vwmaus <vwmaus1@gmail.com>
Date: Thu, 21 Sep 2023 21:52:23 +0200
Subject: [PATCH] Pretty model print. Fixes vignette.

---
 NAMESPACE                            |  1 +
 R/train.R                            | 74 ++++++++++++++++++++++++++++
 man/pretty_arguments.Rd              | 23 +++++++++
 man/print.twdtw_knn1.Rd              | 20 ++++++++
 tests/testthat/test-twdtw_classify.R |  2 +-
 vignettes/landuse-mapping.Rmd        |  5 +-
 6 files changed, 123 insertions(+), 2 deletions(-)
 create mode 100644 man/pretty_arguments.Rd
 create mode 100644 man/print.twdtw_knn1.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 633818b..4c99aae 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -2,6 +2,7 @@
 
 S3method(plot,twdtw_knn1)
 S3method(predict,twdtw_knn1)
+S3method(print,twdtw_knn1)
 export(shift_dates)
 export(twdtw_knn1)
 import(ggplot2)
diff --git a/R/train.R b/R/train.R
index a40674c..2554894 100644
--- a/R/train.R
+++ b/R/train.R
@@ -169,6 +169,80 @@ twdtw_knn1 <- function(x, y, time_weight, cycle_length, time_scale,
 
 }
 
+#' Print method for objects of class twdtw_knn1
+#'
+#' This method provides a structured printout of the important components
+#' of a `twdtw_knn1` object.
+#'
+#' @param x An object of class `twdtw_knn1`.
+#' @param ... ignored
+#' 
+#' @return Invisible `twdtw_knn1` object.
+#'
+#' @export
+print.twdtw_knn1 <- function(x, ...) {
+  cat("\nModel of class 'twdtw_knn1'\n")
+  cat("-----------------------------\n")
+
+  # Printing the call
+  cat("Call:\n")
+  print(x$call)
+
+  # Printing the formula, if available
+  cat("\nFormula:\n")
+  print(x$formula)
+
+  # Printing the data summary
+  cat("\nData:\n")
+  print(x$data)
+
+  # Printing twdtw arguments
+  cat("\nTWDTW Arguments:\n")
+  pretty_arguments(x$twdtw_args)
+
+  invisible(x) # Returns the object invisibly, so it doesn't print twice
+}
+
+#' Print Pretty Arguments
+#'
+#' Display a list of arguments of a given function in a human-readable format.
+#'
+#' @param args A list of named arguments to display.
+#'
+#' @return Invisible NULL. The function is mainly used for its side effect of printing.
+#'
+#' @examples
+#' \dontrun{
+#' pretty_arguments(formals(twdtw_knn1))
+#' }
+#'
+pretty_arguments <- function(args) {
+
+  if (is.null(args)) {
+    cat("Arguments are missing.\n")
+    return(invisible(NULL))
+  }
+
+  for (name in names(args)) {
+    default_value <- args[[name]]
+
+    if (is.symbol(default_value)) {
+      default_value <- as.character(default_value)
+
+    } else if (is.null(default_value)) {
+      default_value <- "NULL"
+
+    } else if (is.vector(default_value) && !is.null(names(default_value))) {
+      # Handle named vectors
+      values <- paste(names(default_value), default_value, sep = "=", collapse = ", ")
+      default_value <- paste0("c(", values, ")")
+    }
+    cat(paste0(" - ", name, ": ", default_value, "\n"))
+  }
+}
+
+
+
 #' Compute the Most Common Sampling Frequency across all observations
 #'
 #' This function calculates the most common difference between consecutive time points.
diff --git a/man/pretty_arguments.Rd b/man/pretty_arguments.Rd
new file mode 100644
index 0000000..a620918
--- /dev/null
+++ b/man/pretty_arguments.Rd
@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/train.R
+\name{pretty_arguments}
+\alias{pretty_arguments}
+\title{Print Pretty Arguments}
+\usage{
+pretty_arguments(args)
+}
+\arguments{
+\item{args}{A list of named arguments to display.}
+}
+\value{
+Invisible NULL. The function is mainly used for its side effect of printing.
+}
+\description{
+Display a list of arguments of a given function in a human-readable format.
+}
+\examples{
+\dontrun{
+pretty_arguments(formals(twdtw_knn1))
+}
+
+}
diff --git a/man/print.twdtw_knn1.Rd b/man/print.twdtw_knn1.Rd
new file mode 100644
index 0000000..c909f7a
--- /dev/null
+++ b/man/print.twdtw_knn1.Rd
@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/train.R
+\name{print.twdtw_knn1}
+\alias{print.twdtw_knn1}
+\title{Print method for objects of class twdtw_knn1}
+\usage{
+\method{print}{twdtw_knn1}(x, ...)
+}
+\arguments{
+\item{x}{An object of class \code{twdtw_knn1}.}
+
+\item{...}{ignored}
+}
+\value{
+Invisible \code{twdtw_knn1} object.
+}
+\description{
+This method provides a structured printout of the important components
+of a \code{twdtw_knn1} object.
+}
diff --git a/tests/testthat/test-twdtw_classify.R b/tests/testthat/test-twdtw_classify.R
index efc4709..8dede52 100644
--- a/tests/testthat/test-twdtw_classify.R
+++ b/tests/testthat/test-twdtw_classify.R
@@ -31,7 +31,7 @@ system.time(
                   time_weight = c(steepness = 0.1, midpoint = 50),
                   formula = band ~ s(time))
 )
-
+m
 # Visualize model patterns
 plot(m)
 
diff --git a/vignettes/landuse-mapping.Rmd b/vignettes/landuse-mapping.Rmd
index 9049dab..66d8af0 100644
--- a/vignettes/landuse-mapping.Rmd
+++ b/vignettes/landuse-mapping.Rmd
@@ -82,6 +82,8 @@ twdtw_model <- twdtw_knn1(x = dc,
                           time_scale = 'day',
                           time_weight = c(steepness = 0.1, midpoint = 50),
                           formula = band ~ s(time))
+
+print(twdtw_model)
 ```
 
 In addition to the mandatory arguments `x` (satellite data-cube) and `y` (training samples), 
@@ -102,9 +104,10 @@ Finally, we predict the land-use classes for each pixel location in the data-cub
 
 ```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE}
 lu_map <- predict(dc, model = twdtw_model)
+print(lu_map)
 ```
 
-And visualize the results using `ggplot`:
+The 'time' dimension was reduced to a single map. We can now visualize it using `ggplot`:
 
 ```{r , echo = TRUE, eval = TRUE, warning = FALSE, message = FALSE}
 ggplot() +