tests/FAfitStats.R

In tsfa: Time Series Factor Analysis

require("tsfa") 

fuzz <- 1e-4 
all.ok <- TRUE  

if (require("CDNmoney")) {

data("CanadianMoneyData.asof.28Jan2005", package="CDNmoney")
data("CanadianCreditData.asof.28Jan2005", package="CDNmoney")

### Construct data

cpi <- 100 * M1total / M1real
seriesNames(cpi) <- "CPI"
popm <- M1total / M1PerCapita
seriesNames(popm) <- "Population of Canada"


z <- tframed(tbind(
    MB2001,
    MB486 + MB452 + MB453 ,
    NonbankCheq,
    MB472 + MB473 + MB487p,
    MB475,
    NonbankNonCheq + MB454 + NonbankTerm + MB2046 + MB2047 + MB2048 +
    MB2057 + MB2058 + MB482),
    names=c("currency", "personal cheq.", "NonbankCheq",
    "N-P demand & notice", "N-P term", "Investment" )
  )


TotalMoney <- tframed(rowSums(z), tframe(z))

z <- tbind (z, ConsumerCredit, ResidentialMortgage,
    ShortTermBusinessCredit, OtherBusinessCredit)

z <-tfwindow(z, start=c(1981,11), end=c(2004,11))

scale <- tfwindow(1e8 /(popm * cpi), tf=tframe(z))

MBandCredit <- sweep(z, 1, scale, "*")

z <- FAfitStats(MBandCredit)

tst <- t(matrix(c( 
   7.21546447992730009e+02, 2.51588683930033227e+02, 1.26266038761697843e+02, 3.78859600450730412e+01,  17.8434818767472727075,   8.5095232288266622334,   1.216817622086157513,   0.000000000000000000,
   4.50000000000000000e+01, 3.50000000000000000e+01, 2.60000000000000000e+01, 1.80000000000000000e+01,  11.0000000000000000000,   5.0000000000000000000,   0.000000000000000000,   0.000000000000000000,
  8.87632543046971553e-123, 1.38179840630406642e-34, 3.92712785335727602e-15, 4.01016034978447702e-03,   0.0852841654918015252,   0.1303008167098467229,		   NaN ,		     NA,
   6.76546447992730009e+02, 2.16588683930033227e+02, 1.00266038761697843e+02, 1.98859600450730412e+01,   6.8434818767472727075,   3.5095232288266622334,   1.216817622086157513,   0.000000000000000000,
   2.33393099314843172e-01, 1.49737065593769536e-01, 1.18204963636601337e-01, 6.32677642482300240e-02,   0.0474774819267114179,   0.0504294831870412338,   		  -Inf ,		     NA,
   0.00000000000000000e+00, 6.79861324270287781e-01, 8.51797257883504133e-01, 9.70606659595843801e-01,   0.9898846828668579345,   0.9948125908587072130,   0.998201427816676312,   1.000000000000000000,
   0.00000000000000000e+00, 6.79861324270287781e-01, 8.51797257883504133e-01, 9.70606659595843801e-01,   0.9898846828668579345,   0.9948125908587072130,   0.998201427816676312,		     NA,
   2.93573389027976361e-01, 6.75453606470459600e-01, 8.33900344668373261e-01, 9.64615898099617119e-01,   0.9876789216920541792,   0.9936623363124368336,   0.997798048110582037,		     NA,
   5.83830405565981203e-01, 8.32936895267106236e-01, 9.13218363115564480e-01, 9.74592322488365470e-01,   0.9881233267331279713,   0.9940646352079134385,   0.999135092994732910,   1.000000000000000000,
   4.91348273469532582e-01, 7.37472263991166943e-01, 8.16423460436771053e-01, 9.22365429825561134e-01,   0.9406166336656398563,   0.9347109872870478231,		  -Inf ,   1.000000000000000000,
   6.31546447992730009e+02, 1.81588683930033227e+02, 7.42660387616978426e+01, 1.88596004507304116e+00,  -4.1565181232527272925,  -1.4904767711733377666,   1.216817622086157513,   0.000000000000000000,
   7.87750456649901480e+02, 3.83996701244376254e+02, 3.18257663867495182e+02, 2.82840792076607556e+02, 309.1411199683018367068, 339.5295665146841201931, 365.338865236529386493, 364.122047614443204111,
   7.77750456649901480e+02, 3.63996701244376254e+02, 2.89257663867495182e+02, 2.45840792076607556e+02, 265.1411199683018367068, 289.5295665146841201931, 310.338865236529386493, 309.122047614443204111,
   2.68676249272728285e+00, 1.05648073887693195e+00, 6.67630575223542855e-01, 4.05383913206786350e-01,   0.3834908763650263785,   0.3931504464812560218,   0.402959484137993318,   0.398550724637681153,
   2.68977042272454803e+00, 1.06249659887146297e+00, 6.76353572215612875e-01, 4.16513254196668792e-01,   0.3967257683529946122,   0.4081900964675836407,   0.419503099122953693,   0.415094339622641528
   ), 8, 15)) 

cat(" printing all statistics.\n")
print(z$fitStats, digits=18)
print(dim(z$fitStats))


# omit NaN, Inf,   and saturated model in next
# if( fuzz < max(abs(c(z$fitStats[,-8] - tst)[-c(117, 122, 123, 128)] ))) { 
 if( fuzz < max(abs(c(z$fitStats - tst)[-c(93, 95, 100, 108, 110,112,113)] ))) { 
    cat("Calculated value is not the same as test value. Value:\n")
    printTestValue(z$fitStats, digits=18)
    cat("difference:\n")
    print(z$fitStats - tst, digits=18)
    all.ok <- FALSE  
    } 


tst <- t(matrix(c(
      4.699578e+02, 1.253226e+02, 8.838008e+01, 20.042478168, 9.3339586, 7.2927056, 1.21681762208615751,
      1.000000e+01, 9.000000e+00, 8.000000e+00,  7.000000000, 6.0000000, 5.0000000, 0,
      1.151586e-94, 1.083752e-22, 9.911368e-16,  0.005478658, 0.1556492, 0.1997656, NA
      ), 7, 3))

#printTestValue(z$seqfitStats, digits=18)
 # omit NA
 if( fuzz < max(abs(z$seqfitStats - tst )[-21])) {
    cat("Calculated value is not the same as test value. Value:\n")
    printTestValue(z$seqfitStats, digits=18)
    cat("difference:\n")
    print(z$seqfitStats - tst, digits=18)
    all.ok <- FALSE  
    } 


# tst <- t(matrix(c(
#       1, 0.6072931, 0.4316338, 0.33011553, 0.02243160, 0.04080963, 0.0001000,
#       1, 0.8704139, 0.8483230, 0.04560729, 0.22813562, 0.34747366, 0.3331834,
#       1, 0.9172717, 0.8256362, 0.79526575, 0.75436665, 0.73664238, 0.7063843,
#       1, 0.5629100, 0.2736706, 0.31302849, 0.43049438, 0.43965433, 0.3335216,
#       1, 0.9392737, 0.8637680, 0.79964034, 0.78316789, 0.00010000, 0.6305054,
#       1, 0.8561037, 0.7494143, 0.70235381, 0.65406616, 0.57832389, 0.0001000,
#       1, 0.5673231, 0.4933977, 0.50077506, 0.23724833, 0.00010000, 0.3697925,
#       1, 0.4740110, 0.4807669, 0.46028538, 0.46866983, 0.47706269, 0.4221650,
#       1, 0.9712291, 0.8902485, 0.89431646, 0.91112706, 0.91223959, 0.8436464,
#       1, 0.5737111, 0.5277170, 0.47626084, 0.42763254, 0.41444074, 0.4591905,
#      ), 7, 10))

#  if( fuzz < max(abs(z$OmegaTot - tst ))) {
#     cat("Calculated value is not the same as test value. Value:\n")
#     printTestValue(z$OmegaTot, digits=18)
#     cat("difference:\n")
#     print(z$OmegaTot - tst, digits=18)
#     all.ok <- FALSE  
#    } 


cat("tests completed.\n")
if (! all.ok) stop("some tests FAILED")
} else cat("CDNmoney data not available. Tests skipped.\n")