From 8bb67222ada208b78596c4781cbecabf38237a26 Mon Sep 17 00:00:00 2001 From: PetoLau Date: Wed, 22 Apr 2020 18:06:20 +0200 Subject: [PATCH] fixed repr_sma + added new norm functions box cox + atan (also denorm) --- DESCRIPTION | 2 +- NAMESPACE | 3 + NEWS.md | 6 ++ R/RcppExports.R | 2 +- R/normalizations_R.R | 114 +++++++++++++++++++++++++++ R/repr_matrix.R | 33 +++++--- man/denorm_atan.Rd | 27 +++++++ man/norm_atan.Rd | 27 +++++++ man/norm_boxcox.Rd | 31 ++++++++ man/repr_sma.Rd | 2 +- src/reprsClassical.cpp | 19 ++++- tests/testthat/test_classical_repr.R | 11 ++- 12 files changed, 258 insertions(+), 19 deletions(-) create mode 100644 R/normalizations_R.R create mode 100644 man/denorm_atan.Rd create mode 100644 man/norm_atan.Rd create mode 100644 man/norm_boxcox.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 3afb059..ea8a832 100644 --- a/DESCRIPTION +++ b/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"), diff --git a/NAMESPACE b/NAMESPACE index 65632ae..7c7bb1c 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 844ffd6..1dded97 100644 --- a/NEWS.md +++ b/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 diff --git a/R/RcppExports.R b/R/RcppExports.R index 7738518..fcf8c05 100644 --- a/R/RcppExports.R +++ b/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 diff --git a/R/normalizations_R.R b/R/normalizations_R.R new file mode 100644 index 0000000..8c24f4d --- /dev/null +++ b/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, +#' +#' @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, +#' +#' @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, +#' +#' @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 diff --git a/R/repr_matrix.R b/R/repr_matrix.R index 6d6b867..b2be93b 100644 --- a/R/repr_matrix.R +++ b/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) + } diff --git a/man/denorm_atan.Rd b/man/denorm_atan.Rd new file mode 100644 index 0000000..81ff6d1 --- /dev/null +++ b/man/denorm_atan.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normalizations_R.R +\name{denorm_atan} +\alias{denorm_atan} +\title{Arctangent denormalisation} +\usage{ +denorm_atan(x) +} +\arguments{ +\item{x}{the numeric vector (time series)} +} +\value{ +the numeric vector of denormalised values +} +\description{ +The \code{denorm_atan} denormalises time series from Arctangent function. +} +\examples{ +denorm_atan(runif(50)) + +} +\seealso{ +\code{\link[TSrepr]{denorm_z}, \link[TSrepr]{denorm_min_max}} +} +\author{ +Peter Laurinec, +} diff --git a/man/norm_atan.Rd b/man/norm_atan.Rd new file mode 100644 index 0000000..a89a4cf --- /dev/null +++ b/man/norm_atan.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normalizations_R.R +\name{norm_atan} +\alias{norm_atan} +\title{Arctangent normalisation} +\usage{ +norm_atan(x) +} +\arguments{ +\item{x}{the numeric vector (time series)} +} +\value{ +the numeric vector of normalised values +} +\description{ +The \code{norm_atan} normalises time series by Arctangent to max (-1,1) range. +} +\examples{ +norm_atan(rnorm(50)) + +} +\seealso{ +\code{\link[TSrepr]{norm_z}, \link[TSrepr]{norm_min_max}} +} +\author{ +Peter Laurinec, +} diff --git a/man/norm_boxcox.Rd b/man/norm_boxcox.Rd new file mode 100644 index 0000000..3450566 --- /dev/null +++ b/man/norm_boxcox.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/normalizations_R.R +\name{norm_boxcox} +\alias{norm_boxcox} +\title{Two-parameter Box-Cox normalisation} +\usage{ +norm_boxcox(x, lambda = 0.1, gamma = 0) +} +\arguments{ +\item{x}{the numeric vector (time series)} + +\item{lambda}{the numeric value - power transformation parameter (default is 0.1)} + +\item{gamma}{the non-negative numeric value - parameter for holding the time series positive (offset) (default is 0)} +} +\value{ +the numeric vector of normalised values +} +\description{ +The \code{norm_boxcox} normalises time series by two-parameter Box-Cox normalisation. +} +\examples{ +norm_boxcox(runif(50)) + +} +\seealso{ +\code{\link[TSrepr]{norm_z}, \link[TSrepr]{norm_min_max}, \link[TSrepr]{norm_atan}} +} +\author{ +Peter Laurinec, +} diff --git a/man/repr_sma.Rd b/man/repr_sma.Rd index c822cbb..70c56f9 100644 --- a/man/repr_sma.Rd +++ b/man/repr_sma.Rd @@ -12,7 +12,7 @@ repr_sma(x, order) \item{order}{the order of simple moving average} } \value{ -the numeric vector of smoothed values +the numeric vector of smoothed values of the length = length(x) - order + 1 } \description{ The \code{repr_sma} computes Simple Moving Average (SMA) from a time series. diff --git a/src/reprsClassical.cpp b/src/reprsClassical.cpp index 00d3887..c20bd20 100644 --- a/src/reprsClassical.cpp +++ b/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 diff --git a/tests/testthat/test_classical_repr.R b/tests/testthat/test_classical_repr.R index a536ab1..feeb512 100644 --- a/tests/testthat/test_classical_repr.R +++ b/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!") +})