tests/testthat/test-exp.R

In corset: Arbitrary Bounding of Series and Time Series Objects

# file corset/tests/testthat/test-exp.R
# Copyright (C) 2016 Merck Sharp & Dohme Corp. a subsidiary of Merck & Co.
# , Inc., Kenilworth, NJ, USA.
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

context('Testing Exp method - Default functionality')

test_that("Corset - class integer", {
  x <- (10:-10) * 1000 + 900
  cx <- corset(x, 'exp')
  #plot(x, ylim = c(-2000,2000));points(cx, col = 'red');abline(h=0)
  expect_equal(cx, structure(
    c(
      10900,
      9900,
      8900,
      7900,
      6900,
      5900,
      4900,
      3900,
      2900,
      1900,
      900,
      450,
      225,
      112.5,
      56.25,
      28.125,
      14.0625,
      7.03125,
      3.515625,
      1.7578125,
      0
    ),
    class = c("numeric", "corset")
  ))
})

test_that("Corset - class numerical", {
  x <- (10:-10) * 1000 + 900.5
  cx <- corset(x, 'exp')
  #plot(x, ylim = c(-2000,2000));points(cx, col = 'red');abline(h=0)
  expect_equal(cx, structure(
    c(
      10900.5,
      9900.5,
      8900.5,
      7900.5,
      6900.5,
      5900.5,
      4900.5,
      3900.5,
      2900.5,
      1900.5,
      900.5,
      450.25,
      225.125,
      112.5625,
      56.28125,
      28.140625,
      14.0703125,
      7.03515625,
      3.517578125,
      1.7587890625,
      0
    ),
    class = c("numeric", "corset")
  ))
})

test_that("Corset - class ts", {
  set.seed(2)
  x <- ts((10:-10) * 1000 + 900.5)
  cx <- corset(x, 'exp')
  #plot(x, ylim = c(-2000,2000));lines(cx, col = 'red');abline(h=0)
  expect_equal(cx, structure(
    c(
      10900.5,
      9900.5,
      8900.5,
      7900.5,
      6900.5,
      5900.5,
      4900.5,
      3900.5,
      2900.5,
      1900.5,
      900.5,
      450.25,
      225.125,
      112.5625,
      56.28125,
      28.140625,
      14.0703125,
      7.03515625,
      3.517578125,
      1.7587890625,
      0
    ),
    .Tsp = c(1, 21, 1),
    class = c("ts", "corset")
  ))
})

test_that("Corset - class forecast ", {
  skip_on_cran()
  if ('forecast' %in% installed.packages()) {
  set.seed(0)
  rx <- rnorm(100, 0.5)
  x <- forecast::forecast(rx)
  cx <- corset(x, 'exp')
  expect_equal(x$mean, cx$mean)
  expect_equal(x$upper, cx$upper)
  expect_lt(as.numeric(cx$lower[1, 1]) - 0.180944603717663, 10^-10)
  expect_equal(as.numeric(cx$lower[1, 2]), 0)
  }
})

