X-Git-Url: https://git.auder.net/js/current/gitweb.js?a=blobdiff_plain;f=pkg%2Ftests%2Ftestthat%2Ftest.dateIndexToInteger.R;h=7f09847f93e2b0393e033b343fc453523f960ba9;hb=6d97bfecf7310ed6682eecce1b7aa2f8185d4742;hp=fb4c8e43f8ebce334748287c5d1ab5ab84777219;hpb=1e20780ee1505fac6c7ed68d340892c497524561;p=talweg.git diff --git a/pkg/tests/testthat/test.dateIndexToInteger.R b/pkg/tests/testthat/test.dateIndexToInteger.R index fb4c8e4..7f09847 100644 --- a/pkg/tests/testthat/test.dateIndexToInteger.R +++ b/pkg/tests/testthat/test.dateIndexToInteger.R @@ -1,69 +1,33 @@ -context("Check that getParamsDirs behaves as expected") +context("Check that dateIndexToInteger behaves as expected") -test_that("on input of sufficient size, beta is estimated accurately enough", { - n = 100000 - d = 2 - K = 2 - Pr = c(0.5, 0.5) +getDataTest = function(n, shift) +{ + n = 1500 + series = list() + s = rep(0, 24) - betas_ref = array( c(1,0,0,1 , 1,-2,3,1), dim=c(2,2,2) ) - for (i in 1:(dim(betas_ref)[3])) + for (i in seq_len(n)) { - beta_ref = betas_ref[,,i] - #all parameters are supposed to be of norm 1: thus, normalize beta_ref - norm2 = sqrt(colSums(beta_ref^2)) - beta_ref = beta_ref / norm2[col(beta_ref)] - - io = generateSampleIO(n, d, K, Pr, beta_ref) - beta = getParamsDirs(io$X, io$Y, K) - betas = .labelSwitchingAlign( - array( c(beta_ref,beta), dim=c(d,K,2) ), compare_to="first", ls_mode="exact") - - #Some traces: 0 is not well estimated, but others are OK - cat("\n\nReference parameter matrix:\n") - print(beta_ref) - cat("Estimated parameter matrix:\n") - print(betas[,,2]) - cat("Difference norm (Matrix norm ||.||_1, max. abs. sum on a column)\n") - diff_norm = norm(beta_ref - betas[,,2]) - cat(diff_norm,"\n") - - #NOTE: 0.5 is loose threshold, but values around 0.3 are expected... - expect_that( diff_norm, is_less_than(0.5) ) + level = i %% 3mean(s[[index]]) + serie = s + # 10 series with NAs for index 2 + if (index == 2 && i >= 60 && i<= 90) + serie[sample(seq_len(L),1)] = NA + series[[i]] = list("level"=i%%3, "serie"=s, "time"=) } + data = new("Data", data=series) +} + +test_that("integer index matches date in data, predict_at == 0", +{ + data = getData( + dateIndexToInteger = function(index, data) }) -dateIndexToInteger = function(index, data) + +test_that("integer index matches date in data, predict_at > 0", { - index = index[1] - if (is.numeric(index)) - index = as.integer(index) - if (is.integer(index)) - return (index) - if (inherits(index, "Date") || is.character(index)) - { - tryCatch(dt <- as.POSIXct(index), error=function(e) stop("Unrecognized index format")) - #TODO: tz arg to difftime ? - integerIndex <- round( (as.numeric( difftime(dt, data$getTime(1)) ))[1] ) + 1 - if (integerIndex > 0 && integerIndex <= data$getSize()) - { - #WARNING: if series start at date >0h, result must be shifted - date1 = as.POSIXlt(data$getTime(1)[1]) - date2 = as.POSIXlt(data$getTime(2)[1]) - shift = (date1$year==date2$year && date1$mon==date2$mon && date1$mday==date2$mday) - return (integerIndex + ifelse(shift,1,0)) - } - stop("Date outside data range") - } - stop("Unrecognized index format") -} -#' @title integerIndexToDate -#' -#' @description Transform an integer index to date index (relative to data) -#' -#' @param index Date (or integer) index -#' @param data Object of class \code{Data} -#' -#' @export -integerIndexToDate = function(index, data) + + + ####TODO: CSV as raw data in inst/extdata http://r-pkgs.had.co.nz/data.html