Nothing
tests/testthat/test-arma_q0.R
In sarima: Simulation and Prediction with Seasonal ARIMA Models
## Do not edit this file manually.
## It has been automatically generated from *.org sources.
library(sarima)
test_that("comparisons of versions of arma_Q0", {
## This was giving a nasty error if running interactively, see below.
## It seems that the problem is that there are no expectations.
## adding the simple one velow resolved this.
## (keeping for now as a reminder)
##
## > devtools::test()
## Loading sarima
## Testing sarima
## v | OK F W S | Context
## Error in x[[method]](...) : attempt to apply non-function
## In addition: Warning message:
## `encoding` is deprecated; all files now assumed to be UTF-8
##
## == Results =====================================================================
## OK: 0
## Failed: 4
## Warnings: 0
## Skipped: 1
##
expect_equal(2 + 2, 4)
## TODO: consolidate the examples in the chunk in the Org file
## immeadiately after this one and put some here.
Q0bis <- arma_Q0bis(c(0.2, 0.5, 0.1), c(0.3))
Q0Gardner <- arma_Q0Gardner(c(0.2, 0.5, 0.1), c(0.3))
## Q0gnb <- sarima:::arma_Q0gnb(c(0.2, 0.5, 0.1), c(0.3))
Q0gnbR <- arma_Q0gnbR(c(0.2, 0.5, 0.1), c(0.3))
## Q0gnb0 <- sarima:::arma_Q0gnb0(c(0.2, 0.5, 0.1), c(0.3))
## rbenchmark::benchmark(sarima:::arma_Q0bis(c(0.2, 0.5, 0.1), c(0.3)) ,
## sarima:::arma_Q0Gardner(c(0.2, 0.5, 0.1), c(0.3)) ,
## sarima:::arma_Q0gnb(c(0.2, 0.5, 0.1), c(0.3)) ,
## sarima:::arma_Q0gnbR(c(0.2, 0.5, 0.1), c(0.3)) ,
## sarima:::arma_Q0gnb0(c(0.2, 0.5, 0.1), c(0.3)) ,
## sarima:::arma_Q0Gardner(c(0.2, 0.5, 0.1), c(0.3)) ,
## repetitions = 1000)
arma_Q0Gardner(c(0.2, 0.5), c(0.3))
arma_Q0naive(c(0.2, 0.5), c(0.3))
sarima:::arma_Q0gnb(c(0.2, 0.5), c(0.3))
arma_Q0gnbR(c(0.2, 0.5), c(0.3))
sarima:::arma_Q0gnb0(c(0.2, 0.5), c(0.3))
## rbenchmark::benchmark(sarima:::arma_Q0bis(c(0.2, 0.5), c(0.3)),
## sarima:::arma_Q0Gardner(c(0.2, 0.5), c(0.3)),
## sarima:::arma_Q0naive(c(0.2, 0.5), c(0.3)),
## sarima:::arma_Q0gnb(c(0.2, 0.5), c(0.3)),
## sarima:::arma_Q0gnbR(c(0.2, 0.5), c(0.3)),
## sarima:::arma_Q0gnb0(c(0.2, 0.5), c(0.3)),
## replications = 10000)
## test replications elapsed relative user.self
## 1 sarima:::arma_Q0bis(c(0.2, 0.5), c(0.3)) 10000 0.38 2.714 1 0.37
## 2 sarima:::arma_Q0Gardner(c(0.2, 0.5), c(0.3)) 10000 0.14 1.000 2 0.14
## 4 sarima:::arma_Q0gnb(c(0.2, 0.5), c(0.3)) 10000 0.14 1.000 4 0.14
## 6 sarima:::arma_Q0gnb0(c(0.2, 0.5), c(0.3)) 10000 0.16 1.143 6 0.15
## 5 sarima:::arma_Q0gnbR(c(0.2, 0.5), c(0.3)) 10000 0.87 6.214 5 0.87
## 3 sarima:::arma_Q0naive(c(0.2, 0.5), c(0.3)) 10000 1.14 8.143 3 1.12
phi4p2 <- c(0.2, 0.5, 0.1, -0.2)
theta4p2 <- c(0.3, 0.05)
a1 <- arma_Q0Gardner(phi4p2, theta4p2)
a2 <- arma_Q0bis(phi4p2, theta4p2)
a4 <- sarima:::arma_Q0gnb(phi4p2, theta4p2)
a3 <- arma_Q0gnbR(phi4p2, theta4p2)
sarima:::arma_Q0gnb0(phi4p2, theta4p2)
## rbenchmark::benchmark(
## sarima:::arma_Q0Gardner(phi4p2, theta4p2),
## sarima:::arma_Q0bis(phi4p2, theta4p2),
## sarima:::arma_Q0gnb(phi4p2, theta4p2),
## sarima:::arma_Q0gnbR(phi4p2, theta4p2),
## sarima:::arma_Q0gnb0(phi4p2, theta4p2),
## replications = 10000 )
##
## test replications elapsed relative user.self
## 2 sarima:::arma_Q0bis(phi4p2, theta4p2) 10000 0.29 2.071 2 0.30
## 1 sarima:::arma_Q0Gardner(phi4p2, theta4p2) 10000 0.14 1.000 1 0.14
## 3 sarima:::arma_Q0gnb(phi4p2, theta4p2) 10000 0.15 1.071 3 0.16
## 5 sarima:::arma_Q0gnb0(phi4p2, theta4p2) 10000 0.15 1.071 5 0.16
## 4 sarima:::arma_Q0gnbR(phi4p2, theta4p2) 10000 1.99 14.214 4 2.00
})
test_that("kikiriki", {
expect_equal(2+2,4)
## replacing calls to eigen() with safe_eigen() since on 32-bit Windows sometimes 'x'
## contains NA/NaN's and errors result (eg NULL$value), see the TODO comments at a number
## of places. I have uncommented the offending lines after changing eigen() with
## safe_eigen().
safe_eigen <- function(x, only.values = FALSE, ...){
if(any(is.na(x))){
list(values = rep(NA_real_, nrow(x)),
vectors = if(only.values)
NULL
else
matrix(NA_real_, nrow = nrow(x), ncol = ncol(x))
)
}else
eigen(x, only.values = only.values, ...)
}
## these are modified examples from arimaML.R
## in "R\src\base\R-3.3.2\src\library\stats\tests\arimaML.R"
##
## The k smallest eigenvalues of m
EV.k <- function(m, k = 2) {
ev <- safe_eigen(m, only.values=TRUE)$values
m <- length(ev)
ev[m:(m-k+1)]
}
chkQ0 <- function(phi, theta, tol = .Machine$double.eps^0.5,
tolC = 1e-15, strict = TRUE, doEigen = FALSE){
all_Q0 <- list(Q0 = arma_Q0Gardner(phi, theta),
Q0bis = arma_Q0bis(phi, theta),
Q0naive = arma_Q0naive(phi, theta),
Q0gnbR = arma_Q0gnbR(phi, theta),
Q0gnb = arma_Q0gnb(phi, theta)
)
eig <- if(doEigen) sapply(all_Q0, function(x) EV.k(x))
a.eq <- mapply(function(x, y, ...) all.equal(all_Q0[[x]], all_Q0[[y]], ...),
rep(names(all_Q0), each = length(all_Q0)),
rep(names(all_Q0), length(all_Q0)),
MoreArgs = list(tol = tol) #, SIMPLIFY = FALSE
)
a.eq <- matrix(a.eq, length(all_Q0))
colnames(a.eq) <- rownames(a.eq) <- names(all_Q0)
# list(c12 = all.equal(Q0, Q0bis, tol = tol),
# c13 = all.equal(Q0, Q0ter, tol = tol),
# c23 = all.equal(Q0bis, Q0ter, tol = tol),
# c24 = all.equal(Q0bis, arma_Q0b, tol = tol)
# )
## if(strict) do.call(stopifnot, a.eq)
c(all_Q0, list(all.eq = a.eq, eigen = eig, phi = phi, theta = theta))
}
##' @title AR-phi corresponding to AR(1) + Seasonality(s)
##' @param s: seasonality
##' @param phi1, phis: phi[1], phi[s] .. defaults: close to non-stationarity
mkPhi <- function(s, phi1 = 0.0001, phis = 0.99) {
stopifnot(length(s) > 0, s == as.integer(s), s >= 2,
length(phi1) == 1, is.numeric(phi1), length(phis) == 1)
c(phi1, rep(0, s-2), phis, -phi1*phis)
}
##--{end of function defs}-------------------------------------------------------
## cases with p=0, q=0 :
chkQ0(numeric(), numeric())
chkQ0( .5, numeric())
chkQ0(numeric(), .7)
chkQ0(numeric(), c(.7, .2))
chkQ <- function(s, theta, tol = 0)
chkQ0(mkPhi(s = s), theta = theta, tol = tol, strict = FALSE)
# all.eq2num <- function(ae) as.numeric(sub(".* difference: ", '', ae))
all.eq2num <- function(ae){
sub(".* difference: ", '', ae)
}
getN12 <- function(r)
all.eq2num(r$all.eq$c12)
ss <- setNames(,2:20)
chk0 <- lapply(ss, chkQ, theta= numeric())
chk1 <- lapply(ss, chkQ, theta= 0.75)
chk2 <- lapply(ss, chkQ, theta= c(0.75, -0.5))
chks <- list(q0 = chk0, q1 = chk1, q2 = chk2)
lapply(chk0, function(x) all.eq2num(x$all.eq))
lapply(chk1, function(x) all.eq2num(x$all.eq))
lapply(chk2, function(x) all.eq2num(x$all.eq))
chk0a <- lapply(ss, chkQ, theta= numeric(), tol = .Machine$double.eps)
chk1a <- lapply(ss, chkQ, theta= 0.75, tol = .Machine$double.eps)
chk2a <- lapply(ss, chkQ, theta= c(0.75, -0.5), tol = .Machine$double.eps)
lapply(chk0a, function(x) all.eq2num(x$all.eq))
lapply(chk1a, function(x) all.eq2num(x$all.eq))
lapply(chk2a, function(x) all.eq2num(x$all.eq))
## these need adaptation to work:
##
## ## Quite platform dependent, in F19, 32 bit looks slightly better than 64:
## (re <- sapply(chks, function(C) sapply(C, getN12)))
## matplot(ss, re, type = "b", log="y", pch = paste(0:2))
## stopifnot(re[paste(2:7),] < 1e-7, # max(.) seen 9.626e-9
## re < 0.9) # max(.) seen 0.395
## The smallest few eigen values:
round(t(sapply(lapply(chk1, `[[`, "Q0"), EV.k, k=3)), 3)
ev3.0 <- lapply(chks, function(ck) t(sapply(lapply(ck, `[[`, "Q0"), EV.k, k=3)))
lapply(ev3.0, round, digits=3) ## problem for q >= 1 (none for q=0)
ev3.bis <- lapply(chks, function(ck) t(sapply(lapply(ck, `[[`, "Q0bis"), EV.k, k=3)))
lapply(ev3.bis[-1], round, digits=3) ## all fine
e1.bis <- sapply(ev3.bis, function(m) m[,1])
min(e1.bis) # -7.1e-15 , -7.5e-15
stopifnot(e1.bis > -1e-12)
round(t(sapply(lapply(chk1, `[[`, "Q0"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk1, `[[`, "Q0bis"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk1, `[[`, "Q0naive"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk1, `[[`, "Q0gnbR"), EV.k, k=3)), 3)
## TODO: temporally commenting out due to the following error:
##
## -- 1. Error: (unknown) (@test-arma_q0.R#191) --------------------------------
## --
## infinite or missing values in 'x'
## 1: t(sapply(lapply(chk1, `[[`, "Q0gnb"), EV.k, k = 3)) at testthat/test-arma_q
## 0.R:191
## 2: sapply(lapply(chk1, `[[`, "Q0gnb"), EV.k, k = 3)
## 3: lapply(X = X, FUN = FUN, ...)
## 4: FUN(X[[i]], ...)
## 5: eigen(m, only.values = TRUE) at testthat/test-arma_q0.R:77
## 6: stop("infinite or missing values in 'x'")
##
## == testthat results =========================================================
## ==
## OK: 79 SKIPPED: 1 FAILED: 1
## 1. Error: (unknown) (@test-arma_q0.R#191)
##
round(t(sapply(lapply(chk1, `[[`, "Q0gnb"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk2, `[[`, "Q0"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk2, `[[`, "Q0bis"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk2, `[[`, "Q0naive"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk2, `[[`, "Q0gnbR"), EV.k, k=3)), 3)
## TODO: temporally commenting out due to the following error:
##
## -- 1. Error: (unknown) (@test-arma_q0.R#215) --------------------------------
## --
## infinite or missing values in 'x'
## 1: t(sapply(lapply(chk2, `[[`, "Q0gnb"), EV.k, k = 3)) at testthat/test-arma_q
## 0.R:215
## 2: sapply(lapply(chk2, `[[`, "Q0gnb"), EV.k, k = 3)
## 3: lapply(X = X, FUN = FUN, ...)
## 4: FUN(X[[i]], ...)
## 5: eigen(m, only.values = TRUE) at testthat/test-arma_q0.R:77
## 6: stop("infinite or missing values in 'x'")
##
## == testthat results =========================================================
## ==
## OK: 79 SKIPPED: 1 FAILED: 1
## 1. Error: (unknown) (@test-arma_q0.R#215)
##
round(t(sapply(lapply(chk2, `[[`, "Q0gnb"), EV.k, k=3)), 3)
ev3.0 <- lapply(chks, function(ck) t(sapply(lapply(ck, `[[`, "Q0"), EV.k, k=3)))
lapply(ev3.0, round, digits=3) ## problem for q >= 1 (none for q=0)
ev3.bis <- lapply(chks, function(ck) t(sapply(lapply(ck, `[[`, "Q0bis"), EV.k, k=3)))
lapply(ev3.bis[-1], round, digits=3) ## all fine
## TODO: temporally commenting out due to the following error:
##
## 1: lapply(chks, function(ck) t(sapply(lapply(ck, `[[`, "Q0gnb"), EV.k, k = 3))
## ) at testthat/test-arma_q0.R:241
## 2: FUN(X[[i]], ...)
## 3: t(sapply(lapply(ck, `[[`, "Q0gnb"), EV.k, k = 3)) at testthat/test-arma_q0.
## R:241
## 4: sapply(lapply(ck, `[[`, "Q0gnb"), EV.k, k = 3)
## 5: lapply(X = X, FUN = FUN, ...)
## 6: FUN(X[[i]], ...)
## 7: eigen(m, only.values = TRUE) at testthat/test-arma_q0.R:77
## 8: stop("infinite or missing values in 'x'")
##
ev3.gnb <- lapply(chks, function(ck) t(sapply(lapply(ck, `[[`, "Q0gnb"), EV.k, k=3)))
lapply(ev3.gnb[-1], round, digits=3) ## all fine
e1.bis <- sapply(ev3.bis, function(m) m[,1])
min(e1.bis) # -7.1e-15 , -7.5e-15
stopifnot(e1.bis > -1e-12)
## TODO: Commenting this out do to the commented out ev3.gnb above.
## Uncomment when that's sorted out!
##
e1.gnb <- sapply(ev3.gnb, function(m) m[,1])
if(!(any(is.na(e1.gnb)))){
min(e1.gnb) # -7.1e-15 , -7.5e-15
stopifnot(e1.gnb > -1e-12)
}
## Now Rossignol's example
phi <- mkPhi(s = 12)
theta <- 0.7
true.cf <- c(ar1=phi[1], ma1=theta, sar1=phi[12])
## TODO: temporally commenting out due to the following error:
##
## infinite or missing values in 'x'
## 1: chkQ0(phi, theta, tol = 0.5, doEigen = TRUE) at testthat/test-arma_q0.R:273
##
## 2: sapply(all_Q0, function(x) EV.k(x)) at testthat/test-arma_q0.R:93
## 3: lapply(X = X, FUN = FUN, ...)
## 4: FUN(X[[i]], ...)
## 5: EV.k(x) at testthat/test-arma_q0.R:93
## 6: eigen(m, only.values = TRUE) at testthat/test-arma_q0.R:77
## 7: stop("infinite or missing values in 'x'")
##
## == testthat results =========================================================
## ==
## OK: 79 SKIPPED: 1 FAILED: 1
## 1. Error: (unknown) (@test-arma_q0.R#273)
##
tt <- chkQ0(phi, theta, tol = 0.50, doEigen = TRUE)
tt$eigen
## Q0 Q0bis Q0naive Q0gnbR Q0gnb
## [1,] -83.45901 -5.293961e-23 -6.352749e-22 -5.293956e-23 -5.293956e-23
## [2,] -83.37531 4.422551e+00 4.422551e+00 4.422551e+00 4.422551e+00
##
## Note that for Q0naive the smallest evalue is negative. The above is from a call to eigen()
## with 'only.values = TRUE'. Indeed:
##
## > EV.k(tt$Q0naive)
## [1] -6.352749e-22 4.422551e+00
## > eigen(tt$Q0naive, only.values = TRUE)$values
## [1] 1.427099e+02 1.337121e+02 1.331121e+02 1.083120e+02 1.079038e+02
## [6] 7.364358e+01 7.344826e+01 3.900463e+01 3.896386e+01 1.369306e+01
## [11] 1.367364e+01 4.422551e+00 -6.352749e-22
##
## (the last element is the smallest)
## However, if also the vectors are computed it is positive:
##
## > eigen(tt$Q0naive)$values
## [1] 1.427099e+02 1.337121e+02 1.331121e+02 1.083120e+02 1.079038e+02
## [6] 7.364358e+01 7.344826e+01 3.900463e+01 3.896386e+01 1.369306e+01
## [11] 1.367364e+01 4.422551e+00 8.526513e-14
##
## It is tempting to think that the value from the full decomposition is more reliable.
## However, it is all probably noise. Indeed, computing v' tt$Q0naive v gives a negative value:
##
## > t(eigen(tt$Q0naive)$vectors[, 13]) %*% tt$Q0naive %*% eigen(tt$Q0naive)$vectors[ , 13]
## [,1]
## [1,] -4.618197e-22
out.0 <- makeARIMA(phi, theta, NULL)
out.R <- makeARIMA(phi, theta, NULL, SSinit="Rossignol")
set.seed(7)
x <- arima.sim(1000,model=list(ar=phi,ma=theta))
k0 <- KalmanLike(x, mod=out.0)
kS <- KalmanLike(x, mod=out.R)
stopifnot(sapply(kS, is.finite))
## ini.ph <- true.cf
## ## Default method = "CSS-ML" works fine
## fm1 <- arima(x, order= c(1,0,1), seasonal= list(period=12, order=c(1,0,0)),
## include.mean=FALSE, init=ini.ph)
## stopifnot(all.equal(true.cf, coef(fm1), tol = 0.05))
##
## ## Using 'ML' seems "harder" :
## e1 <- try(
## arima(x, order= c(1,0,1), seasonal= list(period=12, order=c(1,0,0)),
## include.mean=FALSE, init=ini.ph, method='ML')
## )
## ## Error: NAs in 'phi'
## e2 <- try(
## arima(x, order= c(1,0,1), seasonal= list(period=12, order=c(1,0,0)),
## include.mean=FALSE, init=ini.ph, method='ML', transform.pars=FALSE)
## )
## ## Error in optim(init[mask], armafn, ..): initial value in 'vmmin' is not finite
##
## ## MM: The new Q0 does *not* help here, really:
## e3 <- try(
## arima(x, order= c(1,0,1), seasonal= list(period=12, order=c(1,0,0)),
## include.mean=FALSE, init=ini.ph, method='ML', SSinit = "Rossi")
## )
## ## actually fails still, but *not* transforming parameters works :
## fm2 <-
## arima(x, order= c(1,0,1), seasonal= list(period=12, order=c(1,0,0)),
## include.mean=FALSE, init=ini.ph, method='ML', SSinit = "Rossi", transform.p=FALSE)
##
## stopifnot(all.equal(confint(fm1),
## confint(fm2), tol = 4e-4))
##
phi <- mkPhi(s = 12)
theta <- 0.7
true.cf <- c(ar1 = phi[1], ma1 = theta, sar1 = phi[12])
## TODO: temporally commenting out due to the following error:
##
## infinite or missing values in 'x'
## 1: chkQ0(phi, theta, tol = 0.5, doEigen = TRUE) at testthat/test-arma_q0.R:372
##
## 2: sapply(all_Q0, function(x) EV.k(x)) at testthat/test-arma_q0.R:93
## 3: lapply(X = X, FUN = FUN, ...)
## 4: FUN(X[[i]], ...)
## 5: EV.k(x) at testthat/test-arma_q0.R:93
## 6: eigen(m, only.values = TRUE) at testthat/test-arma_q0.R:77
## 7: stop("infinite or missing values in 'x'")
##
## == testthat results =========================================================
## ==
## OK: 79 SKIPPED: 1 FAILED: 1
## 1. Error: (unknown) (@test-arma_q0.R#372)
##
tt <- chkQ0(phi, theta, tol = 0.50, doEigen = TRUE)
tt$eigen
out.0 <- makeARIMA(phi, theta, NULL)
out.R <- makeARIMA(phi, theta, NULL, SSinit = "Rossignol")
safe_eigen(out.0$Pn)$values
safe_eigen(out.R$Pn)$values
## TODO: temporally commenting out due to the following error:
##
## -- 1. Error: (unknown) (@test-arma_q0.R#397) --------------------------------
## --
## infinite or missing values in 'x'
## 1: eigen(sarima:::arma_Q0gnb0(phi, theta)) at testthat/test-arma_q0.R:397
## 2: stop("infinite or missing values in 'x'")
##
## == testthat results =========================================================
## ==
## OK: 79 SKIPPED: 1 FAILED: 1
## 1. Error: (unknown) (@test-arma_q0.R#397)
##
##
## Note on 32-bit Windows we get:
## > sarima:::arma_Q0gnb0(phi, theta)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [2,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [3,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [4,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [5,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [6,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [7,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [8,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [9,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [10,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [11,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [12,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [13,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## so,
## > eigen(sarima:::arma_Q0gnb0(phi, theta))
## gives:
## Error in eigen(sarima:::arma_Q0gnb0(phi, theta)) :
## infinite or missing values in 'x'
## 'R CMD check' and devtools::check() fail on 32-bit platform but are ok on 64
## (pay attnetion with checks!)
## devtools::test() is ok on 64-bit Windows, since it tests only the current platform.
##
safe_eigen(sarima:::arma_Q0gnb0(phi, theta))$values
safe_eigen(sarima:::arma_Q0gnb(phi, theta))$values
safe_eigen(sarima:::arma_Q0gnbR(phi, theta))$values
## only naive here gets all eigenvalues positive:
safe_eigen(sarima:::arma_Q0naive(phi, theta))$values
})
## test_that("aha", {
## ## Note: commenting out the 'expect_equal() line, gives the following incomprehensible error:
## ## (there is not much point having such tests without expectations,
## ## but if it happens there is no clue in the error message.)
## ## (devtools is 1.13.5, testthat is 2.0.0)
## ##
## ##
## # > devtools::test()
## # Loading sarima
## # Testing sarima
## # v | OK F W S | Context
## # \ | 2 | 0List of 2
## # $ Lik: num NaN
## # $ s2 : num 1.05
## # List of 2
## # $ Lik: num 0.0519
## # $ s2 : num 1.06
## # Error in x[[method]](...) : attempt to apply non-function
## # In addition: Warning message:
## # `encoding` is deprecated; all files now assumed to be UTF-8
## #
## # == Results =====================================================================
## # Duration: 1.5 s
## #
## # OK: 2
## # Failed: 4
## # Warnings: 0
## # Skipped: 1
## # >
## expect_equal(2+2, 4)
## theta <- 0.7
## })
Try the sarima package in your browser
Any scripts or data that you put into this service are public.
sarima documentation built on Aug. 11, 2022, 5:11 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
## Do not edit this file manually.
## It has been automatically generated from *.org sources.
library(sarima)
test_that("comparisons of versions of arma_Q0", {
## This was giving a nasty error if running interactively, see below.
## It seems that the problem is that there are no expectations.
## adding the simple one velow resolved this.
## (keeping for now as a reminder)
##
## > devtools::test()
## Loading sarima
## Testing sarima
## v | OK F W S | Context
## Error in x[[method]](...) : attempt to apply non-function
## In addition: Warning message:
## `encoding` is deprecated; all files now assumed to be UTF-8
##
## == Results =====================================================================
## OK: 0
## Failed: 4
## Warnings: 0
## Skipped: 1
##
expect_equal(2 + 2, 4)
## TODO: consolidate the examples in the chunk in the Org file
## immeadiately after this one and put some here.
Q0bis <- arma_Q0bis(c(0.2, 0.5, 0.1), c(0.3))
Q0Gardner <- arma_Q0Gardner(c(0.2, 0.5, 0.1), c(0.3))
## Q0gnb <- sarima:::arma_Q0gnb(c(0.2, 0.5, 0.1), c(0.3))
Q0gnbR <- arma_Q0gnbR(c(0.2, 0.5, 0.1), c(0.3))
## Q0gnb0 <- sarima:::arma_Q0gnb0(c(0.2, 0.5, 0.1), c(0.3))
## rbenchmark::benchmark(sarima:::arma_Q0bis(c(0.2, 0.5, 0.1), c(0.3)) ,
## sarima:::arma_Q0Gardner(c(0.2, 0.5, 0.1), c(0.3)) ,
## sarima:::arma_Q0gnb(c(0.2, 0.5, 0.1), c(0.3)) ,
## sarima:::arma_Q0gnbR(c(0.2, 0.5, 0.1), c(0.3)) ,
## sarima:::arma_Q0gnb0(c(0.2, 0.5, 0.1), c(0.3)) ,
## sarima:::arma_Q0Gardner(c(0.2, 0.5, 0.1), c(0.3)) ,
## repetitions = 1000)
arma_Q0Gardner(c(0.2, 0.5), c(0.3))
arma_Q0naive(c(0.2, 0.5), c(0.3))
sarima:::arma_Q0gnb(c(0.2, 0.5), c(0.3))
arma_Q0gnbR(c(0.2, 0.5), c(0.3))
sarima:::arma_Q0gnb0(c(0.2, 0.5), c(0.3))
## rbenchmark::benchmark(sarima:::arma_Q0bis(c(0.2, 0.5), c(0.3)),
## sarima:::arma_Q0Gardner(c(0.2, 0.5), c(0.3)),
## sarima:::arma_Q0naive(c(0.2, 0.5), c(0.3)),
## sarima:::arma_Q0gnb(c(0.2, 0.5), c(0.3)),
## sarima:::arma_Q0gnbR(c(0.2, 0.5), c(0.3)),
## sarima:::arma_Q0gnb0(c(0.2, 0.5), c(0.3)),
## replications = 10000)
## test replications elapsed relative user.self
## 1 sarima:::arma_Q0bis(c(0.2, 0.5), c(0.3)) 10000 0.38 2.714 1 0.37
## 2 sarima:::arma_Q0Gardner(c(0.2, 0.5), c(0.3)) 10000 0.14 1.000 2 0.14
## 4 sarima:::arma_Q0gnb(c(0.2, 0.5), c(0.3)) 10000 0.14 1.000 4 0.14
## 6 sarima:::arma_Q0gnb0(c(0.2, 0.5), c(0.3)) 10000 0.16 1.143 6 0.15
## 5 sarima:::arma_Q0gnbR(c(0.2, 0.5), c(0.3)) 10000 0.87 6.214 5 0.87
## 3 sarima:::arma_Q0naive(c(0.2, 0.5), c(0.3)) 10000 1.14 8.143 3 1.12
phi4p2 <- c(0.2, 0.5, 0.1, -0.2)
theta4p2 <- c(0.3, 0.05)
a1 <- arma_Q0Gardner(phi4p2, theta4p2)
a2 <- arma_Q0bis(phi4p2, theta4p2)
a4 <- sarima:::arma_Q0gnb(phi4p2, theta4p2)
a3 <- arma_Q0gnbR(phi4p2, theta4p2)
sarima:::arma_Q0gnb0(phi4p2, theta4p2)
## rbenchmark::benchmark(
## sarima:::arma_Q0Gardner(phi4p2, theta4p2),
## sarima:::arma_Q0bis(phi4p2, theta4p2),
## sarima:::arma_Q0gnb(phi4p2, theta4p2),
## sarima:::arma_Q0gnbR(phi4p2, theta4p2),
## sarima:::arma_Q0gnb0(phi4p2, theta4p2),
## replications = 10000 )
##
## test replications elapsed relative user.self
## 2 sarima:::arma_Q0bis(phi4p2, theta4p2) 10000 0.29 2.071 2 0.30
## 1 sarima:::arma_Q0Gardner(phi4p2, theta4p2) 10000 0.14 1.000 1 0.14
## 3 sarima:::arma_Q0gnb(phi4p2, theta4p2) 10000 0.15 1.071 3 0.16
## 5 sarima:::arma_Q0gnb0(phi4p2, theta4p2) 10000 0.15 1.071 5 0.16
## 4 sarima:::arma_Q0gnbR(phi4p2, theta4p2) 10000 1.99 14.214 4 2.00
})
test_that("kikiriki", {
expect_equal(2+2,4)
## replacing calls to eigen() with safe_eigen() since on 32-bit Windows sometimes 'x'
## contains NA/NaN's and errors result (eg NULL$value), see the TODO comments at a number
## of places. I have uncommented the offending lines after changing eigen() with
## safe_eigen().
safe_eigen <- function(x, only.values = FALSE, ...){
if(any(is.na(x))){
list(values = rep(NA_real_, nrow(x)),
vectors = if(only.values)
NULL
else
matrix(NA_real_, nrow = nrow(x), ncol = ncol(x))
)
}else
eigen(x, only.values = only.values, ...)
}
## these are modified examples from arimaML.R
## in "R\src\base\R-3.3.2\src\library\stats\tests\arimaML.R"
##
## The k smallest eigenvalues of m
EV.k <- function(m, k = 2) {
ev <- safe_eigen(m, only.values=TRUE)$values
m <- length(ev)
ev[m:(m-k+1)]
}
chkQ0 <- function(phi, theta, tol = .Machine$double.eps^0.5,
tolC = 1e-15, strict = TRUE, doEigen = FALSE){
all_Q0 <- list(Q0 = arma_Q0Gardner(phi, theta),
Q0bis = arma_Q0bis(phi, theta),
Q0naive = arma_Q0naive(phi, theta),
Q0gnbR = arma_Q0gnbR(phi, theta),
Q0gnb = arma_Q0gnb(phi, theta)
)
eig <- if(doEigen) sapply(all_Q0, function(x) EV.k(x))
a.eq <- mapply(function(x, y, ...) all.equal(all_Q0[[x]], all_Q0[[y]], ...),
rep(names(all_Q0), each = length(all_Q0)),
rep(names(all_Q0), length(all_Q0)),
MoreArgs = list(tol = tol) #, SIMPLIFY = FALSE
)
a.eq <- matrix(a.eq, length(all_Q0))
colnames(a.eq) <- rownames(a.eq) <- names(all_Q0)
# list(c12 = all.equal(Q0, Q0bis, tol = tol),
# c13 = all.equal(Q0, Q0ter, tol = tol),
# c23 = all.equal(Q0bis, Q0ter, tol = tol),
# c24 = all.equal(Q0bis, arma_Q0b, tol = tol)
# )
## if(strict) do.call(stopifnot, a.eq)
c(all_Q0, list(all.eq = a.eq, eigen = eig, phi = phi, theta = theta))
}
##' @title AR-phi corresponding to AR(1) + Seasonality(s)
##' @param s: seasonality
##' @param phi1, phis: phi[1], phi[s] .. defaults: close to non-stationarity
mkPhi <- function(s, phi1 = 0.0001, phis = 0.99) {
stopifnot(length(s) > 0, s == as.integer(s), s >= 2,
length(phi1) == 1, is.numeric(phi1), length(phis) == 1)
c(phi1, rep(0, s-2), phis, -phi1*phis)
}
##--{end of function defs}-------------------------------------------------------
## cases with p=0, q=0 :
chkQ0(numeric(), numeric())
chkQ0( .5, numeric())
chkQ0(numeric(), .7)
chkQ0(numeric(), c(.7, .2))
chkQ <- function(s, theta, tol = 0)
chkQ0(mkPhi(s = s), theta = theta, tol = tol, strict = FALSE)
# all.eq2num <- function(ae) as.numeric(sub(".* difference: ", '', ae))
all.eq2num <- function(ae){
sub(".* difference: ", '', ae)
}
getN12 <- function(r)
all.eq2num(r$all.eq$c12)
ss <- setNames(,2:20)
chk0 <- lapply(ss, chkQ, theta= numeric())
chk1 <- lapply(ss, chkQ, theta= 0.75)
chk2 <- lapply(ss, chkQ, theta= c(0.75, -0.5))
chks <- list(q0 = chk0, q1 = chk1, q2 = chk2)
lapply(chk0, function(x) all.eq2num(x$all.eq))
lapply(chk1, function(x) all.eq2num(x$all.eq))
lapply(chk2, function(x) all.eq2num(x$all.eq))
chk0a <- lapply(ss, chkQ, theta= numeric(), tol = .Machine$double.eps)
chk1a <- lapply(ss, chkQ, theta= 0.75, tol = .Machine$double.eps)
chk2a <- lapply(ss, chkQ, theta= c(0.75, -0.5), tol = .Machine$double.eps)
lapply(chk0a, function(x) all.eq2num(x$all.eq))
lapply(chk1a, function(x) all.eq2num(x$all.eq))
lapply(chk2a, function(x) all.eq2num(x$all.eq))
## these need adaptation to work:
##
## ## Quite platform dependent, in F19, 32 bit looks slightly better than 64:
## (re <- sapply(chks, function(C) sapply(C, getN12)))
## matplot(ss, re, type = "b", log="y", pch = paste(0:2))
## stopifnot(re[paste(2:7),] < 1e-7, # max(.) seen 9.626e-9
## re < 0.9) # max(.) seen 0.395
## The smallest few eigen values:
round(t(sapply(lapply(chk1, `[[`, "Q0"), EV.k, k=3)), 3)
ev3.0 <- lapply(chks, function(ck) t(sapply(lapply(ck, `[[`, "Q0"), EV.k, k=3)))
lapply(ev3.0, round, digits=3) ## problem for q >= 1 (none for q=0)
ev3.bis <- lapply(chks, function(ck) t(sapply(lapply(ck, `[[`, "Q0bis"), EV.k, k=3)))
lapply(ev3.bis[-1], round, digits=3) ## all fine
e1.bis <- sapply(ev3.bis, function(m) m[,1])
min(e1.bis) # -7.1e-15 , -7.5e-15
stopifnot(e1.bis > -1e-12)
round(t(sapply(lapply(chk1, `[[`, "Q0"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk1, `[[`, "Q0bis"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk1, `[[`, "Q0naive"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk1, `[[`, "Q0gnbR"), EV.k, k=3)), 3)
## TODO: temporally commenting out due to the following error:
##
## -- 1. Error: (unknown) (@test-arma_q0.R#191) --------------------------------
## --
## infinite or missing values in 'x'
## 1: t(sapply(lapply(chk1, `[[`, "Q0gnb"), EV.k, k = 3)) at testthat/test-arma_q
## 0.R:191
## 2: sapply(lapply(chk1, `[[`, "Q0gnb"), EV.k, k = 3)
## 3: lapply(X = X, FUN = FUN, ...)
## 4: FUN(X[[i]], ...)
## 5: eigen(m, only.values = TRUE) at testthat/test-arma_q0.R:77
## 6: stop("infinite or missing values in 'x'")
##
## == testthat results =========================================================
## ==
## OK: 79 SKIPPED: 1 FAILED: 1
## 1. Error: (unknown) (@test-arma_q0.R#191)
##
round(t(sapply(lapply(chk1, `[[`, "Q0gnb"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk2, `[[`, "Q0"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk2, `[[`, "Q0bis"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk2, `[[`, "Q0naive"), EV.k, k=3)), 3)
round(t(sapply(lapply(chk2, `[[`, "Q0gnbR"), EV.k, k=3)), 3)
## TODO: temporally commenting out due to the following error:
##
## -- 1. Error: (unknown) (@test-arma_q0.R#215) --------------------------------
## --
## infinite or missing values in 'x'
## 1: t(sapply(lapply(chk2, `[[`, "Q0gnb"), EV.k, k = 3)) at testthat/test-arma_q
## 0.R:215
## 2: sapply(lapply(chk2, `[[`, "Q0gnb"), EV.k, k = 3)
## 3: lapply(X = X, FUN = FUN, ...)
## 4: FUN(X[[i]], ...)
## 5: eigen(m, only.values = TRUE) at testthat/test-arma_q0.R:77
## 6: stop("infinite or missing values in 'x'")
##
## == testthat results =========================================================
## ==
## OK: 79 SKIPPED: 1 FAILED: 1
## 1. Error: (unknown) (@test-arma_q0.R#215)
##
round(t(sapply(lapply(chk2, `[[`, "Q0gnb"), EV.k, k=3)), 3)
ev3.0 <- lapply(chks, function(ck) t(sapply(lapply(ck, `[[`, "Q0"), EV.k, k=3)))
lapply(ev3.0, round, digits=3) ## problem for q >= 1 (none for q=0)
ev3.bis <- lapply(chks, function(ck) t(sapply(lapply(ck, `[[`, "Q0bis"), EV.k, k=3)))
lapply(ev3.bis[-1], round, digits=3) ## all fine
## TODO: temporally commenting out due to the following error:
##
## 1: lapply(chks, function(ck) t(sapply(lapply(ck, `[[`, "Q0gnb"), EV.k, k = 3))
## ) at testthat/test-arma_q0.R:241
## 2: FUN(X[[i]], ...)
## 3: t(sapply(lapply(ck, `[[`, "Q0gnb"), EV.k, k = 3)) at testthat/test-arma_q0.
## R:241
## 4: sapply(lapply(ck, `[[`, "Q0gnb"), EV.k, k = 3)
## 5: lapply(X = X, FUN = FUN, ...)
## 6: FUN(X[[i]], ...)
## 7: eigen(m, only.values = TRUE) at testthat/test-arma_q0.R:77
## 8: stop("infinite or missing values in 'x'")
##
ev3.gnb <- lapply(chks, function(ck) t(sapply(lapply(ck, `[[`, "Q0gnb"), EV.k, k=3)))
lapply(ev3.gnb[-1], round, digits=3) ## all fine
e1.bis <- sapply(ev3.bis, function(m) m[,1])
min(e1.bis) # -7.1e-15 , -7.5e-15
stopifnot(e1.bis > -1e-12)
## TODO: Commenting this out do to the commented out ev3.gnb above.
## Uncomment when that's sorted out!
##
e1.gnb <- sapply(ev3.gnb, function(m) m[,1])
if(!(any(is.na(e1.gnb)))){
min(e1.gnb) # -7.1e-15 , -7.5e-15
stopifnot(e1.gnb > -1e-12)
}
## Now Rossignol's example
phi <- mkPhi(s = 12)
theta <- 0.7
true.cf <- c(ar1=phi[1], ma1=theta, sar1=phi[12])
## TODO: temporally commenting out due to the following error:
##
## infinite or missing values in 'x'
## 1: chkQ0(phi, theta, tol = 0.5, doEigen = TRUE) at testthat/test-arma_q0.R:273
##
## 2: sapply(all_Q0, function(x) EV.k(x)) at testthat/test-arma_q0.R:93
## 3: lapply(X = X, FUN = FUN, ...)
## 4: FUN(X[[i]], ...)
## 5: EV.k(x) at testthat/test-arma_q0.R:93
## 6: eigen(m, only.values = TRUE) at testthat/test-arma_q0.R:77
## 7: stop("infinite or missing values in 'x'")
##
## == testthat results =========================================================
## ==
## OK: 79 SKIPPED: 1 FAILED: 1
## 1. Error: (unknown) (@test-arma_q0.R#273)
##
tt <- chkQ0(phi, theta, tol = 0.50, doEigen = TRUE)
tt$eigen
## Q0 Q0bis Q0naive Q0gnbR Q0gnb
## [1,] -83.45901 -5.293961e-23 -6.352749e-22 -5.293956e-23 -5.293956e-23
## [2,] -83.37531 4.422551e+00 4.422551e+00 4.422551e+00 4.422551e+00
##
## Note that for Q0naive the smallest evalue is negative. The above is from a call to eigen()
## with 'only.values = TRUE'. Indeed:
##
## > EV.k(tt$Q0naive)
## [1] -6.352749e-22 4.422551e+00
## > eigen(tt$Q0naive, only.values = TRUE)$values
## [1] 1.427099e+02 1.337121e+02 1.331121e+02 1.083120e+02 1.079038e+02
## [6] 7.364358e+01 7.344826e+01 3.900463e+01 3.896386e+01 1.369306e+01
## [11] 1.367364e+01 4.422551e+00 -6.352749e-22
##
## (the last element is the smallest)
## However, if also the vectors are computed it is positive:
##
## > eigen(tt$Q0naive)$values
## [1] 1.427099e+02 1.337121e+02 1.331121e+02 1.083120e+02 1.079038e+02
## [6] 7.364358e+01 7.344826e+01 3.900463e+01 3.896386e+01 1.369306e+01
## [11] 1.367364e+01 4.422551e+00 8.526513e-14
##
## It is tempting to think that the value from the full decomposition is more reliable.
## However, it is all probably noise. Indeed, computing v' tt$Q0naive v gives a negative value:
##
## > t(eigen(tt$Q0naive)$vectors[, 13]) %*% tt$Q0naive %*% eigen(tt$Q0naive)$vectors[ , 13]
## [,1]
## [1,] -4.618197e-22
out.0 <- makeARIMA(phi, theta, NULL)
out.R <- makeARIMA(phi, theta, NULL, SSinit="Rossignol")
set.seed(7)
x <- arima.sim(1000,model=list(ar=phi,ma=theta))
k0 <- KalmanLike(x, mod=out.0)
kS <- KalmanLike(x, mod=out.R)
stopifnot(sapply(kS, is.finite))
## ini.ph <- true.cf
## ## Default method = "CSS-ML" works fine
## fm1 <- arima(x, order= c(1,0,1), seasonal= list(period=12, order=c(1,0,0)),
## include.mean=FALSE, init=ini.ph)
## stopifnot(all.equal(true.cf, coef(fm1), tol = 0.05))
##
## ## Using 'ML' seems "harder" :
## e1 <- try(
## arima(x, order= c(1,0,1), seasonal= list(period=12, order=c(1,0,0)),
## include.mean=FALSE, init=ini.ph, method='ML')
## )
## ## Error: NAs in 'phi'
## e2 <- try(
## arima(x, order= c(1,0,1), seasonal= list(period=12, order=c(1,0,0)),
## include.mean=FALSE, init=ini.ph, method='ML', transform.pars=FALSE)
## )
## ## Error in optim(init[mask], armafn, ..): initial value in 'vmmin' is not finite
##
## ## MM: The new Q0 does *not* help here, really:
## e3 <- try(
## arima(x, order= c(1,0,1), seasonal= list(period=12, order=c(1,0,0)),
## include.mean=FALSE, init=ini.ph, method='ML', SSinit = "Rossi")
## )
## ## actually fails still, but *not* transforming parameters works :
## fm2 <-
## arima(x, order= c(1,0,1), seasonal= list(period=12, order=c(1,0,0)),
## include.mean=FALSE, init=ini.ph, method='ML', SSinit = "Rossi", transform.p=FALSE)
##
## stopifnot(all.equal(confint(fm1),
## confint(fm2), tol = 4e-4))
##
phi <- mkPhi(s = 12)
theta <- 0.7
true.cf <- c(ar1 = phi[1], ma1 = theta, sar1 = phi[12])
## TODO: temporally commenting out due to the following error:
##
## infinite or missing values in 'x'
## 1: chkQ0(phi, theta, tol = 0.5, doEigen = TRUE) at testthat/test-arma_q0.R:372
##
## 2: sapply(all_Q0, function(x) EV.k(x)) at testthat/test-arma_q0.R:93
## 3: lapply(X = X, FUN = FUN, ...)
## 4: FUN(X[[i]], ...)
## 5: EV.k(x) at testthat/test-arma_q0.R:93
## 6: eigen(m, only.values = TRUE) at testthat/test-arma_q0.R:77
## 7: stop("infinite or missing values in 'x'")
##
## == testthat results =========================================================
## ==
## OK: 79 SKIPPED: 1 FAILED: 1
## 1. Error: (unknown) (@test-arma_q0.R#372)
##
tt <- chkQ0(phi, theta, tol = 0.50, doEigen = TRUE)
tt$eigen
out.0 <- makeARIMA(phi, theta, NULL)
out.R <- makeARIMA(phi, theta, NULL, SSinit = "Rossignol")
safe_eigen(out.0$Pn)$values
safe_eigen(out.R$Pn)$values
## TODO: temporally commenting out due to the following error:
##
## -- 1. Error: (unknown) (@test-arma_q0.R#397) --------------------------------
## --
## infinite or missing values in 'x'
## 1: eigen(sarima:::arma_Q0gnb0(phi, theta)) at testthat/test-arma_q0.R:397
## 2: stop("infinite or missing values in 'x'")
##
## == testthat results =========================================================
## ==
## OK: 79 SKIPPED: 1 FAILED: 1
## 1. Error: (unknown) (@test-arma_q0.R#397)
##
##
## Note on 32-bit Windows we get:
## > sarima:::arma_Q0gnb0(phi, theta)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
## [1,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [2,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [3,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [4,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [5,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [6,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [7,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [8,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [9,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [10,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [11,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [12,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## [13,] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN
## so,
## > eigen(sarima:::arma_Q0gnb0(phi, theta))
## gives:
## Error in eigen(sarima:::arma_Q0gnb0(phi, theta)) :
## infinite or missing values in 'x'
## 'R CMD check' and devtools::check() fail on 32-bit platform but are ok on 64
## (pay attnetion with checks!)
## devtools::test() is ok on 64-bit Windows, since it tests only the current platform.
##
safe_eigen(sarima:::arma_Q0gnb0(phi, theta))$values
safe_eigen(sarima:::arma_Q0gnb(phi, theta))$values
safe_eigen(sarima:::arma_Q0gnbR(phi, theta))$values
## only naive here gets all eigenvalues positive:
safe_eigen(sarima:::arma_Q0naive(phi, theta))$values
})
## test_that("aha", {
## ## Note: commenting out the 'expect_equal() line, gives the following incomprehensible error:
## ## (there is not much point having such tests without expectations,
## ## but if it happens there is no clue in the error message.)
## ## (devtools is 1.13.5, testthat is 2.0.0)
## ##
## ##
## # > devtools::test()
## # Loading sarima
## # Testing sarima
## # v | OK F W S | Context
## # \ | 2 | 0List of 2
## # $ Lik: num NaN
## # $ s2 : num 1.05
## # List of 2
## # $ Lik: num 0.0519
## # $ s2 : num 1.06
## # Error in x[[method]](...) : attempt to apply non-function
## # In addition: Warning message:
## # `encoding` is deprecated; all files now assumed to be UTF-8
## #
## # == Results =====================================================================
## # Duration: 1.5 s
## #
## # OK: 2
## # Failed: 4
## # Warnings: 0
## # Skipped: 1
## # >
## expect_equal(2+2, 4)
## theta <- 0.7
## })
Try the sarima package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.