SEXP arma0_kfore(SEXP pG, SEXP pd, SEXP psd, SEXP nahead)
{
int dd = asInteger(pd);
int d, il = asInteger(nahead), ifault = 0, i, j;
double *del, *del2;
SEXP res, x, var;
GET_STARMA;
PROTECT(res = allocVector(VECSXP, 2));
SET_VECTOR_ELT(res, 0, x = allocVector(REALSXP, il));
SET_VECTOR_ELT(res, 1, var = allocVector(REALSXP, il));
d = dd + G->ns * asInteger(psd);
del = (double *) R_alloc(d + 1, sizeof(double));
del2 = (double *) R_alloc(d + 1, sizeof(double));
del[0] = 1;
for(i = 1; i <= d; i++) del[i] = 0;
for (j = 0; j < dd; j++) {
for(i = 0; i <= d; i++) del2[i] = del[i];
for(i = 0; i <= d - 1; i++) del[i+1] -= del2[i];
}
for (j = 0; j < asInteger(psd); j++) {
for(i = 0; i <= d; i++) del2[i] = del[i];
for(i = 0; i <= d - G->ns; i++) del[i + G->ns] -= del2[i];
}
for(i = 1; i <= d; i++) del[i] *= -1;
forkal(G, d, il, del + 1, REAL(x), REAL(var), &ifault);
if(ifault) error(_("forkal error code %d"), ifault);
UNPROTECT(1);
return res;
}
void sarima_predict(sarima_object obj, double *inp, int L, double *xpred, double *amse) {
int d, i, N, ip, iq, ir,D,P,Q,s,p,q,t,ps,qs,j;
double *coef1,*coef2,*delta, *W, *resid, *phi, *theta;
double wmean;
d = obj->d;
N = obj->N;
p = obj->p;
q = obj->q;
D = obj->D;
P = obj->P;
Q = obj->Q;
s = obj->s;
ip = p + s * P;
iq = q + s * Q;
ir = p + s * P;
t = 1 + q + s*Q;
if (ir < t) {
ir = t;
}
ps = P;
qs = Q;
coef1 = (double*)malloc(sizeof(double)* (d + 1));
coef2 = (double*)malloc(sizeof(double)* (D*s + 1));
delta = (double*)malloc(sizeof(double)* (d + D*s + 1));
W = (double*)malloc(sizeof(double)* N);
resid = (double*)malloc(sizeof(double)* N);
phi = (double*)malloc(sizeof(double)* ir);
theta = (double*)malloc(sizeof(double)* ir);
wmean = 0.0;
coef1[0] = coef2[0] = 1.0;
if (d == 0 && D == 0) {
*delta = 1.0;
wmean = obj->mean;
}
if (d > 0) {
deld(d, coef1);
}
if (D > 0) {
delds(D, s, coef2);
}
conv(coef1, d + 1, coef2, D*s + 1, delta);
//mdisplay(delta, 1, d + D*s + 1);
for (i = 1; i <= d+D*s; ++i) {
delta[i] = -1.0 * delta[i];
}
for (i = 0; i < N; ++i) {
W[i] = inp[i];
if (d == 0 && D == 0) {
W[i] -= wmean;
}
resid[i] = obj->res[i];
}
for (i = 0; i < ir; ++i) {
phi[i] = theta[i] = 0.0;
}
for (i = 0; i < p; ++i) {
phi[i] = obj->phi[i];
}
for (i = 0; i < q; ++i) {
theta[i] = -1.0 * obj->theta[i];
}
for (j = 0; j < ps; ++j) {
phi[(j + 1)*s - 1] += obj->PHI[j];
for (i = 0; i < p; ++i) {
phi[(j + 1)*s + i] -= obj->phi[i] * obj->PHI[j];
}
}
for (j = 0; j < qs; ++j) {
theta[(j + 1)*s - 1] -= obj->THETA[j];
for (i = 0; i < q; ++i) {
theta[(j + 1)*s + i] += obj->theta[i] * obj->THETA[j];
}
}
forkal(ip, iq, d+D*s, phi, theta, delta + 1, N, W, resid, L, xpred, amse);
for (i = 0; i < L; ++i) {
xpred[i] += wmean;
}
free(coef1);
free(coef2);
free(delta);
free(W);
free(resid);
free(phi);
free(theta);
}
void ar_predict(ar_object obj, double *inp, int L, double *xpred, double *amse) {
int d, i, N, ip, iq, ir;
double *delta, *W, *resid, *phi, *theta;
double wmean;
d = 0;
N = obj->N;
ip = obj->p;
iq = 0;
delta = (double*)malloc(sizeof(double)* (d + 1));
W = (double*)malloc(sizeof(double)* N);
resid = (double*)malloc(sizeof(double)* N);
ir = iq + 1;
if (ir < ip) {
ir = ip;
}
phi = (double*)malloc(sizeof(double)* ir);
theta = (double*)malloc(sizeof(double)* ir);
wmean = 0.0;
if (d > 0) {
deld(d, delta);
}
else {
*delta = 1.0;
wmean = obj->mean;
}
for (i = 1; i <= d; ++i) {
delta[i] = -1.0 * delta[i];
}
for (i = 0; i < N; ++i) {
W[i] = inp[i];
if (d == 0) {
W[i] -= wmean;
}
resid[i] = obj->res[i];
}
for (i = 0; i < ir; ++i) {
phi[i] = theta[i] = 0.0;
}
for (i = 0; i < ip; ++i) {
phi[i] = obj->phi[i];
}
for (i = 0; i < iq; ++i) {
theta[i] = -1.0 * 0.0;
}
forkal(ip, iq, d, phi, theta, delta + 1, N, W, resid, L, xpred, amse);
for (i = 0; i < L; ++i) {
xpred[i] += wmean;
}
free(delta);
free(W);
free(resid);
free(phi);
free(theta);
}