test_that("Corset - class gts/hts ", {
  if ('hts' %in% installed.packages()) {
  set.seed(6)
  rh <- ts(replicate(5, rnorm(10) + 15:6))
  htseg <- hts::hts(rh, nodes = list(1, 5))  

  x <-
    hts::forecast.gts(htseg,
                      h = 10,
                      method = "bu",
                      fmethod = "arima")
  cx <- corset(x, 'exp')
  expect_equal(cx, structure(
    list(
      bts = structure(
        c(
          3.80515800186062,
          2.65871320384245,
          1.51226840582428,
          0.365823607806099,
          0.18291180390305,
          0.0914559019515249,
          0.0457279509757624,
          0.0228639754878812,
          0.0114319877439406,
          0,
          8.2074129608038,
          8.2074129608038,
          8.2074129608038,
          8.2074129608038,
          8.2074129608038,
          8.2074129608038,
          8.2074129608038,
          8.2074129608038,
          8.2074129608038,
          8.2074129608038,
          5.43966764122182,
          5.43966764122182,
          5.43966764122182,
          5.43966764122182,
          5.43966764122182,
          5.43966764122182,
          5.43966764122182,
          5.43966764122182,
          5.43966764122182,
          5.43966764122182,
          3.28817121759491,
          2.18413427773055,
          1.08009733786618,
          0.540048668933091,
          0.270024334466545,
          0.135012167233273,
          0.0675060836166363,
          0.0337530418083182,
          0.0168765209041591,
          0,
          5.30728795135891,
          4.42653315926531,
          3.54577836717171,
          2.66502357507811,
          1.78426878298451,
          0.903513990890909,
          0.0227591987973099,
          0.011379599398655,
          0.00568979969932748,
          0
        ),
        .Dim = c(10L, 5L),
        .Dimnames = list(
          NULL,
          c("Series 1", "Series 2", "Series 3", "Series 4", "Series 5")
        ),
        .Tsp = c(11, 20, 1),
        class = c("mts", "ts", "matrix", if(getRversion() >= "4.3.0") "array")
      ),
      histy = structure(
        c(
          15.2696059820375,
          13.3700145859607,
          13.8686598276523,
          13.7271955171152,
          11.0241876417677,
          10.3680251769925,
          7.69079570179147,
          8.73862193071141,
          7.04487298737499,
          4.9516027998788,
          16.7278510904457,
          12.8214002609775,
          13.6532067110969,
          11.6314335082964,
          10.4004453564552,
          10.0546051654574,
          10.7076774254494,
          6.90562702442171,
          6.71071817550361,
          8.2074129608038,
          15.5187490065016,
          12.5950820641597,
          15.0148644801591,
          10.8118416629749,
          11.1903808075881,
          8.83026408994545,
          8.96191844055564,
          10.3542042609769,
          8.39342625937317,
          5.43966764122182,
          14.3285406164292,
          14.4924385547309,
          11.8206094838239,
          10.9412825480884,
          12.1379026130001,
          9.83973471509903,
          9.63049312664994,
          9.61695970239454,
          6.80650017148123,
          4.39220815745928,
          14.114835872298,
          13.5676657010407,
          12.578376140606,
          11.8295059368048,
          11.2458109372263,
          9.25425221514964,
          8.7260558667396,
          9.82457894065461,
          7.0142337398516,
          6.1880427434525
        ),
        .Dim = c(10L,
                 5L),
        .Dimnames = list(
          NULL,
          c("Series 1", "Series 2", "Series 3",
            "Series 4", "Series 5")
        ),
        .Tsp = c(1, 10, 1),
        class = c("mts", "ts", "matrix", if(getRversion() >= "4.3.0") "array")
      ),
      labels = structure(
        list(
          `Level 0` = "Total",
          `Level 1` = "A",
          `Level 2` = c("Series 1", "Series 2",
                        "Series 3", "Series 4", "Series 5")
        ),
        .Names = c("Level 0",
                   "Level 1", "Level 2")
      ),
      method = "bu",
      fmethod = "arima",
      nodes = structure(list(
        `Level 1` = 1, `Level 2` = 5
      ), .Names = c("Level 1",
                    "Level 2"))
    ),
    .Names = c("bts", "histy", "labels", "method",
               "fmethod", "nodes"),
    class = c("hts", "gts", "corset")
  ))
}
})

test_that("Corset - class mts / ts / matrix ", {
  set.seed(1)
  x <- ts(replicate(10, rnorm(10)))
  cx <- corset(x, 'exp')
  expect_equal(cx,
               structure(
                 c(
                   0,
                   0.183643324222082,
                   0.889462063179937,
                   1.59528080213779,
                   0.329507771815361,
                   0.408468412121923,
                   0.487429052428485,
                   0.738324705129217,
                   0.575781351653492,
                   0,
                   1.51178116845085,
                   0.389843236411431,
                   0.194921618205716,
                   0.659926268174412,
                   1.12493091814311,
                   0.562465459071554,
                   0.753150834878427,
                   0.943836210685299,
                   0.821221195098089,
                   0.593901321217509,
                   0.918977371608218,
                   0.782136300731067,
                   0.0745649833651906,
                   0.34719536562995,
                   0.61982574789471,
                   0.309912873947355,
                   0.154956436973678,
                   0.0774782184868388,
                   0.247709889343271,
                   0.417941560199702,
                   1.35867955152904,
                   0.873175581544207,
                   0.387671611559369,
                   0.193835805779685,
                   0.0969179028898423,
                   0.0484589514449211,
                   0.0242294757224606,
                   0.562127423853172,
                   1.10002537198388,
                   0.763175748457544,
                   0,
                   0.348481687702369,
                   0.696963375404737,
                   0.556663198673657,
                   0.278331599336829,
                   0.321456780736829,
                   0.36458196213683,
                   0.768532924515416,
                   0.824820325484815,
                   0.881107726454215,
                   0.398105880367068,
                   0.369612785895746,
                   0.341119691424425,
                   0.887071696562731,
                   1.43302370170104,
                   1.98039989850586,
                   0.99019994925293,
                   0.779959788347671,
                   0.569719627442413,
                   0,
                   2.40161776050478,
                   1.54567856147778,
                   0.689739362450777,
                   0.0280021587806661,
                   0.108397229147504,
                   0.188792299514343,
                   0.827173580538614,
                   1.46555486156289,
                   0.153253338211898,
                   2.17261167036215,
                   0.475509528899663,
                   0.543117941194359,
                   0.610726353489055,
                   0.305363176744527,
                   0.298404706130995,
                   0.291446235517463,
                   0.146275793574543,
                   0.00110535163162413,
                   0.0743413241516641,
                   0,
                   0,
                   0.589043498286602,
                   1.1780869965732,
                   0.886016592100813,
                   0.593946187628422,
                   0.332950371213518,
                   1.06309983727636,
                   0.716559323596325,
                   0.370018809916288,
                   0.267098790772231,
                   0,
                   1.20786780598317,
                   1.16040261569495,
                   0.700213649514998,
                   1.58683345454085,
                   0.558486425565304,
                   0.279243212782652,
                   0.139621606391326,
                   0.069810803195663,
                   0
                 ),
                 .Dim = c(10L, 10L),
                 .Dimnames = list(
                   NULL,
                   c(
                     "Series 1",
                     "Series 2",
                     "Series 3",
                     "Series 4",
                     "Series 5",
                     "Series 6",
                     "Series 7",
                     "Series 8",
                     "Series 9",
                     "Series 10"
                   )
                 ),
                 .Tsp = c(1, 10, 1),
                 class = c("mts", "ts", "matrix", if(getRversion() >= "4.3.0") "array", "corset")
               ))
})


