inst/slowTests/crvB01.R

In curve: Dynamic Systems Estimation - Curvature Extensions

# Tests of DSE curvature functions (previously dsecurvature.function.testsB )

# comparison values come only from a previous run of the 
#  code (theoretical values would be nice)...
# Test values have been changed with change to toARMA in 2001.2 which
# eliminates near zero parameter values using fixConstants. The result is
# much more stable and believable curvature results. The span results do not
# change much (as would be hoped) but do change more than the tolerance of 
# these tests. Old values in comments are  strictly for historical reference.

if(!require("dse"))  stop("this test requires dse.")
if(!require("curve"))stop("this test requires curve.")
 Sys.info()
 DSEversion()

fuzz.small <- 1e-12
digits <- 18
all.ok <- T  

 data("eg1.DSE.data.diff", package="dse")  

# data size affects memory constraints
  data <- eg1.DSE.data.diff
   inputData(data) <- NULL
  outputData(data) <- outputData(data)[1:50,1:2]

  VARmodel <- estVARXls(data, re.add.means=FALSE)
  SSmodel  <- l(toSS(VARmodel),  data)
  ARMAmodel<- l(toARMA(SSmodel), data)


cat("DSE curvature test B 1 ...")

  spanVAR <- span(VARmodel)  
  good <- c(0.114449869113756347, 0.114449869113496860, 0.073392835320007246,
      0.073392835319901109, 0.066734407677220553, 0.066734407677178142,
      0.066614701447440999, 0.066614701447334335, 0.063011563098793522,
      0.063011563098589879, 0.059329122705575062, 0.059329122705415301,
      0.056826595787831717, 0.056826595787806411, 0.046204330863178059,
      0.046204330863014273, 0.040188560079512797, 0.040188560079447523,
      0.034056955674954058, 0.034056955674626722, 0.028893589372264245,
      0.028893589372176717, 0.025983005223889789, 0.025983005223849501  )

   tst  <- spanVAR
   error <- max(abs(good - tst))
   cat("max. error ", error)

   if (any(is.na(error)) || any(is.nan(error)) || fuzz.small < error) 
     {printTestValue(c(tst), digits=18)
      all.ok <- F  
     }


cat("DSE curvature test B 2 ...")
 spanSS <- span(SSmodel)
  good <- c(  
       0.10274860855471462662, 0.10274860855462775167, 0.06007019888802080099
     , 0.06007019888791977069, 0.06001503393765705852, 0.06001503393755355797
     , 0.05967088443568880490, 0.05967088443514689811, 0.05668932601611959693
     , 0.05668932601604840388, 0.05452098535006656699, 0.05452098534998019858
     , 0.05124584470731020913, 0.05124584470707382877, 0.05113559933370873806
     , 0.05113559933361908061, 0.04955894474981626524, 0.04955894474939047389
     , 0.04729297332666777126, 0.04729297332610608862, 0.04671869698239693863
     , 0.04671869698201638194, 0.04454781954178882453, 0.04454781954164353103
     , 0.04048455062849974639, 0.04048455062837719859, 0.02942866622217246361
     , 0.02942866622200048313, 0.01693320051034891832, 0.01693320051021537237
     , 0.01308641053414394059, 0.01308641053403496353, 0.01181519516958567939
     , 0.01181519516908161559, 0.00541747854002755207, 0.00541747853967942689
     , 0.00529351434412992337, 0.00529351434394933953, 0.00491893097942279044
     , 0.00491893097926101534, 0.00342671831624704161, 0.00342671831567546801
     , 0.00227476744198765396, 0.00227476744187563897, 0.00012162189247796396
     , 0.00012162189207734090, 0.00003274568362696781, 0.00003274568361473657)

    
   tst  <- spanSS
   error <- max(abs(good - tst))
   cat("max. error ", error)

   if (any(is.na(error)) || any(is.nan(error)) || fuzz.small < error) 
     {printTestValue(c(tst), digits=18)
      all.ok <- F  
     }


cat("DSE curvature test B 3 ...")
 
