static int
mc_solve(lua_State *L)
{
mMatComplex *m = qlua_checkMatComplex(L, 1);
mVecComplex *v = qlua_checkVecComplex(L, 2);
mMatComplex *lu;
mVecComplex *x;
gsl_permutation *p;
/* XXX assume GSL and QLA_D_Complex use compatible layout */
gsl_vector_complex_view vb = gsl_vector_complex_view_array((void *)&v->val[0], v->size);
gsl_vector_complex_view vx;
int signum;
if (m->l_size != m->r_size)
return luaL_error(L, "square matrix expected");
if (m->l_size != v->size)
return luaL_error(L, "vector dim mismatch matrix size");
p = new_permutation(L, m->l_size);
lu = qlua_newMatComplex(L, m->l_size, m->l_size);
x = qlua_newVecComplex(L, m->l_size);
/* XXX assume GSL and QLA_D_Complex use compatible layout */
vx = gsl_vector_complex_view_array((void *)&x->val[0], x->size);
gsl_matrix_complex_memcpy(lu->m, m->m);
gsl_linalg_complex_LU_decomp(lu->m, p, &signum);
if (gsl_linalg_complex_LU_solve(lu->m, p, &vb.vector, &vx.vector))
luaL_error(L, "matrix:solve() failed");
gsl_permutation_free(p);
return 1;
}
static int
cm_mul_cv(lua_State *L)
{
mMatComplex *m = qlua_checkMatComplex(L, 1);
mVecComplex *v = qlua_checkVecComplex(L, 2);
mVecComplex *r = qlua_newVecComplex(L, m->l_size);
/* XXX assume GSL and QLA_D_Complex use compatible layout */
gsl_vector_complex_view vv = gsl_vector_complex_view_array((void *)&v->val[0], v->size);
gsl_vector_complex_view vr = gsl_vector_complex_view_array((void *)&r->val[0], r->size);
if (m->r_size != v->size)
return luaL_error(L, "matrix size mismatch in m * v");
gsl_blas_zgemv(CblasNoTrans, GSL_COMPLEX_ONE, m->m, &vv.vector,
GSL_COMPLEX_ZERO, &vr.vector);
return 1;
}
/**
* \brief Chops and remerges data into stationary segments
*
* This function finds segments of data that appear to be stationary (have the same standard deviation).
*
* The function first attempts to chop up the data into as many stationary segments as possible. The splitting may not
* be optimal, so it then tries remerging consecutive segments to see if the merged segments show more evidence of
* stationarity. <b>[NOTE: Remerging is currently turned off and will make very little difference to the algorithm]</b>.
* It then, if necessary, chops the segments again to make sure there are none greater than the required \c chunkMax.
* The default \c chunkMax is 0, so this rechopping will not normally happen.
*
* This is all performed on data that has had a running median subtracted, to try and removed any underlying trends in
* the data (e.g. those caused by a strong signal), which might affect the calculations (which assume the data is
* Gaussian with zero mean).
*
* If the \c verbose flag is set then a list of the segments will be output to a file called \c data_segment_list.txt,
* with a prefix of the detector name.
*
* \param data [in] A data structure
* \param chunkMin [in] The minimum length of a segment
* \param chunkMax [in] The maximum length of a segment
*
* \return A vector of segment/chunk lengths
*
* \sa subtract_running_median
* \sa chop_data
* \sa merge_data
* \sa rechop_data
*/
UINT4Vector *chop_n_merge( LALInferenceIFOData *data, INT4 chunkMin, INT4 chunkMax ){
UINT4 j = 0;
UINT4Vector *chunkLengths = NULL;
UINT4Vector *chunkIndex = NULL;
COMPLEX16Vector *meddata = NULL;
/* subtract a running median value from the data to remove any underlying trends (e.g. caused by a string signal) that
* might affect the chunk calculations (which can assume the data is Gaussian with zero mean). */
meddata = subtract_running_median( data->compTimeData->data );
/* pass chop data a gsl_vector_view, so that internally it can use vector views rather than having to create new vectors */
gsl_vector_complex_view meddatagsl = gsl_vector_complex_view_array((double*)meddata->data, meddata->length);
chunkIndex = chop_data( &meddatagsl.vector, chunkMin );
/* DON'T BOTHER WITH THE MERGING AS IT WILL MAKE VERY LITTLE DIFFERENCE */
/* merge_data( meddata, chunkIndex ); */
/* if a maximum chunk length is defined then rechop up the data, to segment any chunks longer than this value */
if ( chunkMax > chunkMin ) { rechop_data( chunkIndex, chunkMax, chunkMin ); }
chunkLengths = XLALCreateUINT4Vector( chunkIndex->length );
/* go through segments and turn into vector of chunk lengths */
for ( j = 0; j < chunkIndex->length; j++ ){
if ( j == 0 ) { chunkLengths->data[j] = chunkIndex->data[j]; }
else { chunkLengths->data[j] = chunkIndex->data[j] - chunkIndex->data[j-1]; }
}
/* if verbose print out the segment end indices to a file */
if ( verbose_output ){
FILE *fpsegs = NULL;
CHAR *outfile = NULL;
/* set detector name as prefix */
outfile = XLALStringDuplicate( data->detector->frDetector.prefix );
outfile = XLALStringAppend( outfile, "data_segment_list.txt" );
if ( (fpsegs = fopen(outfile, "w")) == NULL ){
fprintf(stderr, "Non-fatal error open file to output segment list.\n");
return chunkLengths;
}
for ( j = 0; j < chunkIndex->length; j++ ) { fprintf(fpsegs, "%u\n", chunkIndex->data[j]); }
/* add space at the end so that you can separate lists from different detector data streams */
fprintf(fpsegs, "\n");
fclose( fpsegs );
}
return chunkLengths;
}
int
gsl_eigen_hermv (gsl_matrix_complex * A, gsl_vector * eval,
gsl_matrix_complex * evec,
gsl_eigen_hermv_workspace * w)
{
if (A->size1 != A->size2)
{
GSL_ERROR ("matrix must be square to compute eigenvalues", GSL_ENOTSQR);
}
else if (eval->size != A->size1)
{
GSL_ERROR ("eigenvalue vector must match matrix size", GSL_EBADLEN);
}
else if (evec->size1 != A->size1 || evec->size2 != A->size1)
{
GSL_ERROR ("eigenvector matrix must match matrix size", GSL_EBADLEN);
}
else
{
const size_t N = A->size1;
double *const d = w->d;
double *const sd = w->sd;
size_t a, b;
/* handle special case */
if (N == 1)
{
gsl_complex A00 = gsl_matrix_complex_get (A, 0, 0);
gsl_vector_set (eval, 0, GSL_REAL(A00));
gsl_matrix_complex_set (evec, 0, 0, GSL_COMPLEX_ONE);
return GSL_SUCCESS;
}
/* Transform the matrix into a symmetric tridiagonal form */
{
gsl_vector_view d_vec = gsl_vector_view_array (d, N);
gsl_vector_view sd_vec = gsl_vector_view_array (sd, N - 1);
gsl_vector_complex_view tau_vec = gsl_vector_complex_view_array (w->tau, N-1);
gsl_linalg_hermtd_decomp (A, &tau_vec.vector);
gsl_linalg_hermtd_unpack (A, &tau_vec.vector, evec, &d_vec.vector, &sd_vec.vector);
}
/* Make an initial pass through the tridiagonal decomposition
to remove off-diagonal elements which are effectively zero */
chop_small_elements (N, d, sd);
/* Progressively reduce the matrix until it is diagonal */
b = N - 1;
while (b > 0)
{
if (sd[b - 1] == 0.0 || isnan(sd[b - 1]))
{
b--;
continue;
}
/* Find the largest unreduced block (a,b) starting from b
and working backwards */
a = b - 1;
while (a > 0)
{
if (sd[a - 1] == 0.0)
{
break;
}
a--;
}
{
size_t i;
const size_t n_block = b - a + 1;
double *d_block = d + a;
double *sd_block = sd + a;
double * const gc = w->gc;
double * const gs = w->gs;
/* apply QR reduction with implicit deflation to the
unreduced block */
qrstep (n_block, d_block, sd_block, gc, gs);
/* Apply Givens rotation Gij(c,s) to matrix Q, Q <- Q G */
for (i = 0; i < n_block - 1; i++)
{
const double c = gc[i], s = gs[i];
size_t k;
for (k = 0; k < N; k++)
{
gsl_complex qki = gsl_matrix_complex_get (evec, k, a + i);
gsl_complex qkj = gsl_matrix_complex_get (evec, k, a + i + 1);
/* qki <= qki * c - qkj * s */
/* qkj <= qki * s + qkj * c */
gsl_complex x1 = gsl_complex_mul_real(qki, c);
gsl_complex y1 = gsl_complex_mul_real(qkj, -s);
gsl_complex x2 = gsl_complex_mul_real(qki, s);
gsl_complex y2 = gsl_complex_mul_real(qkj, c);
gsl_complex qqki = gsl_complex_add(x1, y1);
gsl_complex qqkj = gsl_complex_add(x2, y2);
gsl_matrix_complex_set (evec, k, a + i, qqki);
gsl_matrix_complex_set (evec, k, a + i + 1, qqkj);
}
}
/* remove any small off-diagonal elements */
chop_small_elements (n_block, d_block, sd_block);
}
}
{
gsl_vector_view d_vec = gsl_vector_view_array (d, N);
gsl_vector_memcpy (eval, &d_vec.vector);
}
return GSL_SUCCESS;
}
}
static void
nonsymmv_get_right_eigenvectors(gsl_matrix *T, gsl_matrix *Z,
gsl_vector_complex *eval,
gsl_matrix_complex *evec,
gsl_eigen_nonsymmv_workspace *w)
{
const size_t N = T->size1;
const double smlnum = GSL_DBL_MIN * N / GSL_DBL_EPSILON;
const double bignum = (1.0 - GSL_DBL_EPSILON) / smlnum;
int i; /* looping */
size_t iu, /* looping */
ju,
ii;
gsl_complex lambda; /* current eigenvalue */
double lambda_re, /* Re(lambda) */
lambda_im; /* Im(lambda) */
gsl_matrix_view Tv, /* temporary views */
Zv;
gsl_vector_view y, /* temporary views */
y2,
ev,
ev2;
double dat[4], /* scratch arrays */
dat_X[4];
double scale; /* scale factor */
double xnorm; /* |X| */
gsl_vector_complex_view ecol, /* column of evec */
ecol2;
int complex_pair; /* complex eigenvalue pair? */
double smin;
/*
* Compute 1-norm of each column of upper triangular part of T
* to control overflow in triangular solver
*/
gsl_vector_set(w->work3, 0, 0.0);
for (ju = 1; ju < N; ++ju)
{
gsl_vector_set(w->work3, ju, 0.0);
for (iu = 0; iu < ju; ++iu)
{
gsl_vector_set(w->work3, ju,
gsl_vector_get(w->work3, ju) +
fabs(gsl_matrix_get(T, iu, ju)));
}
}
for (i = (int) N - 1; i >= 0; --i)
{
iu = (size_t) i;
/* get current eigenvalue and store it in lambda */
lambda_re = gsl_matrix_get(T, iu, iu);
if (iu != 0 && gsl_matrix_get(T, iu, iu - 1) != 0.0)
{
lambda_im = sqrt(fabs(gsl_matrix_get(T, iu, iu - 1))) *
sqrt(fabs(gsl_matrix_get(T, iu - 1, iu)));
}
else
{
lambda_im = 0.0;
}
GSL_SET_COMPLEX(&lambda, lambda_re, lambda_im);
smin = GSL_MAX(GSL_DBL_EPSILON * (fabs(lambda_re) + fabs(lambda_im)),
smlnum);
smin = GSL_MAX(smin, GSL_NONSYMMV_SMLNUM);
if (lambda_im == 0.0)
{
int k, l;
gsl_vector_view bv, xv;
/* real eigenvector */
/*
* The ordering of eigenvalues in 'eval' is arbitrary and
* does not necessarily follow the Schur form T, so store
* lambda in the right slot in eval to ensure it corresponds
* to the eigenvector we are about to compute
*/
gsl_vector_complex_set(eval, iu, lambda);
/*
* We need to solve the system:
*
* (T(1:iu-1, 1:iu-1) - lambda*I)*X = -T(1:iu-1,iu)
*/
/* construct right hand side */
for (k = 0; k < i; ++k)
{
gsl_vector_set(w->work,
(size_t) k,
-gsl_matrix_get(T, (size_t) k, iu));
}
gsl_vector_set(w->work, iu, 1.0);
for (l = i - 1; l >= 0; --l)
{
size_t lu = (size_t) l;
if (lu == 0)
complex_pair = 0;
else
complex_pair = gsl_matrix_get(T, lu, lu - 1) != 0.0;
if (!complex_pair)
{
double x;
/*
* 1-by-1 diagonal block - solve the system:
*
* (T_{ll} - lambda)*x = -T_{l(iu)}
*/
Tv = gsl_matrix_submatrix(T, lu, lu, 1, 1);
bv = gsl_vector_view_array(dat, 1);
gsl_vector_set(&bv.vector, 0,
gsl_vector_get(w->work, lu));
xv = gsl_vector_view_array(dat_X, 1);
gsl_schur_solve_equation(1.0,
&Tv.matrix,
lambda_re,
1.0,
1.0,
&bv.vector,
&xv.vector,
&scale,
&xnorm,
smin);
/* scale x to avoid overflow */
x = gsl_vector_get(&xv.vector, 0);
if (xnorm > 1.0)
{
if (gsl_vector_get(w->work3, lu) > bignum / xnorm)
{
x /= xnorm;
scale /= xnorm;
}
}
if (scale != 1.0)
{
gsl_vector_view wv;
wv = gsl_vector_subvector(w->work, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
}
gsl_vector_set(w->work, lu, x);
if (lu > 0)
{
gsl_vector_view v1, v2;
/* update right hand side */
v1 = gsl_matrix_subcolumn(T, lu, 0, lu);
v2 = gsl_vector_subvector(w->work, 0, lu);
gsl_blas_daxpy(-x, &v1.vector, &v2.vector);
} /* if (l > 0) */
} /* if (!complex_pair) */
else
{
double x11, x21;
/*
* 2-by-2 diagonal block
*/
Tv = gsl_matrix_submatrix(T, lu - 1, lu - 1, 2, 2);
bv = gsl_vector_view_array(dat, 2);
gsl_vector_set(&bv.vector, 0,
gsl_vector_get(w->work, lu - 1));
gsl_vector_set(&bv.vector, 1,
gsl_vector_get(w->work, lu));
xv = gsl_vector_view_array(dat_X, 2);
gsl_schur_solve_equation(1.0,
&Tv.matrix,
lambda_re,
1.0,
1.0,
&bv.vector,
&xv.vector,
&scale,
&xnorm,
smin);
/* scale X(1,1) and X(2,1) to avoid overflow */
x11 = gsl_vector_get(&xv.vector, 0);
x21 = gsl_vector_get(&xv.vector, 1);
if (xnorm > 1.0)
{
double beta;
beta = GSL_MAX(gsl_vector_get(w->work3, lu - 1),
gsl_vector_get(w->work3, lu));
if (beta > bignum / xnorm)
{
x11 /= xnorm;
x21 /= xnorm;
scale /= xnorm;
}
}
/* scale if necessary */
if (scale != 1.0)
{
gsl_vector_view wv;
wv = gsl_vector_subvector(w->work, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
}
gsl_vector_set(w->work, lu - 1, x11);
gsl_vector_set(w->work, lu, x21);
/* update right hand side */
if (lu > 1)
{
gsl_vector_view v1, v2;
v1 = gsl_matrix_subcolumn(T, lu - 1, 0, lu - 1);
v2 = gsl_vector_subvector(w->work, 0, lu - 1);
gsl_blas_daxpy(-x11, &v1.vector, &v2.vector);
v1 = gsl_matrix_subcolumn(T, lu, 0, lu - 1);
gsl_blas_daxpy(-x21, &v1.vector, &v2.vector);
}
--l;
} /* if (complex_pair) */
} /* for (l = i - 1; l >= 0; --l) */
/*
* At this point, w->work is an eigenvector of the
* Schur form T. To get an eigenvector of the original
* matrix, we multiply on the left by Z, the matrix of
* Schur vectors
*/
ecol = gsl_matrix_complex_column(evec, iu);
y = gsl_matrix_column(Z, iu);
if (iu > 0)
{
gsl_vector_view x;
Zv = gsl_matrix_submatrix(Z, 0, 0, N, iu);
x = gsl_vector_subvector(w->work, 0, iu);
/* compute Z * w->work and store it in Z(:,iu) */
gsl_blas_dgemv(CblasNoTrans,
1.0,
&Zv.matrix,
&x.vector,
gsl_vector_get(w->work, iu),
&y.vector);
} /* if (iu > 0) */
/* store eigenvector into evec */
ev = gsl_vector_complex_real(&ecol.vector);
ev2 = gsl_vector_complex_imag(&ecol.vector);
scale = 0.0;
for (ii = 0; ii < N; ++ii)
{
double a = gsl_vector_get(&y.vector, ii);
/* store real part of eigenvector */
gsl_vector_set(&ev.vector, ii, a);
/* set imaginary part to 0 */
gsl_vector_set(&ev2.vector, ii, 0.0);
if (fabs(a) > scale)
scale = fabs(a);
}
if (scale != 0.0)
scale = 1.0 / scale;
/* scale by magnitude of largest element */
gsl_blas_dscal(scale, &ev.vector);
} /* if (GSL_IMAG(lambda) == 0.0) */
else
{
gsl_vector_complex_view bv, xv;
size_t k;
int l;
gsl_complex lambda2;
/* complex eigenvector */
/*
* Store the complex conjugate eigenvalues in the right
* slots in eval
*/
GSL_SET_REAL(&lambda2, GSL_REAL(lambda));
GSL_SET_IMAG(&lambda2, -GSL_IMAG(lambda));
gsl_vector_complex_set(eval, iu - 1, lambda);
gsl_vector_complex_set(eval, iu, lambda2);
/*
* First solve:
*
* [ T(i:i+1,i:i+1) - lambda*I ] * X = 0
*/
if (fabs(gsl_matrix_get(T, iu - 1, iu)) >=
fabs(gsl_matrix_get(T, iu, iu - 1)))
{
gsl_vector_set(w->work, iu - 1, 1.0);
gsl_vector_set(w->work2, iu,
lambda_im / gsl_matrix_get(T, iu - 1, iu));
}
else
{
gsl_vector_set(w->work, iu - 1,
-lambda_im / gsl_matrix_get(T, iu, iu - 1));
gsl_vector_set(w->work2, iu, 1.0);
}
gsl_vector_set(w->work, iu, 0.0);
gsl_vector_set(w->work2, iu - 1, 0.0);
/* construct right hand side */
for (k = 0; k < iu - 1; ++k)
{
gsl_vector_set(w->work, k,
-gsl_vector_get(w->work, iu - 1) *
gsl_matrix_get(T, k, iu - 1));
gsl_vector_set(w->work2, k,
-gsl_vector_get(w->work2, iu) *
gsl_matrix_get(T, k, iu));
}
/*
* We must solve the upper quasi-triangular system:
*
* [ T(1:i-2,1:i-2) - lambda*I ] * X = s*(work + i*work2)
*/
for (l = i - 2; l >= 0; --l)
{
size_t lu = (size_t) l;
if (lu == 0)
complex_pair = 0;
else
complex_pair = gsl_matrix_get(T, lu, lu - 1) != 0.0;
if (!complex_pair)
{
gsl_complex bval;
gsl_complex x;
/*
* 1-by-1 diagonal block - solve the system:
*
* (T_{ll} - lambda)*x = work + i*work2
*/
Tv = gsl_matrix_submatrix(T, lu, lu, 1, 1);
bv = gsl_vector_complex_view_array(dat, 1);
xv = gsl_vector_complex_view_array(dat_X, 1);
GSL_SET_COMPLEX(&bval,
gsl_vector_get(w->work, lu),
gsl_vector_get(w->work2, lu));
gsl_vector_complex_set(&bv.vector, 0, bval);
gsl_schur_solve_equation_z(1.0,
&Tv.matrix,
&lambda,
1.0,
1.0,
&bv.vector,
&xv.vector,
&scale,
&xnorm,
smin);
if (xnorm > 1.0)
{
if (gsl_vector_get(w->work3, lu) > bignum / xnorm)
{
gsl_blas_zdscal(1.0/xnorm, &xv.vector);
scale /= xnorm;
}
}
/* scale if necessary */
if (scale != 1.0)
{
gsl_vector_view wv;
wv = gsl_vector_subvector(w->work, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
wv = gsl_vector_subvector(w->work2, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
}
x = gsl_vector_complex_get(&xv.vector, 0);
gsl_vector_set(w->work, lu, GSL_REAL(x));
gsl_vector_set(w->work2, lu, GSL_IMAG(x));
/* update the right hand side */
if (lu > 0)
{
gsl_vector_view v1, v2;
v1 = gsl_matrix_subcolumn(T, lu, 0, lu);
v2 = gsl_vector_subvector(w->work, 0, lu);
gsl_blas_daxpy(-GSL_REAL(x), &v1.vector, &v2.vector);
v2 = gsl_vector_subvector(w->work2, 0, lu);
gsl_blas_daxpy(-GSL_IMAG(x), &v1.vector, &v2.vector);
} /* if (lu > 0) */
} /* if (!complex_pair) */
else
{
gsl_complex b1, b2, x1, x2;
/*
* 2-by-2 diagonal block - solve the system
*/
Tv = gsl_matrix_submatrix(T, lu - 1, lu - 1, 2, 2);
bv = gsl_vector_complex_view_array(dat, 2);
xv = gsl_vector_complex_view_array(dat_X, 2);
GSL_SET_COMPLEX(&b1,
gsl_vector_get(w->work, lu - 1),
gsl_vector_get(w->work2, lu - 1));
GSL_SET_COMPLEX(&b2,
gsl_vector_get(w->work, lu),
gsl_vector_get(w->work2, lu));
gsl_vector_complex_set(&bv.vector, 0, b1);
gsl_vector_complex_set(&bv.vector, 1, b2);
gsl_schur_solve_equation_z(1.0,
&Tv.matrix,
&lambda,
1.0,
1.0,
&bv.vector,
&xv.vector,
&scale,
&xnorm,
smin);
x1 = gsl_vector_complex_get(&xv.vector, 0);
x2 = gsl_vector_complex_get(&xv.vector, 1);
if (xnorm > 1.0)
{
double beta;
beta = GSL_MAX(gsl_vector_get(w->work3, lu - 1),
gsl_vector_get(w->work3, lu));
if (beta > bignum / xnorm)
{
gsl_blas_zdscal(1.0/xnorm, &xv.vector);
scale /= xnorm;
}
}
/* scale if necessary */
if (scale != 1.0)
{
gsl_vector_view wv;
wv = gsl_vector_subvector(w->work, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
wv = gsl_vector_subvector(w->work2, 0, iu + 1);
gsl_blas_dscal(scale, &wv.vector);
}
gsl_vector_set(w->work, lu - 1, GSL_REAL(x1));
gsl_vector_set(w->work, lu, GSL_REAL(x2));
gsl_vector_set(w->work2, lu - 1, GSL_IMAG(x1));
gsl_vector_set(w->work2, lu, GSL_IMAG(x2));
/* update right hand side */
if (lu > 1)
{
gsl_vector_view v1, v2, v3, v4;
v1 = gsl_matrix_subcolumn(T, lu - 1, 0, lu - 1);
v4 = gsl_matrix_subcolumn(T, lu, 0, lu - 1);
v2 = gsl_vector_subvector(w->work, 0, lu - 1);
v3 = gsl_vector_subvector(w->work2, 0, lu - 1);
gsl_blas_daxpy(-GSL_REAL(x1), &v1.vector, &v2.vector);
gsl_blas_daxpy(-GSL_REAL(x2), &v4.vector, &v2.vector);
gsl_blas_daxpy(-GSL_IMAG(x1), &v1.vector, &v3.vector);
gsl_blas_daxpy(-GSL_IMAG(x2), &v4.vector, &v3.vector);
} /* if (lu > 1) */
--l;
} /* if (complex_pair) */
} /* for (l = i - 2; l >= 0; --l) */
/*
* At this point, work + i*work2 is an eigenvector
* of T - backtransform to get an eigenvector of the
* original matrix
*/
y = gsl_matrix_column(Z, iu - 1);
y2 = gsl_matrix_column(Z, iu);
if (iu > 1)
{
gsl_vector_view x;
/* compute real part of eigenvectors */
Zv = gsl_matrix_submatrix(Z, 0, 0, N, iu - 1);
x = gsl_vector_subvector(w->work, 0, iu - 1);
gsl_blas_dgemv(CblasNoTrans,
1.0,
&Zv.matrix,
&x.vector,
gsl_vector_get(w->work, iu - 1),
&y.vector);
/* now compute the imaginary part */
x = gsl_vector_subvector(w->work2, 0, iu - 1);
gsl_blas_dgemv(CblasNoTrans,
1.0,
&Zv.matrix,
&x.vector,
gsl_vector_get(w->work2, iu),
&y2.vector);
}
else
{
gsl_blas_dscal(gsl_vector_get(w->work, iu - 1), &y.vector);
gsl_blas_dscal(gsl_vector_get(w->work2, iu), &y2.vector);
}
/*
* Now store the eigenvectors into evec - the real parts
* are Z(:,iu - 1) and the imaginary parts are
* +/- Z(:,iu)
*/
/* get views of the two eigenvector slots */
ecol = gsl_matrix_complex_column(evec, iu - 1);
ecol2 = gsl_matrix_complex_column(evec, iu);
/*
* save imaginary part first as it may get overwritten
* when copying the real part due to our storage scheme
* in Z/evec
*/
ev = gsl_vector_complex_imag(&ecol.vector);
ev2 = gsl_vector_complex_imag(&ecol2.vector);
scale = 0.0;
for (ii = 0; ii < N; ++ii)
{
double a = gsl_vector_get(&y2.vector, ii);
scale = GSL_MAX(scale,
fabs(a) + fabs(gsl_vector_get(&y.vector, ii)));
gsl_vector_set(&ev.vector, ii, a);
gsl_vector_set(&ev2.vector, ii, -a);
}
/* now save the real part */
ev = gsl_vector_complex_real(&ecol.vector);
ev2 = gsl_vector_complex_real(&ecol2.vector);
for (ii = 0; ii < N; ++ii)
{
double a = gsl_vector_get(&y.vector, ii);
gsl_vector_set(&ev.vector, ii, a);
gsl_vector_set(&ev2.vector, ii, a);
}
if (scale != 0.0)
scale = 1.0 / scale;
/* scale by largest element magnitude */
gsl_blas_zdscal(scale, &ecol.vector);
gsl_blas_zdscal(scale, &ecol2.vector);
/*
* decrement i since we took care of two eigenvalues at
* the same time
*/
--i;
} /* if (GSL_IMAG(lambda) != 0.0) */
} /* for (i = (int) N - 1; i >= 0; --i) */
} /* nonsymmv_get_right_eigenvectors() */
int
gsl_eigen_herm (gsl_matrix_complex * A, gsl_vector * eval,
gsl_eigen_herm_workspace * w)
{
if (A->size1 != A->size2)
{
GSL_ERROR ("matrix must be square to compute eigenvalues", GSL_ENOTSQR);
}
else if (eval->size != A->size1)
{
GSL_ERROR ("eigenvalue vector must match matrix size", GSL_EBADLEN);
}
else
{
const size_t N = A->size1;
double *const d = w->d;
double *const sd = w->sd;
size_t a, b;
/* handle special case */
if (N == 1)
{
gsl_complex A00 = gsl_matrix_complex_get (A, 0, 0);
gsl_vector_set (eval, 0, GSL_REAL(A00));
return GSL_SUCCESS;
}
{
gsl_vector_view d_vec = gsl_vector_view_array (d, N);
gsl_vector_view sd_vec = gsl_vector_view_array (sd, N - 1);
gsl_vector_complex_view tau_vec = gsl_vector_complex_view_array (w->tau, N-1);
gsl_linalg_hermtd_decomp (A, &tau_vec.vector);
gsl_linalg_hermtd_unpack_T (A, &d_vec.vector, &sd_vec.vector);
}
/* Make an initial pass through the tridiagonal decomposition
to remove off-diagonal elements which are effectively zero */
chop_small_elements (N, d, sd);
/* Progressively reduce the matrix until it is diagonal */
b = N - 1;
while (b > 0)
{
if (sd[b - 1] == 0.0 || isnan(sd[b - 1]))
{
b--;
continue;
}
/* Find the largest unreduced block (a,b) starting from b
and working backwards */
a = b - 1;
while (a > 0)
{
if (sd[a - 1] == 0.0)
{
break;
}
a--;
}
{
const size_t n_block = b - a + 1;
double *d_block = d + a;
double *sd_block = sd + a;
/* apply QR reduction with implicit deflation to the
unreduced block */
qrstep (n_block, d_block, sd_block, NULL, NULL);
/* remove any small off-diagonal elements */
chop_small_elements (n_block, d_block, sd_block);
}
}
{
gsl_vector_view d_vec = gsl_vector_view_array (d, N);
gsl_vector_memcpy (eval, &d_vec.vector);
}
return GSL_SUCCESS;
}
}
int main(void) {
gsl_matrix *TS; /* the training set of real waveforms */
gsl_matrix_complex *cTS; /* the training set of complex waveforms */
size_t TSsize; /* the size of the training set (number of waveforms) */
size_t wl; /* the length of each waveform */
size_t k = 0, j = 0, i = 0, nbases = 0, cnbases = 0;
REAL8 *RB = NULL; /* the real reduced basis set */
COMPLEX16 *cRB = NULL; /* the complex reduced basis set */
LALInferenceREALROQInterpolant *interp = NULL;
LALInferenceCOMPLEXROQInterpolant *cinterp = NULL;
gsl_vector *freqs;
double tolerance = TOLERANCE; /* tolerance for reduced basis generation loop */
TSsize = TSSIZE;
wl = WL;
/* allocate memory for training set */
TS = gsl_matrix_calloc(TSsize, wl);
cTS = gsl_matrix_complex_calloc(TSsize, wl);
/* the waveform model is just a simple chirp so set up chirp mass range for training set */
double fmin0 = 48, fmax0 = 256, f0 = 0., m0 = 0.;
double df = (fmax0-fmin0)/(wl-1.); /* model time steps */
freqs = gsl_vector_alloc(wl); /* times at which to calculate the model */
double Mcmax = 2., Mcmin = 1.5, Mc = 0.;
gsl_vector_view fweights = gsl_vector_view_array(&df, 1);
/* set up training sets (one real and one complex) */
for ( k=0; k < TSsize; k++ ){
Mc = pow(pow(Mcmin, 5./3.) + (double)k*(pow(Mcmax, 5./3.)-pow(Mcmin, 5./3.))/((double)TSsize-1), 3./5.);
for ( j=0; j < wl; j++ ){
f0 = fmin0 + (double)j*(fmax0-fmin0)/((double)wl-1.);
gsl_complex gctmp;
COMPLEX16 ctmp;
m0 = real_model(f0, Mc);
ctmp = imag_model(f0, Mc);
GSL_SET_COMPLEX(&gctmp, creal(ctmp), cimag(ctmp));
gsl_vector_set(freqs, j, f0);
gsl_matrix_set(TS, k, j, m0);
gsl_matrix_complex_set(cTS, k, j, gctmp);
}
}
/* create reduced orthonormal basis from training set */
if ( (RB = LALInferenceGenerateREAL8OrthonormalBasis(&fweights.vector, tolerance, TS, &nbases)) == NULL){
fprintf(stderr, "Error... problem producing basis\n");
return 1;
}
if ( (cRB = LALInferenceGenerateCOMPLEX16OrthonormalBasis(&fweights.vector, tolerance, cTS, &cnbases)) == NULL){
fprintf(stderr, "Error... problem producing basis\n");
return 1;
}
/* free the training set */
gsl_matrix_free(TS);
gsl_matrix_complex_free(cTS);
gsl_matrix_view RBview = gsl_matrix_view_array(RB, nbases, wl);
gsl_matrix_complex_view cRBview = gsl_matrix_complex_view_array((double*)cRB, cnbases, wl);
fprintf(stderr, "No. nodes (real) = %zu, %zu x %zu\n", nbases, RBview.matrix.size1, RBview.matrix.size2);
fprintf(stderr, "No. nodes (complex) = %zu, %zu x %zu\n", cnbases, cRBview.matrix.size1, cRBview.matrix.size2);
/* get the interpolant */
interp = LALInferenceGenerateREALROQInterpolant(&RBview.matrix);
cinterp = LALInferenceGenerateCOMPLEXROQInterpolant(&cRBview.matrix);
/* free the reduced basis */
XLALFree(RB);
XLALFree(cRB);
/* now get the terms for the likelihood with and without the reduced order quadrature
* and do some timing tests */
/* create the model dot model weights */
REAL8 varval = 1.;
gsl_vector_view vars = gsl_vector_view_array(&varval, 1);
gsl_matrix *mmw = LALInferenceGenerateREALModelModelWeights(interp->B, &vars.vector);
gsl_matrix_complex *cmmw = LALInferenceGenerateCOMPLEXModelModelWeights(cinterp->B, &vars.vector);
/* let's create some Gaussian random data */
const gsl_rng_type *T;
gsl_rng *r;
gsl_rng_env_setup();
T = gsl_rng_default;
r = gsl_rng_alloc(T);
REAL8 *data = XLALCalloc(wl, sizeof(REAL8));
COMPLEX16 *cdata = XLALCalloc(wl, sizeof(COMPLEX16));
for ( i=0; i<wl; i++ ){
data[i] = gsl_ran_gaussian(r, 1.0); /* real data */
cdata[i] = gsl_ran_gaussian(r, 1.0) + I*gsl_ran_gaussian(r, 1.0); /* complex data */
}
/* create the data dot model weights */
gsl_vector_view dataview = gsl_vector_view_array(data, wl);
gsl_vector *dmw = LALInferenceGenerateREAL8DataModelWeights(interp->B, &dataview.vector, &vars.vector);
gsl_vector_complex_view cdataview = gsl_vector_complex_view_array((double*)cdata, wl);
gsl_vector_complex *cdmw = LALInferenceGenerateCOMPLEX16DataModelWeights(cinterp->B, &cdataview.vector, &vars.vector);
/* pick a chirp mass and generate a model to compare likelihoods */
double randMc = 1.873; /* a random frequency to create a model */
gsl_vector *modelfull = gsl_vector_alloc(wl);
gsl_vector *modelreduced = gsl_vector_alloc(nbases);
gsl_vector_complex *cmodelfull = gsl_vector_complex_alloc(wl);
gsl_vector_complex *cmodelreduced = gsl_vector_complex_alloc(cnbases);
/* create models */
for ( i=0; i<wl; i++ ){
/* models at all frequencies */
gsl_vector_set(modelfull, i, real_model(gsl_vector_get(freqs, i), randMc));
COMPLEX16 cval = imag_model(gsl_vector_get(freqs, i), randMc);
gsl_complex gcval;
GSL_SET_COMPLEX(&gcval, creal(cval), cimag(cval));
gsl_vector_complex_set(cmodelfull, i, gcval);
}
/* models at interpolant nodes */
for ( i=0; i<nbases; i++ ){ /* real model */
gsl_vector_set(modelreduced, i, real_model(gsl_vector_get(freqs, interp->nodes[i]), randMc));
}
for ( i=0; i<cnbases; i++ ){ /* complex model */
COMPLEX16 cval = imag_model(gsl_vector_get(freqs, cinterp->nodes[i]), randMc);
gsl_complex gcval;
GSL_SET_COMPLEX(&gcval, creal(cval), cimag(cval));
gsl_vector_complex_set(cmodelreduced, i, gcval);
}
/* timing variables */
struct timeval t1, t2, t3, t4;
double dt1, dt2;
/* start with the real model */
/* get the model model term with the full model */
REAL8 mmfull, mmred;
gettimeofday(&t1, NULL);
XLAL_CALLGSL( gsl_blas_ddot(modelfull, modelfull, &mmfull) ); /* real model */
gettimeofday(&t2, NULL);
/* now get it with the reduced order quadrature */
gettimeofday(&t3, NULL);
mmred = LALInferenceROQREAL8ModelDotModel(mmw, modelreduced);
gettimeofday(&t4, NULL);
dt1 = (double)((t2.tv_sec + t2.tv_usec*1.e-6) - (t1.tv_sec + t1.tv_usec*1.e-6));
dt2 = (double)((t4.tv_sec + t4.tv_usec*1.e-6) - (t3.tv_sec + t3.tv_usec*1.e-6));
fprintf(stderr, "Real Signal:\n - M dot M (full) = %le [%.9lf s], M dot M (reduced) = %le [%.9lf s], time ratio = %lf\n", mmfull, dt1, mmred, dt2, dt1/dt2);
/* get the data model term with the full model */
REAL8 dmfull, dmred;
gettimeofday(&t1, NULL);
XLAL_CALLGSL( gsl_blas_ddot(&dataview.vector, modelfull, &dmfull) );
gettimeofday(&t2, NULL);
/* now get it with the reduced order quadrature */
gettimeofday(&t3, NULL);
dmred = LALInferenceROQREAL8DataDotModel(dmw, modelreduced);
gettimeofday(&t4, NULL);
dt1 = (double)((t2.tv_sec + t2.tv_usec*1.e-6) - (t1.tv_sec + t1.tv_usec*1.e-6));
dt2 = (double)((t4.tv_sec + t4.tv_usec*1.e-6) - (t3.tv_sec + t3.tv_usec*1.e-6));
fprintf(stderr, " - D dot M (full) = %le [%.9lf s], D dot M (reduced) = %le [%.9lf s], time ratio = %lf\n", dmfull, dt1, dmred, dt2, dt1/dt2);
/* check difference in log likelihoods */
double Lfull, Lred, Lfrac;
Lfull = mmfull - 2.*dmfull;
Lred = mmred - 2.*dmred;
Lfrac = 100.*fabs(Lfull-Lred)/fabs(Lfull); /* fractional log likelihood difference (in %) */
fprintf(stderr, " - Fractional difference in log likelihoods = %lf%%\n", Lfrac);
XLALFree(data);
gsl_vector_free(modelfull);
gsl_vector_free(modelreduced);
gsl_matrix_free(mmw);
gsl_vector_free(dmw);
/* check log likelihood difference is within tolerance */
if ( Lfrac > LTOL ) { return 1; }
/* now do the same with the complex model */
/* get the model model term with the full model */
COMPLEX16 cmmred, cmmfull;
gsl_complex cmmfulltmp;
gettimeofday(&t1, NULL);
XLAL_CALLGSL( gsl_blas_zdotc(cmodelfull, cmodelfull, &cmmfulltmp) ); /* complex model */
cmmfull = GSL_REAL(cmmfulltmp) + I*GSL_IMAG(cmmfulltmp);
gettimeofday(&t2, NULL);
gettimeofday(&t3, NULL);
cmmred = LALInferenceROQCOMPLEX16ModelDotModel(cmmw, cmodelreduced);
gettimeofday(&t4, NULL);
dt1 = (double)((t2.tv_sec + t2.tv_usec*1.e-6) - (t1.tv_sec + t1.tv_usec*1.e-6));
dt2 = (double)((t4.tv_sec + t4.tv_usec*1.e-6) - (t3.tv_sec + t3.tv_usec*1.e-6));
fprintf(stderr, "Complex Signal:\n - M dot M (full) = %le [%.9lf s], M dot M (reduced) = %le [%.9lf s], time ratio = %lf\n", creal(cmmfull), dt1, creal(cmmred), dt2, dt1/dt2);
COMPLEX16 cdmfull, cdmred;
gsl_complex cdmfulltmp;
gettimeofday(&t1, NULL);
XLAL_CALLGSL( gsl_blas_zdotc(&cdataview.vector, cmodelfull, &cdmfulltmp) );
cdmfull = GSL_REAL(cdmfulltmp) + I*GSL_IMAG(cdmfulltmp);
gettimeofday(&t2, NULL);
gettimeofday(&t3, NULL);
cdmred = LALInferenceROQCOMPLEX16DataDotModel(cdmw, cmodelreduced);
gettimeofday(&t4, NULL);
dt1 = (double)((t2.tv_sec + t2.tv_usec*1.e-6) - (t1.tv_sec + t1.tv_usec*1.e-6));
dt2 = (double)((t4.tv_sec + t4.tv_usec*1.e-6) - (t3.tv_sec + t3.tv_usec*1.e-6));
fprintf(stderr, " - D dot M (full) = %le [%.9lf s], D dot M (reduced) = %le [%.9lf s], time ratio = %lf\n", creal(cdmfull), dt1, creal(cdmred), dt2, dt1/dt2);
/* check difference in log likelihoods */
Lfull = creal(cmmfull) - 2.*creal(cdmfull);
Lred = creal(cmmred) - 2.*creal(cdmred);
Lfrac = 100.*fabs(Lfull-Lred)/fabs(Lfull); /* fractional log likelihood difference (in %) */
fprintf(stderr, " - Fractional difference in log likelihoods = %lf%%\n", Lfrac);
XLALFree(cdata);
gsl_vector_complex_free(cmodelfull);
gsl_vector_complex_free(cmodelreduced);
gsl_matrix_complex_free(cmmw);
gsl_vector_complex_free(cdmw);
LALInferenceRemoveREALROQInterpolant( interp );
LALInferenceRemoveCOMPLEXROQInterpolant( cinterp );
/* check log likelihood difference is within tolerance */
if ( Lfrac > LTOL ) { return 1; }
return 0;
}