context('Testing Exp method - Arbitrary Boundaries')

test_that("Corset - class ts", {
  set.seed(5)
  x <- ts(rnorm(100, 0, 100))
  cx <- corset(x, 'exp', -1:-100, 1:100)
  #plot(x); lines(cx, col = 'red')
  expect_equal(cx, structure(
    c(
      -1,
      -2,
      1,
      2.5,
      -1.75,
      -3.875,
      -5.4375,
      -6.71875,
      1.640625,
      5.8203125,
      -3.08984375,
      -7.544921875,
      -10.2724609375,-12.13623046875,
      -13.0174222618673,
      -13.8986140549846,
      -15.4493070274923,
      1.77534648625386,
      -9.11232675687307,
      5.94383662156346,
      13.4719183107817,
      17.7359591553909,
      20.3679795776954,
      22.1839897888477,
      -1.90800510557614,
      12.5459974472119,
      19.772998723606,
      -4.61350063819702,
      -16.8067503190985,
      7.09662484045075,
      19.0483124202254,
      25.5241562101127,
      29.2620781050563,
      31.6310390525282,
      33.3155195262641,
      -1.84224023686796,
      -19.421120118434,-28.710560059217,
      -21.4856863273615,
      -14.260812595506,
      -28.130406297753,-17.7941491430101,
      -7.45789198826713,
      -26.2289459941336,
      9.88552700293322,-18.5572364985334,
      -32.2908470590256,
      -46.0244576195178,
      -26.4727866014645,-6.92111558341109,
      5.92574707995123,
      18.7726097433136,
      -17.6136951283432,-14.4168803159784,
      -11.2200655036137,
      22.8899672481932,
      5.81453011394414,-11.2609070203049,
      -6.40909282197963,
      23.3275293545762,
      42.6637646772881,-7.58663860944866,
      -57.8370418961854,
      49.6361539030152,
      7.74876343153615,-34.1386270399429,
      -32.1544275884162,
      -30.1702281368895,
      -29.0684195589062,-27.9666109809229,
      -20.4097320819576,
      -22.5614185517355,
      34.7028452022099,
      3.23678425979233,
      41.3531289671798,
      -15.5348476625379,
      -1.71291669259502,
      12.1090142773478,
      18.9173691477455,
      -56.2885069825959,
      49.8416165001331,
      66.4208082500666,
      32.0062604882114,
      -2.40828727364371,
      67.5684475314084,-71.0309605053391,
      -59.1870808624927,
      -47.3432012196463,
      -7.57725566667704,-52.1840056478283,
      -72.0920028239142,
      -8.19430809705911,
      55.7033866297959,
      90.0730584912171,
      64.2169336245925,
      38.3608087579678,
      -34.6583813698718,-54.0189250004419,
      -18.2555593266753,
      -5.92996499937566
    ),
    .Tsp = c(1,
             100, 1),
    class = c("ts", "corset")
  ))
})