#  if (is.R()) good <-
#  c(4.9049410781519936e-01, 1.2425030501882078e-01, 1.1246172533887255e-01,
#    1.0529465638718155e-01, 9.9992325730457826e-02, 9.3539845628889493e-02,
#    9.2174599397343862e-02, 8.9496247916628913e-02, 8.4586129130414314e-02,
#    8.0765436606922522e-02, 7.8623725634452205e-02, 7.4094697970647883e-02,
#    6.8118147328717266e-02, 6.6571019509098564e-02, 6.5347673219782007e-02,
#    6.2868363407609373e-02, 6.0029353951002326e-02, 5.8265043911548742e-02,
#    5.7428063879464482e-02, 5.5270247854539004e-02, 5.3574863616695417e-02,
#    4.9500699356060406e-02, 4.7721177486595059e-02, 4.5675211105535969e-02,
#    4.5187209000554139e-02, 4.4123164386888028e-02, 4.2609744901397094e-02,
#    4.0728262066476652e-02, 3.8500749322484873e-02, 3.6752466902023120e-02,
#    3.6020724107593854e-02, 3.4123385578064033e-02, 3.3321675360527339e-02,
#    2.9526045053003675e-02, 2.4664231456454182e-02, 2.4535892553740390e-02,
#    1.9011587409302790e-02, 1.0185539990175529e-02, 7.9577476414227771e-03,
#    4.4117567759992945e-03, 3.5579116575524851e-03, 2.5973873441597017e-03,
#    2.3124010577862367e-03, 1.6333230757236616e-03, 1.3482756318466882e-03,
#    4.0276257101139824e-04, 9.1217773859851665e-05, 8.4773331050698041e-05,
#    7.5783716183056057e-09, 4.5904401626724121e-10, 1.1070461766649269e-17,
#    9.4242715041701337e-18, 8.2559055659668990e-18, 7.6624154284980461e-18,
#    6.8081425995733192e-18, 4.0398710160059630e-18, 6.6123246315825315e-19,
#    3.8189436573397887e-19, 1.5940242413042422e-19, 9.4133611638589657e-20,
#    7.4869852566030682e-20, 6.0095202032585055e-34, 4.7037657003150257e-34,
#    3.5938593583744286e-34, 2.8591054742395741e-35, 0.0000000000000000e+00,
#    0.0000000000000000e+00, 0.0000000000000000e+00, 0.0000000000000000e+00,
#    0.0000000000000000e+00, 0.0000000000000000e+00 )
#
#  if (is.Splus()) good <-
#    c(1.0034047190656252e+00, 4.8850479622289339e-01, 1.2408559806984479e-01,
#     ,1.1241084023931164e-01, 1.0524964938676544e-01, 9.5268480653867810e-02,
#     ,9.2759311159151175e-02, 9.1819598877975070e-02, 8.9050273189422796e-02,
#     ,8.3629646994090756e-02, 8.0627890823442142e-02, 7.7853771461977417e-02,
#     ,7.3417058329559359e-02, 6.8115229181312409e-02, 6.6487574775202618e-02,
#     ,6.5268877320737190e-02, 6.2804879512010081e-02, 5.9798663205619551e-02,
#     ,5.8138919962726084e-02, 5.7002371757449002e-02, 5.4146518855642631e-02,
#     ,5.2602825342313142e-02, 4.9441695936262117e-02, 4.7269740278206025e-02,
#     ,4.5517604797007144e-02, 4.5143602143697413e-02, 4.3842221290001454e-02,
#     ,4.0984110441742688e-02, 3.9989100730095282e-02, 3.8350089480969470e-02,
#     ,3.6071732859165054e-02, 3.5742661867439247e-02, 3.3945300390401167e-02,
#     ,3.3080230063434836e-02, 2.8791495436511692e-02, 2.4595520370852313e-02,
#     ,2.2520600570674183e-02, 1.8727379899113081e-02, 9.8908734880565584e-03,
#     ,7.7946301146879322e-03, 4.3757311212158376e-03, 3.5514904518346609e-03,
#     ,2.5730688907734350e-03, 2.2937687921734265e-03, 1.6334339201785643e-03,
#     ,1.3490766143686318e-03, 5.2025361050217576e-04, 3.9749496568613595e-04,
#     ,8.7754565756829609e-05, 8.4768386053768149e-05, 1.9920899452363507e-09,
#     ,1.3537769691006131e-17, 1.2204712468141044e-17, 8.9797330692404288e-18,
#     ,7.7118704229531706e-18, 6.6347042930705941e-18, 5.6925127578653899e-18,
#     ,1.7886910482621617e-18, 1.1187688280849653e-18, 2.2384834985967148e-19,
#     ,1.7676728214211909e-19, 1.4038899180867549e-19, 8.0812882075936788e-20,
#     ,9.2192393808022497e-34, 6.6365234946111944e-34, 4.2858059029140618e-34,
#     ,0.0000000000000000e+00, 0.0000000000000000e+00, 0.0000000000000000e+00,
#     ,0.0000000000000000e+00, 0.0000000000000000e+00, 0.0000000000000000e+00 )
#
## around R 1.1.1 and before 2001.2 change to toARMA.SS
#  good <- c(
#    0.490494752810582801,  0.124254301561514971,  0.112464007925927312,
#    0.105296151523361983,  0.0999930106260916302,  0.0935415658736187122,
#    0.0921756236732814843,  0.0894980196142749346,  0.084587879405886357,
#    0.080767820977991206,  0.0786269091436579692,  0.0740982050811652415,
#    0.0681193916577149394,  0.0665714610141954349,  0.0653501433331552389,
#    0.0628846530224142358,  0.0600354127079369554,  0.0582708846001192896,
#    0.0574305754952406169,  0.0552710746500495523,  0.053574894712188792,
#    0.0495021303437292587,  0.0477217132651450854,  0.0456814513508665004,
#    0.0451878212803662471,  0.0441241488416704852,  0.042609890004122658,
#    0.0407357969126947092,  0.0385011094551413538,  0.0367546517958144414,
#    0.0360356097631223324,  0.0341237444130534223,  0.033322353549055661,
#    0.029531589165205166,  0.024682000709630933,  0.0245390284959757336,
#    0.0190136770995758299,  0.010294991264683126,  0.00801491074106989478,
#    0.0045410856260552435,  0.00357647859566593597,  0.00308220555140791344,
#    0.00296860623932166312,  0.00248906796146492609,  0.00213323534758624389,
#    0.00157837322687163963,  0.00126529950976378707,  0.000400334715145694473,
#    9.06116047208433366e-05,  8.46747193312290318e-05,  5.63955802833271451e-06,
#    7.06607834857295999e-07,  1.02427642235884008e-17,  8.2945253576028173e-18,
#    7.73322892221025617e-18,  5.87799494460792363e-18,  5.34659049636090042e-18,
#    2.16262032052361535e-18,  1.36681894882810078e-18,  2.42341824448017461e-19,
#    2.37700839985245846e-19,  1.85660348662921073e-19,  1.83180499055525642e-19,
#    6.63065315055060987e-34,  6.02668158348751715e-34,  3.59344821900416301e-34,
#    0,                    0,                    0,                    0, 0)

   good <- c(
    0.490494107819567371,  0.12425030501911917,  0.112461725336494442, 0.105294656386401966,  0.099992325730318507,  0.0935398456283732527, 0.0921745993982908129,  0.0894962479176689418,  0.0845861291252023167, 0.0807654366058858791,  0.0786237256345985736,  0.0740946979699281111, 0.0681181473293573786,  0.0665710195078176858,  0.0653476732203984167, 0.0628683634124407864, 0.0600293539506179738,  0.0582650439123211517, 0.0574280638768044777,  0.0552702478553844662,  0.0535748636170760156, 0.0495006993550919025,  0.047721177488980214,  0.0456752111048667614, 0.045187208999477993,  0.0441231643866707018, 0.0426097449017576804, 0.0407282620671449158,  0.0385007493229689718,  0.036752466902063026,  0.0360207241092802694,  0.034123385578951608,  0.0333216753576572253, 0.0295260450516676258,  0.0246642314548293322,  0.0245358925542320631, 0.0190115874106292736,  0.0101855399897878788,  0.00795774764138049498, 0.00441175677657453663,  0.00355791165737318147,  0.00259738734426823159, 0.00231240105724756341,  0.0016333230756505931,  0.00134827563181366423,  0.000402762570357753408,  9.12177732878151197e-05,  8.47733303574318227e-05  
#   0.490494107835221516,  0.124250305018532139, 0.112461725339340859, 0.105294656385664667,  0.0999923257310130209, 0.0935398456323032756, 0.0921745993985452899,  0.0894962479182199594,  0.0845861291306833907, 0.0807654366069557594,  0.0786237256355992037,  0.0740946979691021745, 0.0681181473286356087,  0.0665710195081865852,  0.0653476732202404598, 0.0628683634163098304, 0.0600293539506994295,  0.0582650439124260192, 0.0574280638764810974,  0.0552702478549601944,  0.0535748636163666178, 0.0495006993550450997,  0.0477211774866077229, 0.0456752111049421178, 0.0451872090034353968, 0.044123164385675602,  0.0426097449005022194, 0.0407282620660855826,  0.0385007493228021469,  0.0367524669029856837, 0.0360207241107553672,  0.0341233855773758893, 0.0333216753602064153, 0.0295260450528873862,  0.0246642314559944141,  0.0245358925533431735,  0.019011587409945515,  0.0101855399895906563,  0.00795774764113637255, 0.00441175677671917354,  0.00355791165835129966,  0.00259738734439689516, 0.00231240106076091101,  0.00163332307607502031, 0.00134827563186037296,  0.000402762571136752723,  9.12177736295678552e-05,  8.47733310294386793e-05 # Ubuntu, R-2.15.0, 32 bit new BLAS, April, 2012
  )  

   tst  <-  spanARMA <- span(ARMAmodel)
   error <- max(abs(good - tst))
   cat("max. error ",error)

#changed this from 15*fuzz.small to 20*fuzz.small for Ubuntu, R-2.15.0, 32bit, new BLAS, April, 2012
   if (any(is.na(error)) || any(is.nan(error)) || 20*fuzz.small < error) 
     {cat("fuzz.small:", fuzz.small, " error:", error, "\n")
      printTestValue(c(tst), digits=18)
      all.ok <- F  
     }

  if (! all.ok) stop("some tests FAILED")