static void convolveNd_half(const fftw_complex *ox,
double *y,
R_len_t rank,
const R_len_t *N,
int conjugate,
fftw_plan r2c_plan,
fftw_plan c2r_plan) {
R_len_t i;
fftw_complex *oy;
R_len_t pN = prod(rank, N), phN = hprod(rank, N);
/* Allocate needed memory */
oy = (fftw_complex*) fftw_malloc(phN * sizeof(fftw_complex));
/* Compute the Nd-FFT of the matrix y */
fftw_execute_dft_r2c(r2c_plan, y, oy);
/* Compute conjugation if needed */
if (conjugate)
for (i = 0; i < phN; ++i)
oy[i] = conj(oy[i]);
/* Dot-multiply ox and oy, and divide by Nx*...*Nz*/
for (i = 0; i < phN; ++i)
oy[i] *= ox[i] / pN;
/* Compute the reverse transform to obtain result */
fftw_execute_dft_c2r(c2r_plan, oy, y);
/* Cleanup */
fftw_free(oy);
}
static void initialize_circulant(hbhankel_matrix *h,
const double *F,
R_len_t rank,
const R_len_t *N,
const R_len_t *L,
const int *circular) {
fftw_complex *ocirc;
fftw_plan p1, p2;
double *circ;
R_len_t *revN, r;
/* Allocate needed memory */
circ = (double*) fftw_malloc(prod(rank, N) * sizeof(double));
ocirc = (fftw_complex*) fftw_malloc(hprod(rank, N) * sizeof(fftw_complex));
/* Estimate the best plans for given input length, note, that input data is
stored in column-major mode, that's why we're passing dimensions in
*reverse* order */
revN = Calloc(rank, R_len_t);
for (r = 0; r < rank; ++r) revN[r] = N[rank - 1 - r];
p1 = fftw_plan_dft_r2c(rank, revN, circ, ocirc, FFTW_ESTIMATE);
p2 = fftw_plan_dft_c2r(rank, revN, ocirc, circ, FFTW_ESTIMATE);
Free(revN);
/* Fill input buffer */
memcpy(circ, F, prod(rank, N) * sizeof(double));
/* Run the plan on input data */
fftw_execute(p1);
/* Cleanup and return */
fftw_free(circ);
h->circ_freq = ocirc;
h->r2c_plan = p1;
h->c2r_plan = p2;
h->rank = rank;
h->window = Calloc(rank, R_len_t);
memcpy(h->window, L, rank * sizeof(R_len_t));
h->length = Calloc(rank, R_len_t);
memcpy(h->length, N, rank * sizeof(R_len_t));
h->factor = Calloc(rank, R_len_t);
for (r = 0; r < rank; ++r) h->factor[r] = circular[r] ? N[r] : N[r] - L[r] + 1;
}
static void convolveNd(double *x,
double *y,
R_len_t rank,
const R_len_t *N,
int conjugate,
fftw_plan r2c_plan,
fftw_plan c2r_plan) {
fftw_complex *ox;
R_len_t phN = hprod(rank, N);
/* Allocate needed memory */
ox = (fftw_complex*) fftw_malloc(phN * sizeof(fftw_complex));
/* Compute the NdFFT of the arrays x and y */
fftw_execute_dft_r2c(r2c_plan, x, ox);
convolveNd_half(ox, y, rank, N, conjugate, r2c_plan, c2r_plan);
/* Cleanup */
fftw_free(ox);
}
Vector<T> hprod(Vector<T> &x1, Vector<T> &x2)
{
Vector<T> y(x1.size());
hprod(x1, x2, y);
return y;
}
SEXP convolveN(SEXP x, SEXP y,
SEXP input_dim, SEXP output_dim,
SEXP Conj) {
SEXP x_dim = NILSXP, y_dim = NILSXP;
R_len_t rank = length(input_dim);
R_len_t *N = INTEGER(input_dim);
R_len_t pN = prod(rank, N), phN = hprod(rank, N);
int conjugate = LOGICAL(Conj)[0];
fftw_complex *ox, *oy;
fftw_plan r2c_plan, c2r_plan;
double *circ;
R_len_t *revN, r, i;
/* Allocate needed memory */
circ = (double*) fftw_malloc(pN * sizeof(double));
ox = (fftw_complex*) fftw_malloc(phN * sizeof(fftw_complex));
oy = (fftw_complex*) fftw_malloc(phN * sizeof(fftw_complex));
/* Estimate the best plans for given input length, note, that input data is
stored in column-major mode, that's why we're passing dimensions in
*reverse* order */
revN = Calloc(rank, R_len_t);
for (r = 0; r < rank; ++r) revN[r] = N[rank - 1 - r];
r2c_plan = fftw_plan_dft_r2c(rank, revN, circ, ox, FFTW_ESTIMATE);
c2r_plan = fftw_plan_dft_c2r(rank, revN, ox, circ, FFTW_ESTIMATE);
Free(revN);
PROTECT(x_dim = getAttrib(x, R_DimSymbol));
PROTECT(y_dim = getAttrib(y, R_DimSymbol));
/* Fill input buffer by X values*/
memset(circ, 0, pN * sizeof(double));
fill_subarray(circ, REAL(x), rank, N, INTEGER(x_dim), 1);
/* Run the plan on X-input data */
fftw_execute_dft_r2c(r2c_plan, circ, ox);
/* Fill input buffer by Y values*/
memset(circ, 0, pN * sizeof(double));
fill_subarray(circ, REAL(y), rank, N, INTEGER(y_dim), 1);
/* Run the plan on Y-input data */
fftw_execute_dft_r2c(r2c_plan, circ, oy);
/* Compute conjugation if needed */
if (conjugate)
for (i = 0; i < phN; ++i)
oy[i] = conj(oy[i]);
/* Dot-multiply ox and oy, and divide by Nx*...*Nz*/
for (i = 0; i < phN; ++i)
oy[i] *= ox[i] / pN;
/* Compute the reverse transform to obtain result */
fftw_execute_dft_c2r(c2r_plan, oy, circ);
SEXP res;
PROTECT(res = allocVector(REALSXP, prod(rank, INTEGER(output_dim))));
fill_subarray(circ, REAL(res), rank, N, INTEGER(output_dim), 0);
/* setAttrib(output_dim, R_NamesSymbol, R_NilValue); */
setAttrib(res, R_DimSymbol, output_dim);
/* setAttrib(res, R_DimNamesSymbol, R_NilValue); */
/* Cleanup */
fftw_free(ox);
fftw_free(oy);
fftw_free(circ);
/* Return */
UNPROTECT(3);
return res;
}
