tests/testthat/test-bezier.R

In corset: Arbitrary Bounding of Series and Time Series Objects

# file corset/tests/testthat/test-bezier.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 Partial Bezier method - Default functionality')

test_that("Corset - class integer", {
  x <- (10:-10) * 1000 + 900
  cx <- corset(x, 'bezier')
  #plot(x, ylim = c(-2000,2000));points(cx, col = 'red');abline(h=0)
  expect_equal(cx, structure(
    c(
      10900,
      9900.00000007557,
      8900.00013318376,
      7900.00942515128,
      6900.17527289219,
      5901.5470523811,
      4908.44164218709,
      3932.7991060351,
      2998.75458831863,
      2143.42276607584,
      1410.27393341064,
      835.558123716945,
      433.720226866372,
      190.251586701415,
      67.0376845734304,
      17.572955128162,
      3.01768988067312,
      0.267738415328761,
      0.00720697194150919,
      1.07663847305169e-05,
      0
    ),
    class = c("numeric", "corset")
  ))
})

test_that("Corset - class numerical", {
  x <- (10:-10) * 1000 + 900.5
  cx <- corset(x, 'bezier')
  #plot(x, ylim = c(-2000,2000));points(cx, col = 'red');abline(h=0)
  expect_equal(cx, structure(
    c(
      10900.5,
      9900.50000007531,
      8900.50013282933,
      7900.5094058349,
      6900.67499118534,
      5902.04508131027,
      4908.93306977887,
      3933.27252272791,
      2999.19082769556,
      2143.79812139593,
      1410.56798267365,
      835.762443124609,
      433.842558264714,
      190.312476994603,
      67.0616655220961,
      17.5798873366339,
      3.01898729437346,
      0.267862606323573,
      0.00721054739351973,
      1.07720550895473e-05,
      0
    ),
    class = c("numeric", "corset")
  ))
})

