Commit 4c428e6d authored by Dirk Eddelbuettel's avatar Dirk Eddelbuettel

Import Upstream version 0.10-37

parent 7aba2a2c
Package: tseries
Version: 0.10-36
Version: 0.10-37
Title: Time Series Analysis and Computational Finance
Authors@R: c(person("Adrian", "Trapletti", role = "aut",
email = "adrian@trapletti.org"),
......@@ -12,10 +12,10 @@ Depends: R (>= 2.10.0)
Imports: graphics, stats, utils, quadprog, zoo
License: GPL-2
NeedsCompilation: yes
Packaged: 2016-12-15 15:27:15 UTC; hornik
Packaged: 2017-01-17 11:00:51 UTC; hornik
Author: Adrian Trapletti [aut],
Kurt Hornik [aut, cre],
Blake LeBaron [ctb] (BDS test code)
Maintainer: Kurt Hornik <Kurt.Hornik@R-project.org>
Repository: CRAN
Date/Publication: 2016-12-15 16:41:41
Date/Publication: 2017-01-17 12:33:40
154a044c75cbd08632af4adfc98cd426 *ChangeLog
591eda968b980565696cc17903cd3695 *DESCRIPTION
2b3f182ac38fa94b06b0950bda63e2a1 *NAMESPACE
434cfb7f2cdc1fe1cab1922e3fb0e3d8 *R/arma.R
5903f8b93860508e520faa669c04e58f *DESCRIPTION
5f5a43a566e6cdf8f6f13199c78b399a *NAMESPACE
790c7072074abd1c93f008181ccf4666 *R/arma.R
4d47ac4e99712ced9371bedab34386ac *R/finance.R
f3d8df961e5a15c7e356a4566424e175 *R/garch.R
ee2412ba1dab5f357fb5da7b78051987 *R/garch.R
decf4a3134c069cf9d2dbc79b1b60706 *R/irts.R
8373af2fb26375738e9d61677183d10a *R/test.R
ebc29d93799680f40e284960a8cd6950 *R/tsutils.R
cf77d7d885502dc3d8208ce255b3e411 *R/test.R
b8d00d728728d3a7fc725f222fc372f3 *R/tsutils.R
6474314852bc0951b0cc3848febd98dc *R/zzz.R
e311649f01da4c522be8ff61cb4776a2 *README
1b0dd6b7b4405d1674d36ebb260a0e88 *data/NelPlo.rda
......@@ -58,11 +58,12 @@ da83545c6306f8b91dd7f1ba6f9e46b5 *man/tcmd.Rd
345540d936c221018ea0f70147ab8d06 *man/tsbootstrap.Rd
6b89e394a1b8f1d0aedd0ce325dcf28e *man/white.test.Rd
2fa4c7011c2bc0f7449ae151d5cc44ae *src/Makevars
1a35c6e2fa9203b12275182e39fc2ff5 *src/arma.c
f2bf234d2e38601a167e21ced4414add *src/bdstest.c
8baf771b61e1b40e56a60eb8942de9be *src/boot.c
1448096ba1c28220a8e88ab98fbe992f *src/arma.c
ad9369b11b8c8d7f66fee9f80b3058d2 *src/bdstest.c
c47b29e10a2dce353532046d1875ca91 *src/boot.c
aba6a3c63cf4b072d33caf5e10f8c1ff *src/dsumsl.f
d241de1861aa5c67ba732682d2400e3d *src/formats.c
a4437e1594ccd359073bd5d9dcddf727 *src/garch.c
0f28e4e0304e26ee6733839ba9e1a043 *src/garch.c
fbef0e720a93000e09ec177a6999320d *src/init.c
bb845ffd8e0f71eefb50749eed92f249 *src/ppsum.c
010a7adf9c8df331fa379de1c4a7e4da *src/tsutils.c
useDynLib("tseries")
useDynLib("tseries", .registration = TRUE)
import("graphics", "stats", "utils")
importFrom("quadprog", "solve.QP")
......
......@@ -30,7 +30,7 @@ function(x, order = c(1, 1), lag = NULL, coef = NULL,
err <- function(coef) {
u <- double(n)
u[seqN(max.order)] <- 0
u <- .C("arma",
u <- .C(R_arma,
as.vector(x, mode = "double"),
u = as.vector(u),
as.vector(coef, mode = "double"),
......@@ -40,15 +40,14 @@ function(x, order = c(1, 1), lag = NULL, coef = NULL,
as.integer(ma.l),
as.integer(max.order),
as.integer(n),
as.integer(include.intercept),
PACKAGE="tseries")$u
as.integer(include.intercept))$u
return(sum(u^2))
}
resid <- function(coef) {
u <- double(n)
u[seqN(max.order)] <- 0
u <- .C("arma",
u <- .C(R_arma,
as.vector(x, mode = "double"),
u = as.vector(u),
as.vector(coef, mode = "double"),
......@@ -58,8 +57,7 @@ function(x, order = c(1, 1), lag = NULL, coef = NULL,
as.integer(ma.l),
as.integer(max.order),
as.integer(n),
as.integer(include.intercept),
PACKAGE="tseries")$u
as.integer(include.intercept))$u
return(u)
}
......
......@@ -46,7 +46,7 @@ function (x, order = c(1, 1), series = NULL, control = garch.control(...), ...)
if(!is.vector(coef)) stop("coef is not a vector")
if(ncoef != length(coef)) stop("incorrect length of coef")
nlikeli <- 1.0e+10
fit <- .C("fit_garch",
fit <- .C(R_fit_garch,
as.vector(x, mode = "double"),
as.integer(n),
coef = as.vector(coef, mode = "double"),
......@@ -59,25 +59,22 @@ function (x, order = c(1, 1), series = NULL, control = garch.control(...), ...)
as.double(control$falsetol),
nlikeli = as.double(nlikeli),
as.integer(agrad),
as.integer(control$trace),
PACKAGE="tseries")
pred <- .C("pred_garch",
as.integer(control$trace))
pred <- .C(R_pred_garch,
as.vector(x, mode = "double"),
e = as.vector(e, mode = "double"),
as.integer(n),
as.vector(fit$coef, mode = "double"),
as.integer(order[1]),
as.integer(order[2]),
as.integer(FALSE),
PACKAGE = "tseries")
com.hess <- .C("ophess_garch",
as.integer(FALSE))
com.hess <- .C(R_ophess_garch,
as.vector(x, mode = "double"),
as.integer(n),
as.vector(fit$coef, mode = "double"),
hess = as.matrix(hess),
as.integer(order[1]),
as.integer(order[2]),
PACKAGE="tseries")
as.integer(order[2]))
rank <- do.call("qr", c(list(x = com.hess$hess), control$qr))$rank
if(rank != ncoef) {
vc <- matrix(NA, nrow = ncoef, ncol = ncoef)
......@@ -260,15 +257,14 @@ function(object, newdata, genuine = FALSE, ...)
n <- nrow(newdata)
if(genuine) h <- double(n+1)
else h <- double(n)
pred <- .C("pred_garch",
pred <- .C(R_pred_garch,
as.vector(newdata, mode = "double"),
h = as.vector(h, mode = "double"),
as.integer(n),
as.vector(object$coef, mode = "double"),
as.integer(object$order[1]),
as.integer(object$order[2]),
as.integer(genuine),
PACKAGE="tseries")
as.integer(genuine))
pred$h <- sqrt(pred$h)
pred$h[1:max(object$order[1],object$order[2])] <-
rep.int(NA, max(object$order[1],object$order[2]))
......
......@@ -74,15 +74,14 @@ function(x, m = 3, eps = seq(0.5*sd(x),2*sd(x),length=4), trace = FALSE)
cstan <- double(m+1)
STATISTIC <- matrix(0,m-1,k)
for(i in (1:k)) {
res <- .C("bdstest_main",
res <- .C(R_bdstest_main,
as.integer(n),
as.integer(m),
as.vector(x, mode="double"),
as.vector(cc),
cstan = as.vector(cstan),
as.double(eps[i]),
as.integer(trace),
PACKAGE="tseries")
as.integer(trace))
STATISTIC[,i] <- res$cstan[2:m+1]
}
colnames(STATISTIC) <- eps
......@@ -572,12 +571,11 @@ function(x, alternative = c("stationary", "explosive"),
l <- trunc(4*(n/100)^0.25)
else
l <- trunc(12*(n/100)^0.25)
ssqrtl <- .C("R_pp_sum",
ssqrtl <- .C(R_pp_sum,
as.vector(u, mode="double"),
as.integer(n),
as.integer(l),
ssqrtl=as.double(ssqru),
PACKAGE="tseries")$ssqrtl
ssqrtl=as.double(ssqru))$ssqrtl
n2 <- n^2
trm1 <- n2*(n2-1)*sum(yt1^2)/12
trm2 <- n*sum(yt1*(1:n))^2
......@@ -670,12 +668,11 @@ function(x, demean = TRUE, lshort = TRUE)
l <- trunc(n/100)
else
l <- trunc(n/30)
ssqrtl <- .C("R_pp_sum",
ssqrtl <- .C(R_pp_sum,
as.vector(k, mode="double"),
as.integer(n),
as.integer(l),
ssqrtl=as.double(ssqrk),
PACKAGE="tseries")$ssqrtl
ssqrtl=as.double(ssqrk))$ssqrtl
alpha <- res.sum$coefficients[1,1]
STAT <- n*(alpha-1)-0.5*n^2*(ssqrtl-ssqrk)/(sum(ut1^2))
if(demean) {
......@@ -745,12 +742,11 @@ function(x, null = c("Level", "Trend"), lshort = TRUE)
l <- trunc(3*sqrt(n)/13)
else
l <- trunc(10*sqrt(n)/14)
s2 <- .C("R_pp_sum",
s2 <- .C(R_pp_sum,
as.vector(e, mode="double"),
as.integer(n),
as.integer(l),
s2=as.double(s2),
PACKAGE="tseries")$s2
s2=as.double(s2))$s2
STAT <- eta/s2
PVAL <- approx(table, tablep, STAT, rule=2)$y
if(is.na(approx(table, tablep, STAT, rule=1)$y))
......
......@@ -126,12 +126,11 @@ function(xi = 0.2, a = 4.0, n = 1000)
if((xi < 0) || (xi > 1)) stop("xi is not in [0,1]")
if((a < 0) || (a > 4)) stop("a is not in [0,4]")
x <- double(n)
res <- .C("R_quad_map",
res <- .C(R_quad_map,
x = as.vector(x),
as.double(xi),
as.double(a),
as.integer(n),
PACKAGE="tseries")
as.integer(n))
return(ts(res$x))
}
......@@ -273,13 +272,12 @@ function(x, y, colx = "black", coly = "red", typex = "l",
boot.sample <-
function(x, b, type)
{
return(.C("boot",
return(.C(R_boot,
as.vector(x, mode = "double"),
x = as.vector(x, mode = "double"),
as.integer(length(x)),
as.double(b),
as.integer(type),
PACKAGE = "tseries")$x)
as.integer(type))$x)
}
tsbootstrap <- function(x, nb = 1, statistic = NULL, m = 1, b = NULL,
......
......@@ -17,8 +17,8 @@
ARMA estimation */
void arma (double *x, double *u, double *a, int *ar, int *ma, int *arl,
int *mal, int *max, int *n, int *intercept)
void R_arma (double *x, double *u, double *a, int *ar, int *ma, int *arl,
int *mal, int *max, int *n, int *intercept)
/* compute conditional sum of squares */
{
int i, j;
......
......@@ -528,7 +528,7 @@ arguments are exactly the same.
/* begin front end ---------------------------------- */
void bdstest_main (int *N, int *M, double *x, double *c, double *cstan, double *EPS, int *TRACE)
void R_bdstest_main (int *N, int *M, double *x, double *c, double *cstan, double *EPS, int *TRACE)
{
int i;
double k;
......
......@@ -103,7 +103,7 @@ static void BlockBoot (double x[], double xBoot[], int n, int L)
}
}
void boot (double *x, double *xb, int *n, double *b, int *type)
void R_boot (double *x, double *xb, int *n, double *b, int *type)
{
GetRNGstate();
if (*type == 0) StatBoot (x-1, xb-1, *n, *b);
......
......@@ -131,9 +131,9 @@ static void F77_SUB(ufparm) ()
}
void fit_garch (double *y, int *n, double *par, int *p, int *q, int *itmax,
double *afctol, double *rfctol, double *xctol, double *xftol,
double *fret, int *agrad, int *trace)
void R_fit_garch (double *y, int *n, double *par, int *p, int *q, int *itmax,
double *afctol, double *rfctol, double *xctol, double *xftol,
double *fret, int *agrad, int *trace)
/* fit a GARCH (p, q) model
Input:
......@@ -228,7 +228,7 @@ void fit_garch (double *y, int *n, double *par, int *p, int *q, int *itmax,
}
void pred_garch (double *y, double *h, int *n, double *par, int *p, int *q, int *genuine)
void R_pred_garch (double *y, double *h, int *n, double *par, int *p, int *q, int *genuine)
/* predict cv with a GARCH (p, q) model
Input:
......@@ -267,7 +267,7 @@ void pred_garch (double *y, double *h, int *n, double *par, int *p, int *q, int
}
void ophess_garch (double *y, int *n, double *par, double *he, int *p, int *q)
void R_ophess_garch (double *y, int *n, double *par, double *he, int *p, int *q)
/* Compute outer product approximation of the hessian of the
negative log likelihood of a GARCH (p, q) model at given parameter
estimates
......
#include <R.h>
#include <Rinternals.h>
#include <R_ext/Rdynload.h>
void R_pp_sum (double* u, int* n, int* l, double* sum);
void R_quad_map (double *x, double *xi, double *a, int *n);
void R_arma (double *x, double *u, double *a, int *ar, int *ma, int *arl,
int *mal, int *max, int *n, int *intercept);
void R_bdstest_main (int *N, int *M, double *x, double *c, double *cstan,
double *EPS, int *TRACE);
void R_boot (double *x, double *xb, int *n, double *b, int *type);
void R_fit_garch (double *y, int *n, double *par, int *p, int *q, int *itmax,
double *afctol, double *rfctol, double *xctol, double *xftol,
double *fret, int *agrad, int *trace);
void R_ophess_garch (double *y, int *n, double *par, double *he, int *p, int *q);
void R_pred_garch (double *y, double *h, int *n, double *par, int *p, int *q, int *genuine);
static const R_CMethodDef CEntries[] = {
{"R_pp_sum", (DL_FUNC) &R_pp_sum, 4},
{"R_quad_map", (DL_FUNC) &R_quad_map, 4},
{"R_arma", (DL_FUNC) &R_arma, 10},
{"R_bdstest_main", (DL_FUNC) &R_bdstest_main, 7},
{"R_boot", (DL_FUNC) &R_boot, 5},
{"R_fit_garch", (DL_FUNC) &R_fit_garch, 13},
{"R_ophess_garch", (DL_FUNC) &R_ophess_garch, 6},
{"R_pred_garch", (DL_FUNC) &R_pred_garch, 7},
{NULL, NULL, 0}
};
void R_init_tseries(DllInfo *dll)
{
R_registerRoutines(dll, CEntries, NULL, NULL, NULL);
R_useDynamicSymbols(dll, FALSE);
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment