fixed repr_sma + added new norm functions box cox + atan (also denorm)

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: TSrepr
 Type: Package
 Title: Time Series Representations
-Version: 1.0.4
+Version: 1.0.4.999
 Date: 2020-03-25
 Authors@R: person("Peter", "Laurinec", email = "tsreprpackage@gmail.com",
   role = c("aut", "cre"), 

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(clipping)
+export(denorm_atan)
 export(denorm_min_max)
 export(denorm_z)
 export(l1Coef)
@@ -15,6 +16,8 @@ export(meanC)
 export(medianC)
 export(minC)
 export(mse)
+export(norm_atan)
+export(norm_boxcox)
 export(norm_min_max)
 export(norm_min_max_list)
 export(norm_min_max_params)

NEWS.md

@@ -1,3 +1,9 @@
+# TSrepr 1.0.4.999
+  * fixed repr_sma + added stopping rules with order parameter + unit tests on that
+  * TODO new norm functions as atan + Box-Cox + YJ
+  * TODO repr_matrix -> repr_list
+  * TODO new vignette on use case of repr_list + repr_sma + DTW hierarcical clustering + on new dataset (covid-19 countries' trajectories)
+
 # TSrepr 1.0.4 2020/03/25
 
   * Fixed 0/0 case in forecasting accuracy measures

R/RcppExports.R

@@ -652,7 +652,7 @@ norm_min_max_params <- function(x, min, max) {
 #'
 #' @description The \code{repr_sma} computes Simple Moving Average (SMA) from a time series.
 #'
-#' @return the numeric vector of smoothed values
+#' @return the numeric vector of smoothed values of the length = length(x) - order + 1
 #'
 #' @param x the numeric vector (time series)
 #' @param order the order of simple moving average

R/normalizations_R.R

@@ -0,0 +1,114 @@
+# ArcTan normalisation to (-1,1) range ----
+
+#' @rdname norm_atan
+#' @name norm_atan
+#' @title Arctangent normalisation
+#'
+#' @description The \code{norm_atan} normalises time series by Arctangent to max (-1,1) range.
+#'
+#' @return the numeric vector of normalised values
+#'
+#' @param x the numeric vector (time series)
+#'
+#' @author Peter Laurinec, <tsreprpackage@gmail.com>
+#'
+#' @seealso \code{\link[TSrepr]{norm_z}, \link[TSrepr]{norm_min_max}}
+#'
+#' @examples
+#' norm_atan(rnorm(50))
+#'
+#' @export norm_atan
+norm_atan <- function(x) {
+
+  x <- as.numeric(x)
+
+  norm_values <- atan(x) / (pi / 2)
+
+
+  return(norm_values)
+
+}
+
+#' @rdname denorm_atan
+#' @name denorm_atan
+#' @title Arctangent denormalisation
+#'
+#' @description The \code{denorm_atan} denormalises time series from Arctangent function.
+#'
+#' @return the numeric vector of denormalised values
+#'
+#' @param x the numeric vector (time series)
+#'
+#' @author Peter Laurinec, <tsreprpackage@gmail.com>
+#'
+#' @seealso \code{\link[TSrepr]{denorm_z}, \link[TSrepr]{denorm_min_max}}
+#'
+#' @examples
+#' denorm_atan(runif(50))
+#'
+#' @export denorm_atan
+denorm_atan <- function(x) {
+
+  x <- as.numeric(x)
+
+  denorm_values <- tan(x * (pi / 2))
+
+  return(denorm_values)
+
+}
+
+# Two-parameter Box-Cox normalisation -----
+
+#' @rdname norm_boxcox
+#' @name norm_boxcox
+#' @title Two-parameter Box-Cox normalisation
+#'
+#' @description The \code{norm_boxcox} normalises time series by two-parameter Box-Cox normalisation.
+#'
+#' @return the numeric vector of normalised values
+#'
+#' @param x the numeric vector (time series)
+#' @param lambda the numeric value - power transformation parameter (default is 0.1)
+#' @param gamma the non-negative numeric value - parameter for holding the time series positive (offset) (default is 0)
+#'
+#' @author Peter Laurinec, <tsreprpackage@gmail.com>
+#'
+#' @seealso \code{\link[TSrepr]{norm_z}, \link[TSrepr]{norm_min_max}, \link[TSrepr]{norm_atan}}
+#'
+#' @examples
+#' norm_boxcox(runif(50))
+#'
+#' @export norm_boxcox
+norm_boxcox <- function(x, lambda = 0.1, gamma = 0) {
+
+  x <- as.numeric(x)
+
+  if (gamma < 0) {
+
+    stop("gamma must be non-negative")
+
+  } else if (lambda <= 0 & sum(x == 0L) > 0) {
+
+    stop("set gamma parameter higher to be x > 0")
+
+  }
+
+  if (lambda == 0) {
+
+    norm_values <- log(x + gamma)
+
+  } else {
+
+    norm_values <- (((x + gamma) ^ lambda) - 1) / lambda
+
+  }
+
+  return(norm_values)
+
+}
+
+# TODO denorm_boxcox
+
+# Yeo-Johnson normalisation -----
+
+# TODO norm_yj, denorm_yj

R/repr_matrix.R

@@ -40,36 +40,49 @@
 repr_matrix <- function(x, func = NULL, args = NULL, normalise = FALSE, func_norm = norm_z, windowing = FALSE, win_size = NULL) {
 
   if (is.null(func)) {
+
     stop("func must be specified!")
+
   }
 
   x <- data.matrix(x)
 
   if (normalise == TRUE) {
+
     x <- t(apply(x, 1, func_norm))
+
   }
 
   if (windowing) {
 
     if (is.null(win_size)) {
+
       stop("win_size must be specified!")
+
     }
 
     repr <- t(sapply(1:nrow(x), function(i) do.call(repr_windowing, args = append(list(x = x[i,]),
                                                                                   append(list(func = func,
-                                                                                       win_size = win_size),
-                                                                                       args)
-                                                                                  ))))
+                                                                                              win_size = win_size
+                                                                                              ),
+                                                                                         args
+                                                                                         )
+                                                                                  )
+                                                    )
+                     )
+              )
+
   } else {
+
     repr <- t(sapply(1:nrow(x), function(i) do.call(func, args = append(list(x = x[i,]),
-                                                                        args))))
-  }
+                                                                        args
+                                                                        )
+                                                    )
+                     )
+              )
 
