Nothing
# 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")
))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.