test_that("Corset - class ts", {
  x <- ts((10:-10) * 1000 + 900.5)
  cx <- corset(x, 'bezier')
  #plot(x, ylim = c(-2000,2000));lines(cx, col = 'red');abline(h=0)
  expect_equal(cx, structure(
    c(
      10900.5,
      9900.50000007531,
      8900.50013282933,
      7900.5094058349,
      6900.67499118534,
      5902.04508131027,
      4908.93306977887,
      3933.27252272791,
      2999.19082769556,
      2143.79812139593,
      1410.56798267365,
      835.762443124609,
      433.842558264714,
      190.312476994603,
      67.0616655220961,
      17.5798873366339,
      3.01898729437346,
      0.267862606323573,
      0.00721054739351973,
      1.07720550895473e-05,
      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, 'bezier')
    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, 'bezier')
  expect_equal(cx, structure(
    list(
      bts = structure(
        c(
          3.80515800186062,
          2.66996675440457,
          1.64601324968342,
          0.864152651943784,
          0.370660223314166,
          0.12098227038375,
          0.0261780272598394,
          0.00273824728401341,
          5.01079348960876e-05,
          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.20088700981897,
          1.25811185523255,
          0.594059725254644,
          0.221312450756648,
          0.059960514225786,
          0.0100663824045864,
          0.000724759292237971,
          6.83776460170098e-06,
          0,
          5.30728795135891,
          4.42653859168677,
          3.54635425900036,
          2.67302379748065,
          1.83193309462167,
          1.07949126101059,
          0.495294444070853,
          0.14319111445892,
          0.0136170500840911,
          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, 'bezier')
  expect_equal(cx,
               structure(
                 c(
                   0,
                   0.183643324222082,
                   0.406324908596249,
                   1.59528080213779,
                   0.524879035976907,
                   0.459419447612894,
                   0.487429052428485,
                   0.738324705129217,
                   0.575781351653492,
                   0,
                   1.51178116845085,
                   0.687674018218684,
                   0.360850956619705,
                   0.323082890517881,
                   1.12493091814311,
                   0.380572138873008,
                   0.448191742072224,
                   0.943836210685299,
                   0.821221195098089,
                   0.593901321217509,
                   0.918977371608218,
                   0.782136300731067,
                   0.38224081886771,
                   0.259904956133021,
                   0.61982574789471,
                   0.140534808033911,
                   0.0756637491727551,
                   0.0590980602249591,
                   0.14561771219714,
                   0.417941560199702,
                   1.35867955152904,
                   0.546246765720715,
                   0.387671611559369,
                   0.127145168363187,
                   0.0607687588966947,
                   0.0594504041189091,
                   0.151520999434904,
                   0.374349885190298,
                   1.10002537198388,
                   0.763175748457544,
                   0,
                   0.167503277081711,
                   0.696963375404737,
                   0.556663198673657,
                   0.271969244778273,
                   0.261080394093053,
                   0.36458196213683,
                   0.768532924515416,
                   0.475804073176413,
                   0.881107726454215,
                   0.398105880367068,
                   0.222304404264301,
                   0.341119691424425,
                   0.587126071369814,
                   1.43302370170104,
                   1.98039989850586,
                   0.621658361859357,
                   0.361802155811226,
                   0.569719627442413,
                   0,
                   2.40161776050478,
                   0.968277887243452,
                   0.689739362450777,
                   0.261904345313247,
                   0.196007467055641,
                   0.266850231229406,
                   0.462353389058745,
                   1.46555486156289,
                   0.153253338211898,
                   2.17261167036215,
                   0.475509528899663,
                   0.28413708010971,
                   0.610726353489055,
                   0.185273629068083,
                   0.134606149977445,
                   0.291446235517463,
                   0.0731548644618042,
                   0.0460956635550376,
                   0.0743413241516641,
                   0,
                   0,
                   0.236467718442192,
                   1.1780869965732,
                   0.468220006356377,
                   0.593946187628422,
                   0.332950371213518,
                   1.06309983727636,
                   0.388518324722054,
                   0.370018809916288,
                   0.267098790772231,
                   0,
                   1.20786780598317,
                   1.16040261569495,
                   0.700213649514998,
                   1.58683345454085,
                   0.606693390507465,
                   0.310433200318828,
                   0.0925549298407398,
                   0.00815056171076708,
                   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 Partial Bezier method - Arbitrary Boundaries')

test_that("Corset - class ts", {
  set.seed(5)
  x <- ts(rnorm(100, 0, 100))
  cx <- corset(x, 'bezier', -1:-100, 1:100)
  #plot(x); lines(cx, col = 'red')
  expect_equal(cx, structure(
    c(
      -1,
      0.116355561650003,
      0.446763772739703,
      0.175819736032893,-0.801898984746453,
      -1.91179744989519,
      -2.66386194768088,
      -3.04367880585556,-3.36899382262208,
      -3.96130290835408,
      -4.92242392902421,
      -6.0990315721542,-7.17675476627002,
      -7.81261584959876,
      -7.74386792458096,
      -6.85003725878387,-5.16897198062792,
      -2.87651648621779,
      -0.240983094437187,
      2.4360772673997,
      4.88055980231127,
      6.89564130179517,
      8.39053335500758,
      9.38253945115316,
      9.97315188164403,
      10.3054011077149,
      10.5144762817728,
      10.6853106589919,
      10.8286945711816,
      10.8819630384343,
      10.7329486284096,
      10.2589675928995,
      9.36836953009315,
      8.03201258134622,
      6.29589124015804,
      4.27258547030935,
      2.11590866790679,
      -0.0121660404779003,
      -1.97193544185891,
      -3.66561354017109,-5.04266487690025,
      -6.09243257030006,
      -6.82951243239837,
      -7.27869794428105,-7.4650603140028,
      -7.41163303047681,
      -7.14362408619008,
      -6.69548694655501,-6.11644339324667,
      -5.47125697907849,
      -4.8355078462602,
      -4.28716698176686,-3.89780446337383,
      -3.72668631270837,
      -3.81943717445594,
      -4.21062295113822,-4.92757298027625,
      -11.2609070203049,
      -6.40909282197963,
      23.3275293545762,-11.2808835535356,
      -13.5935006061775,
      -57.8370418961854,
      49.6361539030152,-20.1449011603232,
      -21.4062212246861,
      -21.7944061053414,
      -21.1349222963359,-19.3571337821455,
      -16.5200673165984,
      -12.8179499890403,
      -8.56169543105297,
      34.7028452022099,
      3.23678425979233,
      41.3531289671798,
      -15.5348476625379,
      8.27695105001458,
      9.25545854149017,
      9.55121171700127,
      -56.2885069825959,
      49.8416165001331,
      8.67921864379581,
      8.24498505721885,
      -2.40828727364371,
      67.5684475314084,
      -71.0309605053391,
      4.93379861007474,
      -47.3432012196463,-7.57725566667704,
      -52.1840056478283,
      13.3602788943686,
      20.4674734179506,
      27.7947583359108,
      32.2113196764886,
      29.7584850218978,
      17.7296481083232,-34.6583813698718,
      -54.0189250004419,
      -18.2555593266753,
      -5.92996499937566
    ),
    .Tsp = c(1, 100, 1),
    class = c("ts", "corset")
  ))
})