-  # if (is.null(args)) {
-  #   repr <- t(apply(x, 1, func))
-  # } else {
-  #   repr <- t(sapply(1:nrow(x), function(i) do.call(func, args = append(list(x = x[i,]), args))))
-  # }
+  }
 
   return(repr)
+
 }

src/reprsClassical.cpp

@@ -10,7 +10,7 @@ using namespace Rcpp;
 //'
 //' @description The \code{repr_sma} computes Simple Moving Average (SMA) from a time series.
 //'
-//' @return the numeric vector of smoothed values
+//' @return the numeric vector of smoothed values of the length = length(x) - order + 1
 //'
 //' @param x the numeric vector (time series)
 //' @param order the order of simple moving average
@@ -26,9 +26,19 @@ using namespace Rcpp;
 NumericVector repr_sma(NumericVector x, int order) {
 
   int n = x.size();
-  int n_ma = n - order;
-  double sum = 0;
 
+  if (order <= 0) {
+
+    stop("order must be positive number!");
+
+  } else if (order > n) {
+
+    stop("order must be less than length(x)!");
+
+  }
+
+  int n_ma = n - order + 1;
+  double sum = 0;
   NumericVector repr(n_ma);
 
   for(int i = 0; i < order; i++){
@@ -38,10 +48,11 @@ NumericVector repr_sma(NumericVector x, int order) {
   repr[0] = sum / order;
 
   for(int i = 1; i < n_ma; i++){
-    repr[i] = repr[i-1] + (x[i+order]/order) - (x[i-1]/order);
+    repr[i] = repr[i-1] + (x[i+order-1]/order) - (x[i-1]/order);
   }
 
   return repr;
+
 }
 
 //' @rdname repr_paa

tests/testthat/test_classical_repr.R

@@ -5,8 +5,9 @@ x_ts <- rep(1:8, 12)
 order <- 5
 q <- 8
 freq <- 24
+
 test_that("Test on x_ts, length of output from selected repr_...() functions", {
-  expect_length(repr_sma(x_ts, order = order), length(x_ts) - order)
+  expect_length(repr_sma(x_ts, order = order), length(x_ts) - order + 1)
   expect_length(repr_paa(x_ts, q = q, func = mean), length(x_ts)/q)
   expect_length(repr_paa(x_ts[-1], q = q, func = mean), ceiling(length(x_ts[-1])/q))
   expect_length(repr_seas_profile(x_ts, freq = freq, func = mean), freq)
@@ -15,7 +16,13 @@ test_that("Test on x_ts, length of output from selected repr_...() functions", {
 
 # Extracted values (repr.) testing
 test_that("Test on x_ts, extracted values from repr_...() functions", {
-  expect_equal(mean(repr_sma(x_ts, order = order)), 4.2)
+  expect_equal(mean(repr_sma(x_ts, order = order)), 4.5)
   expect_equal(unique(repr_paa(x_ts, q = q, func = mean)), mean(x_ts))
   expect_equal(repr_seas_profile(x_ts, freq = freq, func = mean), rep(1:8, 3))
 })
+
+# Test errors: parameters exceeds some limits
+test_that("Test on the parameters of reprs when they exceeds some limits", {
+  expect_error(repr_sma(x_ts, order = length(x_ts) + 1), "order must be less than length\\(x\\)!")
+  expect_error(repr_sma(x_ts, order = 0), "order must be positive number!")
+})