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; }