// Wald Test used in both summary and anova (polymophism)
int GlmTest::GeeWald(glm *Alt, gsl_matrix *LL, gsl_vector *teststat) {
gsl_set_error_handler_off();
unsigned int i, j, l;
double alpha, result, sum = 0;
unsigned int nP = Alt->nParams;
unsigned int nDF = LL->size1;
unsigned int nVars = tm->nVars, nRows = tm->nRows;
int status;
gsl_vector *LBeta = gsl_vector_alloc(nVars * nDF);
gsl_vector_set_zero(LBeta);
gsl_matrix *w1jX1 = gsl_matrix_alloc(nRows, nP);
gsl_matrix *XwX = gsl_matrix_alloc(nP, nP);
gsl_matrix *Rl2 = gsl_matrix_alloc(nDF, nP);
gsl_matrix *IinvN = gsl_matrix_alloc(nDF, nDF);
gsl_matrix *IinvRl = gsl_matrix_alloc(nVars * nDF, nVars * nDF);
gsl_vector *tmp = gsl_vector_alloc(nVars * nDF);
gsl_vector_view tmp2, wj, LBj, bj; //, dj;
gsl_matrix_view Rl;
gsl_matrix_set_zero(IinvRl);
GrpMat *Z = (GrpMat *)malloc(nVars * sizeof(GrpMat));
for (j = 0; j < nVars; j++) {
Z[j].matrix = gsl_matrix_alloc(nP, nRows);
// w1jX1 = W^1/2 * X
wj = gsl_matrix_column(Alt->wHalf, j);
for (i = 0; i < nP; i++)
gsl_matrix_set_col(w1jX1, i, &wj.vector);
gsl_matrix_mul_elements(w1jX1, Alt->Xref);
// LBeta = L*Beta
LBj = gsl_vector_subvector(LBeta, j * nDF, nDF);
bj = gsl_matrix_column(Alt->Beta, j);
gsl_blas_dgemv(CblasNoTrans, 1, LL, &bj.vector, 0, &LBj.vector);
// Z = (X^T W X)^-1 * X^T W^1/2.
gsl_matrix_set_identity(XwX);
gsl_blas_dsyrk(CblasLower, CblasTrans, 1.0, w1jX1, 0.0, XwX);
status = gsl_linalg_cholesky_decomp(XwX);
if (status == GSL_EDOM) {
if (tm->warning == TRUE)
printf("Warning:singular matrix in wald test. An eps*I is added to the "
"singular matrix.\n");
gsl_matrix_set_identity(XwX);
gsl_blas_dsyrk(CblasLower, CblasTrans, 1.0, w1jX1, eps, XwX);
gsl_linalg_cholesky_decomp(XwX);
}
gsl_linalg_cholesky_invert(XwX);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, XwX, w1jX1, 0.0, Z[j].matrix);
gsl_matrix_memcpy(Rl2, LL);
gsl_blas_dtrmm(CblasRight, CblasLower, CblasNoTrans, CblasNonUnit, 1.0, XwX,
Rl2); // L*(X'WX)^-1
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, Rl2, LL, 0.0,
IinvN); // L*(X^T*W*X)^-1*L^T
if ((tm->punit != NONE) || (tm->corr == IDENTITY)) {
status = gsl_linalg_cholesky_decomp(IinvN);
if (status == GSL_EDOM) {
if (tm->warning == TRUE)
printf("Warning:singular IinvN in wald test.\n");
}
tmp2 = gsl_vector_subvector(tmp, 0, nDF);
gsl_linalg_cholesky_solve(IinvN, &LBj.vector, &tmp2.vector);
gsl_blas_ddot(&LBj.vector, &tmp2.vector, &result);
gsl_vector_set(teststat, j + 1, sqrt(result));
sum = sum + result;
}
if (tm->corr != IDENTITY) {
// IinvRl=L*vSandRl*L^T
for (l = 0; l <= j; l++) {
Rl = gsl_matrix_submatrix(IinvRl, j * nDF, l * nDF, nDF, nDF);
alpha = gsl_matrix_get(Rlambda, j, l);
// borrow XwX space to store vSandRl
gsl_blas_dgemm(CblasNoTrans, CblasTrans, alpha, Z[j].matrix,
Z[l].matrix, 0.0, XwX);
// Rl2 = L*vSandRl*L^T
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, LL, XwX, 0.0, Rl2);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, Rl2, LL, 0.0, &Rl.matrix);
} // end l
} // end if (tm->corr)
} // end for j=1:nVars
if (tm->corr == IDENTITY)
gsl_vector_set(teststat, 0, sqrt(sum));
else {
status = gsl_linalg_cholesky_decomp(IinvRl);
if (status == GSL_EDOM) {
if (tm->warning == TRUE)
printf("Warning:singular matrix in multivariate wald test.\n");
}
gsl_linalg_cholesky_solve(IinvRl, LBeta, tmp);
gsl_blas_ddot(LBeta, tmp, &result);
gsl_vector_set(teststat, 0, sqrt(result));
}
// free memory
for (j = 0; j < nVars; j++)
gsl_matrix_free(Z[j].matrix);
free(Z);
gsl_vector_free(LBeta);
gsl_matrix_free(w1jX1);
gsl_matrix_free(XwX);
gsl_matrix_free(Rl2);
gsl_matrix_free(IinvN);
gsl_matrix_free(IinvRl);
gsl_vector_free(tmp);
return SUCCESS;
}
static void
hybrid_free (void *vstate)
{
hybrid_state_t *state = (hybrid_state_t *) vstate;
gsl_vector_free (state->v);
gsl_vector_free (state->w);
gsl_vector_free (state->rdx);
gsl_vector_free (state->qtdf);
gsl_vector_free (state->df);
gsl_vector_free (state->f_trial);
gsl_vector_free (state->x_trial);
gsl_vector_free (state->gradient);
gsl_vector_free (state->newton);
gsl_vector_free (state->qtf);
gsl_vector_free (state->diag);
gsl_vector_free (state->tau);
gsl_matrix_free (state->r);
gsl_matrix_free (state->q);
gsl_matrix_free (state->J);
}
/* Run PAM */
static void pam_run(pam_partition p, size_t max_iters)
{
if (p->k == p->M->size1) {
/* Simple case */
return;
}
size_t i, j, k, m, n, trimmed_size = p->M->size1 - p->k,
any_swaps = 0,
iter = 0;
size_t *medoids, *trimmed;
double c, current_cost;
gsl_vector *cost = gsl_vector_alloc(trimmed_size);
gsl_vector_ulong *cl_index = gsl_vector_ulong_alloc(p->cl_index->size);
gsl_vector *cl_dist = gsl_vector_alloc(p->cl_dist->size);
medoids = malloc(sizeof(size_t) * p->k);
trimmed = malloc(sizeof(size_t) * (p->M->size1 - p->k));
j = 0;
k = 0;
for (i = 0; i < p->M->size1; i++) {
if (gsl_vector_uchar_get(p->in_set, i))
medoids[j++] = i;
else {
assert(!pam_always_select(p, i));
trimmed[k++] = i;
}
}
assert(j == p->k);
assert(k == p->M->size1 - p->k);
do {
if (PAM_VERBOSE)
fprintf(stderr, "Iteration %lu\n", iter);
any_swaps = 0;
/* For every medoid, m, swap with every non-medoid, compute cost */
for (i = 0; i < p->k; i++) {
m = medoids[i];
/* If medoid is in the always_select set, no action. */
if (pam_always_select(p, m))
continue;
current_cost = pam_total_cost(p);
/* Try every non-medoid */
gsl_vector_set_all(cost, FLT_MAX);
for (j = 0; j < trimmed_size; j++) {
n = trimmed[j];
c = pam_swap_update_cost(p, m, n, cl_index, cl_dist);
gsl_vector_set(cost, j, c);
}
/* Find the minimum cost from all swaps */
j = gsl_vector_min_index(cost);
if (gsl_vector_get(cost, j) < current_cost) {
/* Current cost beaten */
any_swaps = 1;
n = trimmed[j];
assert(n != m);
assert(!gsl_vector_uchar_get(p->in_set, n));
assert(gsl_vector_uchar_get(p->in_set, m));
if (PAM_VERBOSE)
fprintf(stderr, "SWAP: %lu->%lu [%f -> %f]\n", m, n,
current_cost, gsl_vector_get(cost, j));
gsl_vector_uchar_swap_elements(p->in_set, m, n);
/* Move n to medoids, m to trimmed */
trimmed[j] = m;
medoids[i] = n;
/* Recalculate cached values */
pam_swap_cost(p, m, n);
}
}
}
while (any_swaps && ++iter < max_iters);
if (PAM_VERBOSE) {
fprintf(stderr, "Done in %lu iterations. Final config:\n", iter);
gsl_vector_uchar_fprintf(stderr, p->in_set, "%d");
fprintf(stderr, "Final cost: %f\n", pam_total_cost(p));
}
gsl_vector_free(cost);
gsl_vector_ulong_free(cl_index);
gsl_vector_free(cl_dist);
free(medoids);
free(trimmed);
}
static int
lmder_alloc (void *vstate, size_t n, size_t p)
{
lmder_state_t *state = (lmder_state_t *) vstate;
gsl_matrix *r;
gsl_vector *tau, *diag, *qtf, *newton, *gradient, *x_trial, *f_trial,
*df, *sdiag, *rptdx, *w, *work1;
gsl_permutation *perm;
r = gsl_matrix_calloc (n, p);
if (r == 0)
{
GSL_ERROR ("failed to allocate space for r", GSL_ENOMEM);
}
state->r = r;
tau = gsl_vector_calloc (GSL_MIN(n, p));
if (tau == 0)
{
gsl_matrix_free (r);
GSL_ERROR ("failed to allocate space for tau", GSL_ENOMEM);
}
state->tau = tau;
diag = gsl_vector_calloc (p);
if (diag == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
GSL_ERROR ("failed to allocate space for diag", GSL_ENOMEM);
}
state->diag = diag;
qtf = gsl_vector_calloc (n);
if (qtf == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
GSL_ERROR ("failed to allocate space for qtf", GSL_ENOMEM);
}
state->qtf = qtf;
newton = gsl_vector_calloc (p);
if (newton == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
GSL_ERROR ("failed to allocate space for newton", GSL_ENOMEM);
}
state->newton = newton;
gradient = gsl_vector_calloc (p);
if (gradient == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
GSL_ERROR ("failed to allocate space for gradient", GSL_ENOMEM);
}
state->gradient = gradient;
x_trial = gsl_vector_calloc (p);
if (x_trial == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
GSL_ERROR ("failed to allocate space for x_trial", GSL_ENOMEM);
}
state->x_trial = x_trial;
f_trial = gsl_vector_calloc (n);
if (f_trial == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
GSL_ERROR ("failed to allocate space for f_trial", GSL_ENOMEM);
}
state->f_trial = f_trial;
df = gsl_vector_calloc (n);
if (df == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
GSL_ERROR ("failed to allocate space for df", GSL_ENOMEM);
}
state->df = df;
sdiag = gsl_vector_calloc (p);
if (sdiag == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
GSL_ERROR ("failed to allocate space for sdiag", GSL_ENOMEM);
}
state->sdiag = sdiag;
rptdx = gsl_vector_calloc (n);
if (rptdx == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
gsl_vector_free (sdiag);
GSL_ERROR ("failed to allocate space for rptdx", GSL_ENOMEM);
}
state->rptdx = rptdx;
w = gsl_vector_calloc (n);
if (w == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
gsl_vector_free (sdiag);
gsl_vector_free (rptdx);
GSL_ERROR ("failed to allocate space for w", GSL_ENOMEM);
}
state->w = w;
work1 = gsl_vector_calloc (p);
if (work1 == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
gsl_vector_free (sdiag);
gsl_vector_free (rptdx);
gsl_vector_free (w);
GSL_ERROR ("failed to allocate space for work1", GSL_ENOMEM);
}
state->work1 = work1;
perm = gsl_permutation_calloc (p);
if (perm == 0)
{
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
gsl_vector_free (sdiag);
gsl_vector_free (rptdx);
gsl_vector_free (w);
gsl_vector_free (work1);
GSL_ERROR ("failed to allocate space for perm", GSL_ENOMEM);
}
state->perm = perm;
return GSL_SUCCESS;
}
int DPMHC_S_smplr(struct str_DPMHC *ptr_DPMHC_data)
{
int i_K = ptr_DPMHC_data->i_K;
gsl_vector *v_y = ptr_DPMHC_data->v_y;
gsl_vector *v_w = ptr_DPMHC_data->v_w;
gsl_vector *v_u = ptr_DPMHC_data->v_u;
gsl_vector_int *vi_S = ptr_DPMHC_data->vi_S;
gsl_vector_int *vi_n = ptr_DPMHC_data->vi_n;
gsl_matrix *m_DPtheta = ptr_DPMHC_data->m_DPtheta;
size_t i_n=v_y->size;
gsl_vector *v_p = gsl_vector_calloc (i_K);
gsl_vector_int *vi_cnt = gsl_vector_int_calloc (i_K);
int i,j,st,ism;
double sm,dn;
double d_yi,d_muj,d_xij,d_tauj;
gsl_vector_int_set_zero ( vi_cnt );
gsl_vector_int_set_zero ( vi_n );
for(i=0;i<i_n;i++){
//printf("i=%d\n",i);
d_yi = v_y->data[i];
sm=0.0;
for(j=0;j<i_K;j++){
if( vget(v_w,j) <= vget(v_u,i) ){
vset(v_p,j,0.0);
// printf("w_j,u_i %g %g",vget(w,j),vget(u,i));
}else{
// printf("K=%d\n",i_K);
// dn = den_norm_prec ( vget(y,i), mget(theta,j,0), mget(theta,j,1) );
d_muj = mget(m_DPtheta,j,0);
d_xij = mget(m_DPtheta,j,1);
d_tauj = mget(m_DPtheta,j,2);
dn = exp( log_nor(d_yi, d_muj, fabs(d_xij) * fabs(d_xij) / d_tauj ));
vset(v_p,j,dn);
sm+=dn;
//printf("p>0\n");
}
}
/* standardize */
gsl_vector_scale( v_p, 1.0/sm );
// pvec(p);
/* take draw */
st = (int)ran_multinomial( v_p, i_K-1 );
vset_int(vi_S,i,st);
vset_int(vi_cnt,st,1);
(vi_n->data[st])++;
}
/* find number of clusters with at least one observation assigned to it */
ism=0;
for(j=0;j<i_K;j++){
if( vget_int(vi_cnt,j) == 1)ism++;
}
ptr_DPMHC_data->i_m = ism;
gsl_vector_free (v_p);
gsl_vector_int_free (vi_cnt);
return 0;
}
void QwtHistogram::loadData()
{
if (d_matrix){
loadDataFromMatrix();
return;
}
int r = abs(d_end_row - d_start_row) + 1;
QVarLengthArray<double> Y(r);
int ycol = d_table->colIndex(title().text());
int size = 0;
for (int i = 0; i<r; i++ ){
QString yval = d_table->text(i, ycol);
if (!yval.isEmpty()){
bool valid_data = true;
Y[size] = ((Graph *)plot())->locale().toDouble(yval, &valid_data);
if (valid_data)
size++;
}
}
if(size < 2 || (size==2 && Y[0] == Y[1])){//non valid histogram
double X[2];
Y.resize(2);
for (int i = 0; i<2; i++ ){
Y[i] = 0;
X[i] = 0;
}
setData(X, Y.data(), 2);
return;
}
int n;
gsl_histogram *h;
if (d_autoBin){
n = 10;
h = gsl_histogram_alloc (n);
if (!h)
return;
gsl_vector *v = gsl_vector_alloc (size);
for (int i = 0; i<size; i++ )
gsl_vector_set (v, i, Y[i]);
double min, max;
gsl_vector_minmax (v, &min, &max);
gsl_vector_free (v);
d_begin = floor(min);
d_end = ceil(max);
d_bin_size = (d_end - d_begin)/(double)n;
gsl_histogram_set_ranges_uniform (h, floor(min), ceil(max));
} else {
n = int((d_end - d_begin)/d_bin_size + 1);
h = gsl_histogram_alloc (n);
if (!h)
return;
double *range = new double[n+2];
for (int i = 0; i<= n+1; i++ )
range[i] = d_begin + i*d_bin_size;
gsl_histogram_set_ranges (h, range, n+1);
delete[] range;
}
for (int i = 0; i<size; i++ )
gsl_histogram_increment (h, Y[i]);
#ifdef Q_CC_MSVC
QVarLengthArray<double> X(n); //stores ranges (x) and bins (y)
#else
double X[n]; //stores ranges (x) and bins (y)
#endif
Y.resize(n);
for (int i = 0; i<n; i++ ){
Y[i] = gsl_histogram_get (h, i);
double lower, upper;
gsl_histogram_get_range (h, i, &lower, &upper);
X[i] = lower;
}
#ifdef Q_CC_MSVC
setData(X.data(), Y.data(), n);
#else
setData(X, Y.data(), n);
#endif
d_mean = gsl_histogram_mean(h);
d_standard_deviation = gsl_histogram_sigma(h);
d_min = gsl_histogram_min_val(h);
d_max = gsl_histogram_max_val(h);
gsl_histogram_free (h);
}
/* Produce a vector of chisquared values as a function of frequency */
void fastChi(const double *sampletimes, const float *vals, const float *stderrs,
long ndata, long nharmonics, double deltat,
long nrealpoints, long nchivalues, double tstart,
float *dovstorage, float *oovstorage,
float *chireductionlist)
{
int d;
int i;
int h;
float invdeltat = 1/deltat;
gsl_matrix *alpha = gsl_matrix_alloc(2 * nharmonics + 1,2 * nharmonics + 1);
gsl_vector *beta = gsl_vector_alloc(2 * nharmonics + 1);
gsl_vector *x = gsl_vector_alloc(2 * nharmonics + 1);
float *cosdata = malloc((nharmonics + 1) * sizeof(float));
float *sindata = malloc((nharmonics + 1) * sizeof(float));
float *cosvar = malloc((2*nharmonics + 1) * sizeof(float));
float *sinvar = malloc((2*nharmonics + 1) * sizeof(float));
/* if the pointers point somewhere, assume that they point to the right place */
assert(sampletimes && vals && stderrs && dovstorage && oovstorage && chireductionlist);
assert(nchivalues * 2 * nharmonics <= nrealpoints); /* FIXME: change 2 to 1 when */
/* using aliasing */
assert(cosdata && sindata && cosvar && sinvar);
memset(dovstorage, 0, nrealpoints * sizeof(float));
memset(oovstorage, 0, nrealpoints * sizeof(float));
for (d = 0 ; d < ndata ; d++)
{
long tindex = (sampletimes[d] - tstart) * invdeltat;
float inv_variance = 1/(stderrs[d] * stderrs[d]);
assert(tindex >= 0 && tindex < nrealpoints);
/* adding rather than setting averages measurments that */
/* fall in same timebin. It does, however, reduce the d.o.f. */
/* and subsequently improperly reduces the chisquared. */
/* This is a minor point. */
/* dov: _d_ata _o_ver _v_ariance oov: _o_ne _o_ver _v_ariance */
dovstorage[tindex] += vals[d] * inv_variance;
oovstorage[tindex] += inv_variance;
}
gsl_fft_real_float_radix2_transform(dovstorage, 1, nrealpoints);
gsl_fft_real_float_radix2_transform(oovstorage, 1, nrealpoints);
cosdata[0] = dovstorage[0]; /* The constant (0f) terms are the same for all f */
cosvar[0] = oovstorage[0];
for (i = 1 ; i < nchivalues ; i++)
{
for (h = 1 ; h <= nharmonics ; h++)
{
cosdata[h] = dovstorage[i*h];
sindata[h] = dovstorage[nrealpoints - (i * h)] * FFTSIGNCONVENTION;
}
for (h = 1 ; h <= 2*nharmonics ; h++)
{ /* put alias wrapping in here */
cosvar[h] = oovstorage[i*h];
sinvar[h] = oovstorage[nrealpoints - (i * h)] * FFTSIGNCONVENTION;
}
chireductionlist[i]
= calcChiReduction(nharmonics,
cosdata, sindata, cosvar, sinvar,
alpha, beta, x);
}
gsl_matrix_free(alpha);
gsl_vector_free(beta);
gsl_vector_free(x);
free(cosdata);
free(sindata);
free(cosvar);
free(sinvar);
}
/** Executes the algorithm
*
* @throw runtime_error Thrown if algorithm cannot execute
*/
void DiffractionEventCalibrateDetectors::exec() {
// Try to retrieve optional properties
const int maxIterations = getProperty("MaxIterations");
const double peakOpt = getProperty("LocationOfPeakToOptimize");
// Get the input workspace
EventWorkspace_sptr inputW = getProperty("InputWorkspace");
// retrieve the properties
const std::string rb_params = getProperty("Params");
// Get some stuff from the input workspace
// We make a copy of the instrument since we will be moving detectors in
// `inputW` but want to access original positions (etc.) via `detList` below.
const auto &dummyW = create<EventWorkspace>(*inputW, 1, inputW->binEdges(0));
Instrument_const_sptr inst = dummyW->getInstrument();
// Build a list of Rectangular Detectors
std::vector<boost::shared_ptr<RectangularDetector>> detList;
// --------- Loading only one bank ----------------------------------
std::string onebank = getProperty("BankName");
bool doOneBank = (!onebank.empty());
for (int i = 0; i < inst->nelements(); i++) {
boost::shared_ptr<RectangularDetector> det;
boost::shared_ptr<ICompAssembly> assem;
boost::shared_ptr<ICompAssembly> assem2;
det = boost::dynamic_pointer_cast<RectangularDetector>((*inst)[i]);
if (det) {
if (det->getName() == onebank)
detList.push_back(det);
if (!doOneBank)
detList.push_back(det);
} else {
// Also, look in the first sub-level for RectangularDetectors (e.g. PG3).
// We are not doing a full recursive search since that will be very long
// for lots of pixels.
assem = boost::dynamic_pointer_cast<ICompAssembly>((*inst)[i]);
if (assem) {
for (int j = 0; j < assem->nelements(); j++) {
det = boost::dynamic_pointer_cast<RectangularDetector>((*assem)[j]);
if (det) {
if (det->getName() == onebank)
detList.push_back(det);
if (!doOneBank)
detList.push_back(det);
} else {
// Also, look in the second sub-level for RectangularDetectors (e.g.
// PG3).
// We are not doing a full recursive search since that will be very
// long for lots of pixels.
assem2 = boost::dynamic_pointer_cast<ICompAssembly>((*assem)[j]);
if (assem2) {
for (int k = 0; k < assem2->nelements(); k++) {
det = boost::dynamic_pointer_cast<RectangularDetector>(
(*assem2)[k]);
if (det) {
if (det->getName() == onebank)
detList.push_back(det);
if (!doOneBank)
detList.push_back(det);
}
}
}
}
}
}
}
}
// set-up minimizer
std::string inname = getProperty("InputWorkspace");
std::string outname = inname + "2"; // getProperty("OutputWorkspace");
IAlgorithm_sptr algS = createChildAlgorithm("SortEvents");
algS->setProperty("InputWorkspace", inputW);
algS->setPropertyValue("SortBy", "X Value");
algS->executeAsChildAlg();
// Write DetCal File
std::string filename = getProperty("DetCalFilename");
std::fstream outfile;
outfile.open(filename.c_str(), std::ios::out);
if (detList.size() > 1) {
outfile << "#\n";
outfile << "# Mantid Optimized .DetCal file for SNAP with TWO detector "
"panels\n";
outfile << "# Old Panel, nominal size and distance at -90 degrees.\n";
outfile << "# New Panel, nominal size and distance at +90 degrees.\n";
outfile << "#\n";
outfile << "# Lengths are in centimeters.\n";
outfile << "# Base and up give directions of unit vectors for a local\n";
outfile << "# x,y coordinate system on the face of the detector.\n";
outfile << "#\n";
outfile << "# " << DateAndTime::getCurrentTime().toFormattedString("%c")
<< "\n";
outfile << "#\n";
outfile << "6 L1 T0_SHIFT\n";
IComponent_const_sptr source = inst->getSource();
IComponent_const_sptr sample = inst->getSample();
outfile << "7 " << source->getDistance(*sample) * 100 << " 0\n";
outfile << "4 DETNUM NROWS NCOLS WIDTH HEIGHT DEPTH DETD "
"CenterX CenterY CenterZ BaseX BaseY BaseZ "
"UpX UpY UpZ\n";
}
Progress prog(this, 0.0, 1.0, detList.size());
for (int det = 0; det < static_cast<int>(detList.size()); det++) {
std::string par[6];
par[0] = detList[det]->getName();
par[1] = inname;
par[2] = outname;
std::ostringstream strpeakOpt;
strpeakOpt << peakOpt;
par[3] = strpeakOpt.str();
par[4] = rb_params;
// --- Create a GroupingWorkspace for this detector name ------
CPUTimer tim;
IAlgorithm_sptr alg2 =
AlgorithmFactory::Instance().create("CreateGroupingWorkspace", 1);
alg2->initialize();
alg2->setProperty("InputWorkspace", inputW);
alg2->setPropertyValue("GroupNames", detList[det]->getName());
std::string groupWSName = "group_" + detList[det]->getName();
alg2->setPropertyValue("OutputWorkspace", groupWSName);
alg2->executeAsChildAlg();
par[5] = groupWSName;
std::cout << tim << " to CreateGroupingWorkspace\n";
const gsl_multimin_fminimizer_type *T = gsl_multimin_fminimizer_nmsimplex;
gsl_vector *ss, *x;
gsl_multimin_function minex_func;
// finally do the fitting
int nopt = 6;
int iter = 0;
int status = 0;
/* Starting point */
x = gsl_vector_alloc(nopt);
gsl_vector_set(x, 0, 0.0);
gsl_vector_set(x, 1, 0.0);
gsl_vector_set(x, 2, 0.0);
gsl_vector_set(x, 3, 0.0);
gsl_vector_set(x, 4, 0.0);
gsl_vector_set(x, 5, 0.0);
/* Set initial step sizes to 0.1 */
ss = gsl_vector_alloc(nopt);
gsl_vector_set_all(ss, 0.1);
/* Initialize method and iterate */
minex_func.n = nopt;
minex_func.f = &Mantid::Algorithms::gsl_costFunction;
minex_func.params = ∥
gsl_multimin_fminimizer *s = gsl_multimin_fminimizer_alloc(T, nopt);
gsl_multimin_fminimizer_set(s, &minex_func, x, ss);
do {
iter++;
status = gsl_multimin_fminimizer_iterate(s);
if (status)
break;
double size = gsl_multimin_fminimizer_size(s);
status = gsl_multimin_test_size(size, 1e-2);
} while (status == GSL_CONTINUE && iter < maxIterations &&
s->fval != -0.000);
// Output summary to log file
if (s->fval != -0.000)
movedetector(gsl_vector_get(s->x, 0), gsl_vector_get(s->x, 1),
gsl_vector_get(s->x, 2), gsl_vector_get(s->x, 3),
gsl_vector_get(s->x, 4), gsl_vector_get(s->x, 5), par[0],
getProperty("InputWorkspace"));
else {
gsl_vector_set(s->x, 0, 0.0);
gsl_vector_set(s->x, 1, 0.0);
gsl_vector_set(s->x, 2, 0.0);
gsl_vector_set(s->x, 3, 0.0);
gsl_vector_set(s->x, 4, 0.0);
gsl_vector_set(s->x, 5, 0.0);
}
std::string reportOfDiffractionEventCalibrateDetectors =
gsl_strerror(status);
if (s->fval == -0.000)
reportOfDiffractionEventCalibrateDetectors = "No events";
g_log.information() << "Detector = " << det << "\n"
<< "Method used = "
<< "Simplex"
<< "\n"
<< "Iteration = " << iter << "\n"
<< "Status = "
<< reportOfDiffractionEventCalibrateDetectors << "\n"
<< "Minimize PeakLoc-" << peakOpt << " = " << s->fval
<< "\n";
// Move in cm for small shifts
g_log.information() << "Move (X) = " << gsl_vector_get(s->x, 0) * 0.01
<< " \n";
g_log.information() << "Move (Y) = " << gsl_vector_get(s->x, 1) * 0.01
<< " \n";
g_log.information() << "Move (Z) = " << gsl_vector_get(s->x, 2) * 0.01
<< " \n";
g_log.information() << "Rotate (X) = " << gsl_vector_get(s->x, 3) << " \n";
g_log.information() << "Rotate (Y) = " << gsl_vector_get(s->x, 4) << " \n";
g_log.information() << "Rotate (Z) = " << gsl_vector_get(s->x, 5) << " \n";
Kernel::V3D CalCenter =
V3D(gsl_vector_get(s->x, 0) * 0.01, gsl_vector_get(s->x, 1) * 0.01,
gsl_vector_get(s->x, 2) * 0.01);
Kernel::V3D Center = detList[det]->getPos() + CalCenter;
int pixmax = detList[det]->xpixels() - 1;
int pixmid = (detList[det]->ypixels() - 1) / 2;
BoundingBox box;
detList[det]->getAtXY(pixmax, pixmid)->getBoundingBox(box);
double baseX = box.xMax();
double baseY = box.yMax();
double baseZ = box.zMax();
Kernel::V3D Base = V3D(baseX, baseY, baseZ) + CalCenter;
pixmid = (detList[det]->xpixels() - 1) / 2;
pixmax = detList[det]->ypixels() - 1;
detList[det]->getAtXY(pixmid, pixmax)->getBoundingBox(box);
double upX = box.xMax();
double upY = box.yMax();
double upZ = box.zMax();
Kernel::V3D Up = V3D(upX, upY, upZ) + CalCenter;
Base -= Center;
Up -= Center;
// Rotate around x
baseX = Base[0];
baseY = Base[1];
baseZ = Base[2];
double deg2rad = M_PI / 180.0;
double angle = gsl_vector_get(s->x, 3) * deg2rad;
Base = V3D(baseX, baseY * cos(angle) - baseZ * sin(angle),
baseY * sin(angle) + baseZ * cos(angle));
upX = Up[0];
upY = Up[1];
upZ = Up[2];
Up = V3D(upX, upY * cos(angle) - upZ * sin(angle),
upY * sin(angle) + upZ * cos(angle));
// Rotate around y
baseX = Base[0];
baseY = Base[1];
baseZ = Base[2];
angle = gsl_vector_get(s->x, 4) * deg2rad;
Base = V3D(baseZ * sin(angle) + baseX * cos(angle), baseY,
baseZ * cos(angle) - baseX * sin(angle));
upX = Up[0];
upY = Up[1];
upZ = Up[2];
Up = V3D(upZ * cos(angle) - upX * sin(angle), upY,
upZ * sin(angle) + upX * cos(angle));
// Rotate around z
baseX = Base[0];
baseY = Base[1];
baseZ = Base[2];
angle = gsl_vector_get(s->x, 5) * deg2rad;
Base = V3D(baseX * cos(angle) - baseY * sin(angle),
baseX * sin(angle) + baseY * cos(angle), baseZ);
upX = Up[0];
upY = Up[1];
upZ = Up[2];
Up = V3D(upX * cos(angle) - upY * sin(angle),
upX * sin(angle) + upY * cos(angle), upZ);
Base.normalize();
Up.normalize();
Center *= 100.0;
// << det+1 << " "
outfile << "5 " << detList[det]->getName().substr(4) << " "
<< detList[det]->xpixels() << " " << detList[det]->ypixels()
<< " " << 100.0 * detList[det]->xsize() << " "
<< 100.0 * detList[det]->ysize() << " "
<< "0.2000"
<< " " << Center.norm() << " ";
Center.write(outfile);
outfile << " ";
Base.write(outfile);
outfile << " ";
Up.write(outfile);
outfile << "\n";
// clean up dynamically allocated gsl stuff
gsl_vector_free(x);
gsl_vector_free(ss);
gsl_multimin_fminimizer_free(s);
// Remove the now-unneeded grouping workspace
AnalysisDataService::Instance().remove(groupWSName);
prog.report(detList[det]->getName());
}
// Closing
outfile.close();
}
// [[Rcpp::export]]
Rcpp::List fitData(Rcpp::DataFrame D) {
const size_t ncoeffs = NCOEFFS;
const size_t nbreak = NBREAK;
const size_t n = N;
size_t i, j;
RcppGSL::vector<double> y = D["y"]; // access columns by name,
RcppGSL::vector<double> x = D["x"]; // assigning to GSL vectors
RcppGSL::vector<double> w = D["w"];
gsl_bspline_workspace *bw;
gsl_vector *B;
gsl_vector *c;
gsl_matrix *X, *cov;
gsl_multifit_linear_workspace *mw;
double chisq, Rsq, dof, tss;
bw = gsl_bspline_alloc(4, nbreak); // allocate a cubic bspline workspace (k = 4)
B = gsl_vector_alloc(ncoeffs);
X = gsl_matrix_alloc(n, ncoeffs);
c = gsl_vector_alloc(ncoeffs);
cov = gsl_matrix_alloc(ncoeffs, ncoeffs);
mw = gsl_multifit_linear_alloc(n, ncoeffs);
gsl_bspline_knots_uniform(0.0, 15.0, bw); // use uniform breakpoints on [0, 15]
for (i = 0; i < n; ++i) { // construct the fit matrix X
double xi = gsl_vector_get(x, i);
gsl_bspline_eval(xi, B, bw); // compute B_j(xi) for all j
for (j = 0; j < ncoeffs; ++j) { // fill in row i of X
double Bj = gsl_vector_get(B, j);
gsl_matrix_set(X, i, j, Bj);
}
}
gsl_multifit_wlinear(X, w, y, c, cov, &chisq, mw); // do the fit
dof = n - ncoeffs;
tss = gsl_stats_wtss(w->data, 1, y->data, 1, y->size);
Rsq = 1.0 - chisq / tss;
Rcpp::NumericVector FX(151), FY(151); // output the smoothed curve
double xi, yi, yerr;
for (xi = 0.0, i=0; xi < 15.0; xi += 0.1, i++) {
gsl_bspline_eval(xi, B, bw);
gsl_multifit_linear_est(B, c, cov, &yi, &yerr);
FX[i] = xi;
FY[i] = yi;
}
Rcpp::List res =
Rcpp::List::create(Rcpp::Named("X")=FX,
Rcpp::Named("Y")=FY,
Rcpp::Named("chisqdof")=Rcpp::wrap(chisq/dof),
Rcpp::Named("rsq")=Rcpp::wrap(Rsq));
gsl_bspline_free(bw);
gsl_vector_free(B);
gsl_matrix_free(X);
gsl_vector_free(c);
gsl_matrix_free(cov);
gsl_multifit_linear_free(mw);
y.free();
x.free();
w.free();
return(res);
}
int VelStereoMatcher::findOptimalStereo(StereoProperties init)
{
const gsl_multimin_fminimizer_type *T = gsl_multimin_fminimizer_nmsimplex2;
gsl_multimin_fminimizer *s = NULL;
gsl_vector *ss, *x;
gsl_multimin_function minex_func;
size_t iter = 0;
int status;
double size;
// Starting point
x = stereoToVec(init);
// Set initial step sizes to 1
ss = gsl_vector_alloc(11);
gsl_vector_set(ss, 0, 0.1);
gsl_vector_set(ss, 1, 0.1);
gsl_vector_set(ss, 2, 0.1);
gsl_vector_set(ss, 3, 0.05);
gsl_vector_set(ss, 4, 0.05);
gsl_vector_set(ss, 5, 0.05);
gsl_vector_set(ss, 6, 5);
gsl_vector_set(ss, 7, 5);
gsl_vector_set(ss, 8, 5);
gsl_vector_set(ss, 9, 5);
gsl_vector_set(ss, 10, 0.001);
// Initialize method and iterate
minex_func.n = 11;
minex_func.f = this->optFuncWrapper;
minex_func.params = this;
s = gsl_multimin_fminimizer_alloc(T, 11);
gsl_multimin_fminimizer_set(s, &minex_func, x, ss);
do
{
iter++;
status = gsl_multimin_fminimizer_iterate(s);
if (status)
break;
size = gsl_multimin_fminimizer_size(s);
status = gsl_multimin_test_size(size, 1e-4);
if (status == GSL_SUCCESS)
{
printf("converged to minimum at\n");
}
printf("%5d x:%2.3f y:%2.3f z:%2.3f rx:%2.3f ry:%2.3f rz:%2.3f fx:%3.1f fy:%3.1f cx:%3.1f cy:%3.1f baseline:%2.3f f() = %7.3f size = %.3f\n", iter,
gsl_vector_get(s->x, 0), gsl_vector_get(s->x, 1), gsl_vector_get(s->x, 2), gsl_vector_get(s->x, 3),
gsl_vector_get(s->x, 4), gsl_vector_get(s->x, 5), gsl_vector_get(s->x, 6), gsl_vector_get(s->x, 7), gsl_vector_get(s->x, 8), gsl_vector_get(s->x, 9), gsl_vector_get(s->x, 10), s->fval, size);
} while (status == GSL_CONTINUE && iter < 100);
gsl_vector_free(x);
gsl_vector_free(ss);
gsl_multimin_fminimizer_free(s);
return status;
}
void Spectrometer::countAmplitudes_bulk_B(Medium &Osrodek, QString DataName, QProgressBar *Progress, QTextBrowser *Browser, double kx, double ky, double w, int polarisation, double x_lenght, double y_lenght, double precision) {
double a=Osrodek.itsBasis.getLatticeConstant();
int RecVec=itsRecVectors;
int dimension=3*(2*RecVec+1)*(2*RecVec+1);
std::ofstream plik;
DataName="results/amplitudes/"+ DataName + ".dat";
QByteArray bytes = DataName.toAscii();
const char * CDataName = bytes.data();
plik.open(CDataName);
//inicjalizacje wektorów i macierzy
gsl_matrix *gamma=gsl_matrix_calloc(dimension, dimension);
gsl_matrix *V=gsl_matrix_calloc(dimension, dimension);
gsl_vector *S=gsl_vector_calloc(dimension);
gsl_vector *work=gsl_vector_calloc(dimension);
//gamma dla Podłoża
/*
S - numeruje transformaty tensora sprężystoci i gestosci
i - numeruje wiersze macierzy
j - numeruje kolumny macierzy
*/
for(int Nx=-RecVec, i=0, S=0; Nx<=RecVec; Nx++) {
for(int Ny=-RecVec; Ny<=RecVec; Ny++, i=i+3) {
for(int Nx_prim=-RecVec, j=0; Nx_prim<=RecVec; Nx_prim++) {
for(int Ny_prim=-RecVec; Ny_prim<=RecVec; Ny_prim++, j=j+3, S++) {
double Elasticity[6][6];
itsRecBasisSubstance[S].getElasticity(Elasticity);
double Density=itsRecBasisSubstance[S].getDensity();
double gx=2*M_PI*Nx/a;
double gy=2*M_PI*Ny/a;
double gx_prim=2*M_PI*Nx_prim/a;
double gy_prim=2*M_PI*Ny_prim/a;
gsl_matrix_set(gamma, i, j, Elasticity[0][0]*(kx+gx)*(kx+gx_prim)+Elasticity[3][3]*(ky+gy)*(ky+gy_prim)-Density*w*w);
gsl_matrix_set(gamma, i+1, j, Elasticity[0][1]*(kx+gx_prim)*(ky+gy)+Elasticity[3][3]*(ky+gy_prim)*(kx+gx));
gsl_matrix_set(gamma, i, j+1, Elasticity[0][1]*(ky+gy_prim)*(kx+gx)+Elasticity[3][3]*(kx+gx_prim)*(ky+gy));
gsl_matrix_set(gamma, i+1, j+1, Elasticity[0][0]*(ky+gy_prim)*(ky+gy)+Elasticity[3][3]*(kx+gx_prim)*(kx+gx)-Density*w*w);
gsl_matrix_set(gamma, i+2, j+2, Elasticity[3][3]*(ky+gy_prim)*(ky+gy)+Elasticity[3][3]*(kx+gx_prim)*(kx+gx)-Density*w*w);
}
}
}
}
//rozwiązanie układu równań
gsl_linalg_SV_decomp(gamma, V, S, work);
gsl_complex u;
double Gx, Gy;
if (polarisation==3) {
gsl_complex ux, uy, uz;
for(double x=0; x < x_lenght; x=x+precision) {
for(double y=0; y < y_lenght; y=y+precision) {
ux = gsl_complex_rect(0, 0);
uy = gsl_complex_rect(0, 0);
uz = gsl_complex_rect(0, 0);
//pasek postepu
int postep=int(100*x/x_lenght);
Progress->setValue(postep);
Progress->update();
QApplication::processEvents();
for (int Nx=-RecVec, i=0; Nx <= RecVec; Nx++) {
for (int Ny=-RecVec; Ny <= RecVec; Ny++, i=i+3) {
Gx=2*M_PI*Nx/a;
Gy=2*M_PI*Ny/a;
double Ax = gsl_matrix_get(V, i, dimension-1);
double Ay = gsl_matrix_get(V, i+1, dimension-1);
double Az = gsl_matrix_get(V, i+2, dimension-1);
gsl_complex expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y);
gsl_complex exp1 = gsl_complex_exp(expin1);
gsl_complex multiply = gsl_complex_mul_real(exp1, Ax);
ux = gsl_complex_add(ux, multiply);
expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y);
exp1 = gsl_complex_exp(expin1);
multiply = gsl_complex_mul_real(exp1, Ay);
uy = gsl_complex_add(uy, multiply);
expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y);
exp1 = gsl_complex_exp(expin1);
multiply = gsl_complex_mul_real(exp1, Az);
uz = gsl_complex_add(uz, multiply);
}
}
double U = sqrt(gsl_complex_abs(ux)*gsl_complex_abs(ux)+gsl_complex_abs(uy)*gsl_complex_abs(uy)+gsl_complex_abs(uz)*gsl_complex_abs(uz));
//zapisanie wartości do pliku
QString nazwa = Osrodek.itsBasis.getFillingSubstance().getName();
if(nazwa=="Air")
{
double rad=Osrodek.itsBasis.getRadius();
if(sqrt(x*x+y*y) > rad && sqrt((a-x)*(a-x)+y*y) > rad && sqrt((a-x)*(a-x)+(a-y)*(a-y)) > rad && sqrt((a-y)*(a-y)+x*x) > rad)
{
plik << x << "\t" << y << "\t" << U << "\n";
}
} else {
plik << x << "\t" << y << "\t" << U << "\n";
}
}
plik << "\n";
}
} else if (polarisation==4) {
gsl_complex uxx, uxy, uxz, uyx, uyy, uyz, uzx, uzy, uzz;
double Uxx, Uxy, Uxz, Uyx, Uyy, Uyz, Uzx, Uzy, Uzz;
for(double x=0; x < x_lenght; x=x+precision) {
for(double y=0; y < y_lenght; y=y+precision) {
uxx = gsl_complex_rect(0, 0);
uxy = gsl_complex_rect(0, 0);
uxz = gsl_complex_rect(0, 0);
uyx = gsl_complex_rect(0, 0);
uyy = gsl_complex_rect(0, 0);
uyz = gsl_complex_rect(0, 0);
uzx = gsl_complex_rect(0, 0);
uzy = gsl_complex_rect(0, 0);
uzz = gsl_complex_rect(0, 0);
double rad=Osrodek.itsBasis.getRadius();
double Ela[6][6];
if(sqrt(x*x+y*y) > rad && sqrt((a-x)*(a-x)+y*y) > rad && sqrt((a-x)*(a-x)+(a-y)*(a-y)) > rad && sqrt((a-y)*(a-y)+x*x) > rad)
{
Osrodek.itsBasis.getSubstance().getElasticity(Ela);
} else {
Osrodek.itsBasis.getFillingSubstance().getElasticity(Ela);
}
//pasek postepu
int postep=int(100*x/x_lenght);
Progress->setValue(postep);
Progress->update();
QApplication::processEvents();
for (int Nx=-RecVec, i=0; Nx <= RecVec; Nx++) {
for (int Ny=-RecVec; Ny <= RecVec; Ny++, i=i+3) {
Gx=2*M_PI*Nx/a;
Gy=2*M_PI*Ny/a;
double Ax = gsl_matrix_get(V, i, dimension-1);
double Ay = gsl_matrix_get(V, i+1, dimension-1);
double Az = gsl_matrix_get(V, i+2, dimension-1);
gsl_complex expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y);
gsl_complex exp1 = gsl_complex_exp(expin1);
gsl_complex multiply = gsl_complex_mul_real(exp1, Ax);
//uxx
gsl_complex multidiff = gsl_complex_mul(multiply, gsl_complex_mul_real(gsl_complex_rect(0,1), kx+Gx));
uxx = gsl_complex_add(uxx, multidiff);
//uxy
multidiff = gsl_complex_mul(multiply, gsl_complex_mul_real(gsl_complex_rect(0,1), ky+Gy));
uxy = gsl_complex_add(uxy, multidiff);
expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y);
exp1 = gsl_complex_exp(expin1);
//uy
multiply = gsl_complex_mul_real(exp1, Ay);
//uyx
multidiff = gsl_complex_mul(multiply, gsl_complex_mul_real(gsl_complex_rect(0,1), kx+Gx));
uyx = gsl_complex_add(uyx, multidiff);
//uyy
multidiff = gsl_complex_mul(multiply, gsl_complex_mul_real(gsl_complex_rect(0,1), ky+Gy));
uyy = gsl_complex_add(uyy, multidiff);
expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y);
exp1 = gsl_complex_exp(expin1);
multiply = gsl_complex_mul_real(exp1, Az);
//uzx
multidiff = gsl_complex_mul(multiply, gsl_complex_mul_real(gsl_complex_rect(0,1), kx+Gx));
uzx = gsl_complex_add(uzx, multidiff);
//uzy
multidiff = gsl_complex_mul(multiply, gsl_complex_mul_real(gsl_complex_rect(0,1), ky+Gy));
uzy = gsl_complex_add(uzy, multidiff);
}
}
Uxx=gsl_complex_abs(uxx);
Uxy=gsl_complex_abs(uxy);
Uxz=gsl_complex_abs(uxz);
Uyx=gsl_complex_abs(uyx);
Uyy=gsl_complex_abs(uyy);
Uyz=gsl_complex_abs(uyz);
Uzx=gsl_complex_abs(uzx);
Uzy=gsl_complex_abs(uzy);
Uzz=gsl_complex_abs(uzz);
double U = Ela[0][0]*(Uxx*Uxx+Uyy*Uyy+Uzz*Uzz)+2*Ela[0][1]*(Uxx*Uyy+Uxx*Uzz+Uyy*Uzz)+0.25*Ela[3][3]*((Uyz+Uzy)*(Uyz+Uzy)+(Uxz+Uzx)*(Uxz+Uzx)+(Uxy+Uyx)*(Uxy+Uyx));
//zapisanie wartości do pliku
QString nazwa = Osrodek.itsBasis.getFillingSubstance().getName();
if(nazwa=="Air")
{
double rad=Osrodek.itsBasis.getRadius();
if(sqrt(x*x+y*y) > rad && sqrt((a-x)*(a-x)+y*y) > rad && sqrt((a-x)*(a-x)+(a-y)*(a-y)) > rad && sqrt((a-y)*(a-y)+x*x) > rad)
{
plik << x << "\t" << y << "\t" << U << "\n";
}
} else {
plik << x << "\t" << y << "\t" << U << "\n";
}
}
plik << "\n";
}
} else {
for(double x=0; x < x_lenght; x=x+precision) {
for(double y=0; y < y_lenght; y=y+precision) {
u = gsl_complex_rect(0, 0);
//pasek postepu
int postep=int(100*x/x_lenght);
Progress->setValue(postep);
Progress->update();
QApplication::processEvents();
for (int Nx=-RecVec, i=0; Nx <= RecVec; Nx++) {
for (int Ny=-RecVec; Ny <= RecVec; Ny++, i=i+3) {
Gx=2*M_PI*Nx/a;
Gy=2*M_PI*Ny/a;
double A = gsl_matrix_get(V, i+polarisation, dimension-1);
gsl_complex expin1 = gsl_complex_rect(0, (kx+Gx)*x+(ky+Gy)*y);
gsl_complex exp1 = gsl_complex_exp(expin1);
gsl_complex multiply = gsl_complex_mul_real(exp1, A);
u = gsl_complex_add(u, multiply);
}
}
double U = gsl_complex_abs(u);
//zapisanie wartości do pliku
plik << x << "\t" << y << "\t" << U << "\n";
}
plik << "\n";
}
}
plik.close();
gsl_matrix_free(gamma);
gsl_matrix_free(V);
gsl_vector_free(S);
gsl_vector_free(work);
}
QMap<double, double> SGMResolutionOptimization::curve(QList<QVariant> stateParameters, AMRegionsList* contextParameters){
double _maxenergy = maximumEnergy(contextParameters);
double _minenergy = minimumEnergy(contextParameters);
double _slit = stateParameters.at(0).toDouble();
double _y1, _y2, _y3, _x1, _x2, _x3;
double _maxRes = 0;
SGMBeamlineInfo::sgmGrating _grating = (SGMBeamlineInfo::sgmGrating)stateParameters.at(1).toInt();
SGMBeamlineInfo::sgmHarmonic _harmonic = (SGMBeamlineInfo::sgmHarmonic)stateParameters.at(2).toInt();
if(!SGMBeamlineInfo::sgmInfo()->energyRangeValidForSettings(_grating, _harmonic, _minenergy, _maxenergy))
{
}
else if((_harmonic == 3) && (_grating == 2)){
_y1 = (0.95)*(0.5229*log(_slit)+1.4221);
_y2 = (0.95)*(0.4391*log(_slit)+1.2617);
_y3 = (0.95)*(0.421*log(_slit)+0.9037);
_x1 = 2000;
_x2 = 1200;
_x3 = 800;
_maxRes = 12500;
}
else{
if( (_grating == 0) && SGMBeamlineInfo::sgmInfo()->energyRangeValidForSettings(_grating, _harmonic, _minenergy, _maxenergy) ){
_y1 = 0.4568*log(_slit)+1.0199;
_y2 = 0.4739*log(_slit)+0.605;
_y3 = 0.4257*log(_slit)+0.4438;
_x1 = 600;
_x2 = 400;
_x3 = 250;
_maxRes = 17500;
}
else if( (_grating == 1) && SGMBeamlineInfo::sgmInfo()->energyRangeValidForSettings(_grating, _harmonic, _minenergy, _maxenergy) ){
_y1 = 0.425*log(_slit)+1.4936;
_y2 = 0.4484*log(_slit)+1.0287;
_y3 = 0.4029*log(_slit)+0.7914;
_x1 = 1200;
_x2 = 800;
_x3 = 500;
_maxRes = 15000;
}
else if( (_grating == 2) && SGMBeamlineInfo::sgmInfo()->energyRangeValidForSettings(_grating, _harmonic, _minenergy, _maxenergy) ){
_y1 = 0.5229*log(_slit)+1.4221;
_y2 = 0.4391*log(_slit)+1.2617;
_y3 = 0.421*log(_slit)+0.9037;
_x1 = 2000;
_x2 = 1200;
_x3 = 800;
_maxRes = 13750;
}
}
int i, n;
double xi, yi, ei, chisq;
gsl_matrix *X, *cov;
gsl_vector *y, *w, *c;
n = 3;
X = gsl_matrix_alloc (n, 3);
y = gsl_vector_alloc (n);
w = gsl_vector_alloc (n);
c = gsl_vector_alloc (3);
cov = gsl_matrix_alloc (3, 3);
double ix[3];
double iy[3];
double ie[3];
ix[0] = _x1;
ix[1] = _x2;
ix[2] = _x3;
iy[0] = _y1;
iy[1] = _y2;
iy[2] = _y3;
ie[0] = 0.1*iy[0];
ie[1] = 0.1*iy[1];
ie[2] = 0.1*iy[2];
for (i = 0; i < n; i++)
{
xi = ix[i];
yi = iy[i];
ei = ie[i];
gsl_matrix_set (X, i, 0, 1.0);
gsl_matrix_set (X, i, 1, xi);
gsl_matrix_set (X, i, 2, xi*xi);
gsl_vector_set (y, i, yi);
gsl_vector_set (w, i, 1.0/(ei*ei));
}
gsl_multifit_linear_workspace * work
= gsl_multifit_linear_alloc (n, 3);
gsl_multifit_wlinear (X, w, y, c, cov,
&chisq, work);
gsl_multifit_linear_free (work);
#define C(i) (gsl_vector_get(c,(i)))
#define COV(i,j) (gsl_matrix_get(cov,(i),(j)))
QMap<double, double> rCurve;
double tmpStart, tmpEnd, tmpDelta;//, tmpVal;
for( int x = 0; x < contextParameters->count(); x++){
tmpStart = contextParameters->start(x);
tmpDelta = contextParameters->delta(x);
tmpEnd = contextParameters->end(x);
if( tmpStart >= 250 && tmpStart <= 2000 && tmpEnd >= 250 && tmpEnd <= 2000 ){
for( double y = tmpStart; ((tmpDelta > 0) ? (y <= tmpEnd) : (y >= tmpEnd)); y += tmpDelta ){
//rCurve[y] = !SGMBeamline::sgm()->energyValidForSettings(_grating, _harmonic, y) ? 0.0 :y/(pow(10, C(2)*y*y + C(1)*y + C(0))*1e-3);
if(!SGMBeamlineInfo::sgmInfo()->energyValidForSettings(_grating, _harmonic, y))
rCurve[y] = 0.0;
else{
rCurve[y] = y/(pow(10, C(2)*y*y + C(1)*y + C(0))*1e-3);
}
}
}
else
rCurve[250] = 0;
}
gsl_matrix_free (X);
gsl_vector_free (y);
gsl_vector_free (w);
gsl_vector_free (c);
gsl_matrix_free (cov);
return rCurve;
}
gsl_multiroot_fsolver *
gsl_multiroot_fsolver_alloc (const gsl_multiroot_fsolver_type * T,
size_t n)
{
int status;
gsl_multiroot_fsolver * s;
s = (gsl_multiroot_fsolver *) malloc (sizeof (gsl_multiroot_fsolver));
if (s == 0)
{
GSL_ERROR_VAL ("failed to allocate space for multiroot solver struct",
GSL_ENOMEM, 0);
}
s->x = gsl_vector_calloc (n);
if (s->x == 0)
{
free (s);
GSL_ERROR_VAL ("failed to allocate space for x", GSL_ENOMEM, 0);
}
s->f = gsl_vector_calloc (n);
if (s->f == 0)
{
gsl_vector_free (s->x);
free (s);
GSL_ERROR_VAL ("failed to allocate space for f", GSL_ENOMEM, 0);
}
s->dx = gsl_vector_calloc (n);
if (s->dx == 0)
{
gsl_vector_free (s->x);
gsl_vector_free (s->f);
free (s);
GSL_ERROR_VAL ("failed to allocate space for dx", GSL_ENOMEM, 0);
}
s->state = malloc (T->size);
if (s->state == 0)
{
gsl_vector_free (s->dx);
gsl_vector_free (s->x);
gsl_vector_free (s->f);
free (s); /* exception in constructor, avoid memory leak */
GSL_ERROR_VAL ("failed to allocate space for multiroot solver state",
GSL_ENOMEM, 0);
}
s->type = T ;
status = (s->type->alloc)(s->state, n);
if (status != GSL_SUCCESS)
{
(s->type->free)(s->state);
free (s->state);
gsl_vector_free (s->dx);
gsl_vector_free (s->x);
gsl_vector_free (s->f);
free (s); /* exception in constructor, avoid memory leak */
GSL_ERROR_VAL ("failed to set solver", status, 0);
}
s->function = NULL;
return s;
}
void MultiDimMinimizer::CleanUp()
{
if(x!=NULL) {gsl_vector_free(x); x=NULL;}
if(ss!=NULL) {gsl_vector_free(ss);ss=NULL;}
if(s!=NULL) {gsl_multimin_fminimizer_free (s); s=NULL;}
}
/* Everything needs to be declared as unused in case HDF is not enabled. */
int XLALSimInspiralNRWaveformGetHplusHcross(
UNUSED REAL8TimeSeries **hplus, /**< Output h_+ vector */
UNUSED REAL8TimeSeries **hcross, /**< Output h_x vector */
UNUSED REAL8 phiRef, /**< orbital phase at reference pt. */
UNUSED REAL8 inclination, /**< inclination angle */
UNUSED REAL8 deltaT, /**< sampling interval (s) */
UNUSED REAL8 m1, /**< mass of companion 1 (kg) */
UNUSED REAL8 m2, /**< mass of companion 2 (kg) */
UNUSED REAL8 r, /**< distance of source (m) */
UNUSED REAL8 fStart, /**< start GW frequency (Hz) */
UNUSED REAL8 fRef, /**< reference GW frequency (Hz) */
UNUSED REAL8 s1x, /**< initial value of S1x */
UNUSED REAL8 s1y, /**< initial value of S1y */
UNUSED REAL8 s1z, /**< initial value of S1z */
UNUSED REAL8 s2x, /**< initial value of S2x */
UNUSED REAL8 s2y, /**< initial value of S2y */
UNUSED REAL8 s2z, /**< initial value of S2z */
UNUSED const char *NRDataFile, /**< Location of NR HDF file */
UNUSED LALValue* ModeArray /**< Container for the ell and m modes to generate. To generate all available modes pass NULL */
)
{
#ifndef LAL_HDF5_ENABLED
XLAL_ERROR(XLAL_EFAILED, "HDF5 support not enabled");
#else
/* Declarations */
UINT4 curr_idx, nr_file_format;
INT4 model, modem;
size_t array_length;
REAL8 nrEta;
REAL8 S1x, S1y, S1z, S2x, S2y, S2z;
REAL8 Mflower, time_start_M, time_start_s, time_end_M, time_end_s;
REAL8 est_start_time, curr_h_real, curr_h_imag;
REAL8 theta, psi, calpha, salpha;
REAL8 distance_scale_fac;
COMPLEX16 curr_ylm;
REAL8TimeSeries *hplus_corr;
REAL8TimeSeries *hcross_corr;
/* These keys follow a strict formulation and cannot be longer than 11
* characters */
char amp_key[20];
char phase_key[20];
gsl_vector *tmpVector=NULL;
LALH5File *file, *group;
LIGOTimeGPS tmpEpoch = LIGOTIMEGPSZERO;
REAL8Vector *curr_amp, *curr_phase;
/* Use solar masses for units. NR files will use
* solar masses as well, so easier for that conversion
*/
m1 = m1 / LAL_MSUN_SI;
m2 = m2 / LAL_MSUN_SI;
file = XLALH5FileOpen(NRDataFile, "r");
if (file == NULL)
{
XLAL_ERROR(XLAL_EIO, "NR SIMULATION DATA FILE %s NOT FOUND.\n", NRDataFile);
}
/* Sanity checks on physical parameters passed to waveform
* generator to guarantee consistency with NR data file.
*/
XLALH5FileQueryScalarAttributeValue(&nrEta, file, "eta");
if (fabs((m1 * m2) / pow((m1 + m2),2.0) - nrEta) > 1E-3)
{
XLAL_ERROR(XLAL_EDOM, "MASSES (%e and %e) ARE INCONSISTENT WITH THE MASS RATIO OF THE NR SIMULATION (eta=%e).\n", m1, m2, nrEta);
}
/* Read spin metadata, L_hat, n_hat from HDF5 metadata and make sure
* the ChooseTDWaveform() input values are consistent with the data
* recorded in the metadata of the HDF5 file.
* PS: This assumes that the input spins are in the LAL frame!
*/
XLALH5FileQueryScalarAttributeValue(&nr_file_format, file, "Format");
if (nr_file_format < 2)
{
XLALPrintInfo("This NR file is format %d. Only formats 2 and above support the use of reference frequency. For formats < 2 the reference frequency always corresponds to the start of the waveform.", nr_file_format);
fRef = -1;
}
XLALSimInspiralNRWaveformGetSpinsFromHDF5FilePointer(&S1x, &S1y, &S1z,
&S2x, &S2y, &S2z,
fRef, m1+m2, file);
if (fabs(S1x - s1x) > 1E-3)
{
XLAL_ERROR(XLAL_EDOM, "SPIN1X IS INCONSISTENT WITH THE NR SIMULATION.\n");
}
if (fabs(S1y - s1y) > 1E-3)
{
XLAL_ERROR(XLAL_EDOM, "SPIN1Y IS INCONSISTENT WITH THE NR SIMULATION.\n");
}
if (fabs(S1z - s1z) > 1E-3)
{
XLAL_ERROR(XLAL_EDOM, "SPIN1Z IS INCONSISTENT WITH THE NR SIMULATION.\n");
}
if (fabs(S2x - s2x) > 1E-3)
{
XLAL_ERROR(XLAL_EDOM, "SPIN2X IS INCONSISTENT WITH THE NR SIMULATION.\n");
}
if (fabs(S2y - s2y) > 1E-3)
{
XLAL_ERROR(XLAL_EDOM, "SPIN2Y IS INCONSISTENT WITH THE NR SIMULATION.\n");
}
if (fabs(S2z - s2z) > 1E-3)
{
XLAL_ERROR(XLAL_EDOM, "SPIN2Z IS INCONSISTENT WITH THE NR SIMULATION.\n");
}
/* First estimate the length of time series that is needed.
* Demand that 22 mode that is present and use that to figure this out
*/
XLALH5FileQueryScalarAttributeValue(&Mflower, file, "f_lower_at_1MSUN");
/* Figure out start time of data */
group = XLALH5GroupOpen(file, "amp_l2_m2");
ReadHDF5RealVectorDataset(group, "X", &tmpVector);
time_start_M = (REAL8)(gsl_vector_get(tmpVector, 0));
time_end_M = (REAL8)(gsl_vector_get(tmpVector, tmpVector->size - 1));
gsl_vector_free(tmpVector);
time_start_s = time_start_M * (m1 + m2) * LAL_MTSUN_SI;
time_end_s = time_end_M * (m1 + m2) * LAL_MTSUN_SI;
/* We don't want to return the *entire* waveform if it will be much longer
* than the specified f_lower. Therefore guess waveform length using
* the SEOBNR_ROM function and add 10% for safety.
* FIXME: Is this correct for precessing waveforms?
*/
if (fStart < Mflower / (m1 + m2) )
{
XLAL_ERROR(XLAL_EDOM, "WAVEFORM IS NOT LONG ENOUGH TO REACH f_low. %e %e %e",
fStart, Mflower, Mflower / (m1 + m2));
}
XLALH5FileQueryScalarAttributeValue(&nr_file_format, file, "Format");
if (nr_file_format > 1)
{
if (XLALSimInspiralNRWaveformCheckFRef(file, fStart * (m1+m2)) > 0)
{
/* Can use Omega array to get start time */
est_start_time = XLALSimInspiralNRWaveformGetRefTimeFromRefFreq(file, fStart * (m1+m2)) * (m1 + m2) * LAL_MTSUN_SI;
}
else
{
/* This is the potential weird case where Omega-vs-time does not start
* at precisely the same time as flower_at_1MSUN. This gap should be
* small, so just use the full waveform here.
*/
est_start_time = time_start_s;
}
}
else
{
/* Fall back on SEOBNR chirp time estimate */
XLALSimIMRSEOBNRv4ROMTimeOfFrequency(&est_start_time, fStart, m1 * LAL_MSUN_SI, m2 * LAL_MSUN_SI, s1z, s2z);
est_start_time = (-est_start_time) * 1.1;
}
if (est_start_time > time_start_s)
{
/* Restrict start time of waveform */
time_start_s = est_start_time;
time_start_M = time_start_s / ((m1 + m2) * LAL_MTSUN_SI);
}
array_length = (UINT4)(ceil( (time_end_s - time_start_s) / deltaT));
/* Compute correct angles for hplus and hcross following LAL convention. */
theta = psi = calpha = salpha = 0.;
XLALSimInspiralNRWaveformGetRotationAnglesFromH5File(&theta, &psi, &calpha,
&salpha, file, inclination, phiRef, fRef*(m1+m2));
/* Create the return time series, use arbitrary epoch here. We set this
* properly later. */
XLALGPSAdd(&tmpEpoch, time_start_s);
*hplus = XLALCreateREAL8TimeSeries("H_PLUS", &tmpEpoch, 0.0, deltaT,
&lalStrainUnit, array_length );
*hcross = XLALCreateREAL8TimeSeries("H_CROSS", &tmpEpoch, 0.0, deltaT,
&lalStrainUnit, array_length );
hplus_corr = XLALCreateREAL8TimeSeries("H_PLUS", &tmpEpoch, 0.0, deltaT,
&lalStrainUnit, array_length );
hcross_corr = XLALCreateREAL8TimeSeries("H_CROSS", &tmpEpoch, 0.0, deltaT,
&lalStrainUnit, array_length );
for (curr_idx = 0; curr_idx < array_length; curr_idx++)
{
hplus_corr->data->data[curr_idx] = 0.0;
hcross_corr->data->data[curr_idx] = 0.0;
}
/* Create the distance scale factor */
distance_scale_fac = (m1 + m2) * LAL_MRSUN_SI / r;
/* Generate the waveform */
/* NOTE: We assume that for a given ell mode, all m modes are present */
INT4 NRLmax;
XLALH5FileQueryScalarAttributeValue(&NRLmax, file, "Lmax");
if ( ModeArray == NULL )
{/* Default behaviour: Generate all modes upto NRLmax */
ModeArray = XLALSimInspiralCreateModeArray();
for (int ell=2; ell<=NRLmax; ell++)
{
XLALSimInspiralModeArrayActivateAllModesAtL(ModeArray, ell);
}
}
/* else Use the ModeArray given */
for (model=2; model < (NRLmax + 1) ; model++)
{
for (modem=-model; modem < (model+1); modem++)
{
/* first check if (l,m) mode is 'activated' in the ModeArray */
/* if activated then generate the mode, else skip this mode. */
if (XLALSimInspiralModeArrayIsModeActive(ModeArray, model, modem) != 1)
{
XLAL_PRINT_INFO("SKIPPING model = %i modem = %i\n", model, modem);
continue;
}
XLAL_PRINT_INFO("generateing model = %i modem = %i\n", model, modem);
snprintf(amp_key, sizeof(amp_key), "amp_l%d_m%d", model, modem);
snprintf(phase_key, sizeof(phase_key), "phase_l%d_m%d", model, modem);
/* Check that both groups exist */
if (XLALH5FileCheckGroupExists(file, amp_key) == 0)
{
continue;
}
if (XLALH5FileCheckGroupExists(file, phase_key) == 0)
{
continue;
}
/* Get amplitude and phase from file */
XLALSimInspiralNRWaveformGetDataFromHDF5File(&curr_amp, file, (m1 + m2),
time_start_s, array_length, deltaT, amp_key);
XLALSimInspiralNRWaveformGetDataFromHDF5File(&curr_phase, file, (m1 + m2),
time_start_s, array_length, deltaT, phase_key);
curr_ylm = XLALSpinWeightedSphericalHarmonic(theta, psi, -2,
model, modem);
for (curr_idx = 0; curr_idx < array_length; curr_idx++)
{
curr_h_real = curr_amp->data[curr_idx]
* cos(curr_phase->data[curr_idx]) * distance_scale_fac;
curr_h_imag = curr_amp->data[curr_idx]
* sin(curr_phase->data[curr_idx]) * distance_scale_fac;
hplus_corr->data->data[curr_idx] = hplus_corr->data->data[curr_idx]
+ curr_h_real * creal(curr_ylm) - curr_h_imag * cimag(curr_ylm);
hcross_corr->data->data[curr_idx] = hcross_corr->data->data[curr_idx]
- curr_h_real * cimag(curr_ylm) - curr_h_imag * creal(curr_ylm);
}
XLALDestroyREAL8Vector(curr_amp);
XLALDestroyREAL8Vector(curr_phase);
}
}
/* Correct for the "alpha" angle as given in T1600045 to translate
* from the NR wave frame to LAL wave-frame
* Helper time series needed.
*/
for (curr_idx = 0; curr_idx < array_length; curr_idx++)
{
(*hplus)->data->data[curr_idx] =
(calpha*calpha - salpha*salpha) * hplus_corr->data->data[curr_idx]
- 2.0*calpha*salpha * hcross_corr->data->data[curr_idx];
(*hcross)->data->data[curr_idx] =
+ 2.0*calpha*salpha * hplus_corr->data->data[curr_idx]
+ (calpha*calpha - salpha*salpha) * hcross_corr->data->data[curr_idx];
}
XLALDestroyREAL8TimeSeries(hplus_corr);
XLALDestroyREAL8TimeSeries(hcross_corr);
XLALH5FileClose(file);
XLALDestroyValue(ModeArray);
return XLAL_SUCCESS;
#endif
}
static int
vector_bfgs_alloc (void *vstate, size_t n)
{
vector_bfgs_state_t *state = (vector_bfgs_state_t *) vstate;
state->x1 = gsl_vector_calloc (n);
if (state->x1 == 0)
{
GSL_ERROR ("failed to allocate space for x1", GSL_ENOMEM);
}
state->dx1 = gsl_vector_calloc (n);
if (state->dx1 == 0)
{
gsl_vector_free (state->x1);
GSL_ERROR ("failed to allocate space for dx1", GSL_ENOMEM);
}
state->x2 = gsl_vector_calloc (n);
if (state->x2 == 0)
{
gsl_vector_free (state->dx1);
gsl_vector_free (state->x1);
GSL_ERROR ("failed to allocate space for x2", GSL_ENOMEM);
}
state->p = gsl_vector_calloc (n);
if (state->p == 0)
{
gsl_vector_free (state->x2);
gsl_vector_free (state->dx1);
gsl_vector_free (state->x1);
GSL_ERROR ("failed to allocate space for p", GSL_ENOMEM);
}
state->x0 = gsl_vector_calloc (n);
if (state->x0 == 0)
{
gsl_vector_free (state->p);
gsl_vector_free (state->x2);
gsl_vector_free (state->dx1);
gsl_vector_free (state->x1);
GSL_ERROR ("failed to allocate space for g0", GSL_ENOMEM);
}
state->g0 = gsl_vector_calloc (n);
if (state->g0 == 0)
{
gsl_vector_free (state->x0);
gsl_vector_free (state->p);
gsl_vector_free (state->x2);
gsl_vector_free (state->dx1);
gsl_vector_free (state->x1);
GSL_ERROR ("failed to allocate space for g0", GSL_ENOMEM);
}
state->dx0 = gsl_vector_calloc (n);
if (state->dx0 == 0)
{
gsl_vector_free (state->g0);
gsl_vector_free (state->x0);
gsl_vector_free (state->p);
gsl_vector_free (state->x2);
gsl_vector_free (state->dx1);
gsl_vector_free (state->x1);
GSL_ERROR ("failed to allocate space for g0", GSL_ENOMEM);
}
state->dg0 = gsl_vector_calloc (n);
if (state->dg0 == 0)
{
gsl_vector_free (state->dx0);
gsl_vector_free (state->g0);
gsl_vector_free (state->x0);
gsl_vector_free (state->p);
gsl_vector_free (state->x2);
gsl_vector_free (state->dx1);
gsl_vector_free (state->x1);
GSL_ERROR ("failed to allocate space for g0", GSL_ENOMEM);
}
return GSL_SUCCESS;
}
int
main (int argc, char **argv)
{
int i=0, j=0, n=0, nl=0, k=0,
posi=0, posj=0, posk=0, ncol=0, nrow=0;
double xi=0.0, yi=0.0, yy=0.0, ei=0.0, sumsq=0.0, med=0.0;
gsl_matrix *X=NULL, *cov=NULL;
gsl_vector *y=NULL, *w=NULL, *c=NULL;
MRI_IMAGE *im = NULL;
double *dar = NULL;
gsl_multifit_linear_workspace *work=NULL;
if (argc != 2)
{
fprintf (stderr,"usage: fitanje_1sign data > outfile\n");
exit (-1);
}
/* slower than specific code you had but more convenient.
It allows you to use all the column and row selections
we can do with filenames. Also, keeps you fron worrying
about dimensions.
The problem with your code was assuming you had 13 columns always
That was not the case for stat5_fitcoef.
OK, that was caused by a problem in the scripts. That is fixed,
but I leave this change here anyway.
*/
fprintf(stderr,"Patience, reading %s... ", argv[1]);
im = mri_read_double_1D (argv[1]);
if (!im) {
fprintf(stderr,"Error: Failed to read matrix data from %s\n",
argv[1]);
return(-1);
}
ncol = im->ny;
nrow = im->nx;
fprintf (stderr,"Have %d cols, %d rows\nNow fitting...", ncol, nrow);
n = ncol-3;
/* now just get the array and kill the rest */
dar = MRI_DOUBLE_PTR(im);
/* make sure that pointer is set to NULL in im, or risk hell */
mri_clear_data_pointer(im) ;
if (im) mri_free(im); im = NULL; /* now kill im */
X = gsl_matrix_alloc (n, 5);
y = gsl_vector_alloc (n);
c = gsl_vector_alloc (5);
cov = gsl_matrix_alloc (5, 5);
for (i = 0; i < n; i++) {
xi = i+1;
gsl_matrix_set (X, i, 0, 1.0);
gsl_matrix_set (X, i, 1, xi);
gsl_matrix_set (X, i, 2, xi*xi);
gsl_matrix_set (X, i, 3, xi*xi*xi);
gsl_matrix_set (X, i, 4, xi*xi*xi*xi);
// printf ("%lg ",xi);
}
/*make header
printf ("matrvola\n");
ZSS: By adding # to the text line,
I made the output file be a .1D format */
fprintf(stdout, "#%s_0\t%s_1\t%s_2\t%s_3\t%s_4\n",
argv[1],argv[1],argv[1],argv[1],argv[1]);
// go by lines - signatures
/* pre-allocate, I think this should be just fine,
there should be no need to reinitialize work
all the time */
work = gsl_multifit_linear_alloc (n, 5);
for (nl=0; nl<nrow; ++nl) {
posi = (int)dar[nl];
posj = (int)dar[nl+ nrow];
posk = (int)dar[nl+2*nrow];
for (k = 3; k < ncol; k++) {
gsl_vector_set (y, k-3, dar[nl+k*nrow]);
}
gsl_multifit_linear (X, y, c, cov,
&sumsq, work);
/* printf ( "\n # best fit: Y = %g + %g X + %g X^2 +%g X^3 + %g X^4\n",
C(0), C(1), C(2), C(3), C(4));
printf ("# sumsq = %g\n", sumsq); */
fprintf (stdout, "%11g\t%11g\t%11g\t%11g\t%11g\n",
C(0), C(1), C(2), C(3), C(4));
/*
printf ("# covariance matrix:\n");
printf ("[ %+.5e, %+.5e, %+.5e \n",
COV(0,0), COV(0,1), COV(0,2));
printf (" %+.5e, %+.5e, %+.5e \n",
COV(1,0), COV(1,1), COV(1,2));
printf (" %+.5e, %+.5e, %+.5e ]\n",
COV(2,0), COV(2,1), COV(2,2));
printf ("# chisq = %g\n", chisq);
*/
}
gsl_multifit_linear_free (work); work = NULL;
free(dar); dar = NULL; /* done with input array */
gsl_vector_free (y);
gsl_vector_free (c);
gsl_matrix_free (cov);
gsl_matrix_free (X);
//gsl_vector_free (w);
fprintf (stderr,"\n");
return 0;
}
int
test_fdf(const char * desc,
gsl_multimin_function_fdf *f,
initpt_function initpt,
const gsl_multimin_fdfminimizer_type *T)
{
int status;
size_t iter = 0;
double step_size;
gsl_vector *x = gsl_vector_alloc (f->n);
gsl_multimin_fdfminimizer *s;
fcount = 0; gcount = 0;
(*initpt) (x);
step_size = 0.1 * gsl_blas_dnrm2 (x);
s = gsl_multimin_fdfminimizer_alloc(T, f->n);
gsl_multimin_fdfminimizer_set (s, f, x, step_size, 0.1);
#ifdef DEBUG
printf("x "); gsl_vector_fprintf (stdout, s->x, "%g");
printf("g "); gsl_vector_fprintf (stdout, s->gradient, "%g");
#endif
do
{
iter++;
status = gsl_multimin_fdfminimizer_iterate(s);
#ifdef DEBUG
printf("%i: \n",iter);
printf("x "); gsl_vector_fprintf (stdout, s->x, "%g");
printf("g "); gsl_vector_fprintf (stdout, s->gradient, "%g");
printf("f(x) %g\n",s->f);
printf("dx %g\n",gsl_blas_dnrm2(s->dx));
printf("status=%d\n", status);
printf("\n");
#endif
if (status == GSL_ENOPROG)
break;
status = gsl_multimin_test_gradient(s->gradient,1e-3);
}
while (iter < 5000 && status == GSL_CONTINUE);
/* If no error in iteration, test for numerical convergence */
if (status == GSL_CONTINUE || status == GSL_ENOPROG)
status = (fabs(s->f) > 1e-5);
gsl_test(status, "%s, on %s: %i iters (fn+g=%d+%d), f(x)=%g",
gsl_multimin_fdfminimizer_name(s),desc, iter, fcount, gcount, s->f);
gsl_multimin_fdfminimizer_free(s);
gsl_vector_free(x);
return status;
}
/* coefficients as well */
double singleChi(const double *sampletimes, const float *vals, const float *stderrs,
long ndata, long nharmonics, double tstart,
double frequency, float *harmoniccoeffs)
{
#define MAXHARM 17
int i, j, d;
int result;
double alpha[2*MAXHARM+1][2*MAXHARM+1];
double beta[2*MAXHARM+1];
double chisqred;
gsl_matrix *alpha_gsl = gsl_matrix_alloc(2 * nharmonics + 1,2 * nharmonics + 1);
gsl_vector *beta_gsl = gsl_vector_alloc(2 * nharmonics + 1);
gsl_vector *x_gsl = gsl_vector_alloc(2 * nharmonics + 1);
assert(nharmonics <= MAXHARM);
for (i = 0 ; i < 2*nharmonics+1 ; i++)
{
beta[i] = 0;
for (j = 0 ; j < 2*nharmonics+1 ; j++)
alpha[i][j] = 0;
}
for (d = 0 ; d < ndata ; d++)
{
for (i = 0 ; i < 2*nharmonics+1 ; i++)
{
double invvar = 1/(stderrs[d] * stderrs[d]);
beta[i] += vals[d]
* invvar
* Mfunc(i, (sampletimes[d] - tstart) * frequency * 2 * M_PI);
for (j = 0 ; j < 2*nharmonics+1 ; j++)
alpha[i][j] += invvar
* Mfunc(i, (sampletimes[d] - tstart) * frequency * 2 * M_PI)
* Mfunc(j, (sampletimes[d] - tstart) * frequency * 2 * M_PI);
}
}
for (i = 0 ; i < 2*nharmonics+1 ; i++)
{
gsl_vector_set(beta_gsl, i, beta[i]);
for (j = 0 ; j < 2*nharmonics+1 ; j++)
gsl_matrix_set(alpha_gsl, i, j, alpha[i][j]);
}
result = gsl_linalg_HH_solve(alpha_gsl, beta_gsl, x_gsl);
/* x = alpha^-1 beta */
assert(result == 0);
gsl_blas_ddot(x_gsl, beta_gsl, &chisqred);
if (harmoniccoeffs)
{
for (i = 0 ; i < 2*nharmonics+1 ; i++)
{
harmoniccoeffs[i] = gsl_vector_get(x_gsl, i);
}
}
gsl_matrix_free(alpha_gsl);
gsl_vector_free(beta_gsl);
gsl_vector_free(x_gsl);
return chisqred;
}
void
test_eigen_symm_results (const gsl_matrix * A,
const gsl_vector * eval,
const gsl_matrix * evec,
size_t count,
const char * desc,
const char * desc2)
{
const size_t N = A->size1;
size_t i, j;
double emax = 0;
gsl_vector * x = gsl_vector_alloc(N);
gsl_vector * y = gsl_vector_alloc(N);
/* check eigenvalues */
for (i = 0; i < N; i++)
{
double ei = gsl_vector_get (eval, i);
if (fabs(ei) > emax) emax = fabs(ei);
}
for (i = 0; i < N; i++)
{
double ei = gsl_vector_get (eval, i);
gsl_vector_const_view vi = gsl_matrix_const_column(evec, i);
gsl_vector_memcpy(x, &vi.vector);
/* compute y = A x (should = lambda v) */
gsl_blas_dgemv (CblasNoTrans, 1.0, A, x, 0.0, y);
for (j = 0; j < N; j++)
{
double xj = gsl_vector_get (x, j);
double yj = gsl_vector_get (y, j);
double eixj = chop_subnormals(ei * xj);
gsl_test_abs(yj, eixj, emax * 1e8 * GSL_DBL_EPSILON,
"%s, eigenvalue(%d,%d), %s", desc, i, j, desc2);
}
}
/* check eigenvectors are orthonormal */
for (i = 0; i < N; i++)
{
gsl_vector_const_view vi = gsl_matrix_const_column(evec, i);
double nrm_v = gsl_blas_dnrm2(&vi.vector);
gsl_test_rel (nrm_v, 1.0, N * GSL_DBL_EPSILON, "%s, normalized(%d), %s",
desc, i, desc2);
}
for (i = 0; i < N; i++)
{
gsl_vector_const_view vi = gsl_matrix_const_column(evec, i);
for (j = i + 1; j < N; j++)
{
gsl_vector_const_view vj = gsl_matrix_const_column(evec, j);
double vivj;
gsl_blas_ddot (&vi.vector, &vj.vector, &vivj);
gsl_test_abs (vivj, 0.0, N * GSL_DBL_EPSILON,
"%s, orthogonal(%d,%d), %s", desc, i, j, desc2);
}
}
gsl_vector_free(x);
gsl_vector_free(y);
}
static void
lmder_free (void *vstate)
{
lmder_state_t *state = (lmder_state_t *) vstate;
gsl_permutation_free (state->perm);
gsl_vector_free (state->work1);
gsl_vector_free (state->w);
gsl_vector_free (state->rptdx);
gsl_vector_free (state->sdiag);
gsl_vector_free (state->df);
gsl_vector_free (state->f_trial);
gsl_vector_free (state->x_trial);
gsl_vector_free (state->gradient);
gsl_vector_free (state->newton);
gsl_vector_free (state->qtf);
gsl_vector_free (state->diag);
gsl_vector_free (state->tau);
gsl_matrix_free (state->r);
}
void
test_eigen_genherm(void)
{
size_t N_max = 20;
size_t n, i;
gsl_rng *r = gsl_rng_alloc(gsl_rng_default);
for (n = 1; n <= N_max; ++n)
{
gsl_matrix_complex * A = gsl_matrix_complex_alloc(n, n);
gsl_matrix_complex * B = gsl_matrix_complex_alloc(n, n);
gsl_matrix_complex * ma = gsl_matrix_complex_alloc(n, n);
gsl_matrix_complex * mb = gsl_matrix_complex_alloc(n, n);
gsl_vector * eval = gsl_vector_alloc(n);
gsl_vector * evalv = gsl_vector_alloc(n);
gsl_vector * x = gsl_vector_alloc(n);
gsl_vector * y = gsl_vector_alloc(n);
gsl_vector_complex * work = gsl_vector_complex_alloc(n);
gsl_matrix_complex * evec = gsl_matrix_complex_alloc(n, n);
gsl_eigen_genherm_workspace * w = gsl_eigen_genherm_alloc(n);
gsl_eigen_genhermv_workspace * wv = gsl_eigen_genhermv_alloc(n);
for (i = 0; i < 5; ++i)
{
create_random_herm_matrix(A, r, -10, 10);
create_random_complex_posdef_matrix(B, r, work);
gsl_matrix_complex_memcpy(ma, A);
gsl_matrix_complex_memcpy(mb, B);
gsl_eigen_genhermv(ma, mb, evalv, evec, wv);
test_eigen_genherm_results(A, B, evalv, evec, i, "random", "unsorted");
gsl_matrix_complex_memcpy(ma, A);
gsl_matrix_complex_memcpy(mb, B);
gsl_eigen_genherm(ma, mb, eval, w);
/* eval and evalv have to be sorted? not sure why */
gsl_vector_memcpy(x, eval);
gsl_vector_memcpy(y, evalv);
gsl_sort_vector(x);
gsl_sort_vector(y);
test_eigenvalues_real(y, x, "genherm, random", "unsorted");
gsl_eigen_genhermv_sort(evalv, evec, GSL_EIGEN_SORT_VAL_ASC);
test_eigen_genherm_results(A, B, evalv, evec, i, "random", "val/asc");
gsl_eigen_genhermv_sort(evalv, evec, GSL_EIGEN_SORT_VAL_DESC);
test_eigen_genherm_results(A, B, evalv, evec, i, "random", "val/desc");
gsl_eigen_genhermv_sort(evalv, evec, GSL_EIGEN_SORT_ABS_ASC);
test_eigen_genherm_results(A, B, evalv, evec, i, "random", "abs/asc");
gsl_eigen_genhermv_sort(evalv, evec, GSL_EIGEN_SORT_ABS_DESC);
test_eigen_genherm_results(A, B, evalv, evec, i, "random", "abs/desc");
}
gsl_matrix_complex_free(A);
gsl_matrix_complex_free(B);
gsl_matrix_complex_free(ma);
gsl_matrix_complex_free(mb);
gsl_vector_free(eval);
gsl_vector_free(evalv);
gsl_vector_free(x);
gsl_vector_free(y);
gsl_vector_complex_free(work);
gsl_matrix_complex_free(evec);
gsl_eigen_genherm_free(w);
gsl_eigen_genhermv_free(wv);
}
gsl_rng_free(r);
} /* test_eigen_genherm() */
int main(int argc, char **argv)
{
gsl_matrix *Original;
gsl_matrix *Mtr_Cov;
FILE *input;
int num_lineas;
int i,j,k;
double var;
/*---------------------------------------------------------
Verifica cuales archivos fueron usados como input y se asegura de que solo haya cargado uno.
-----------------------------------------------------------*/
printf("Este programa se ejecutó con %d argumento(s):\n",argc-1);
for(i=1;i<argc;i++){
printf("%s\n", argv[i]);
}
if(argc!=2){
printf("se necesita 1 argumento además del nombre del ejecutable!,\n EXIT!\n");
exit(1);
}
else{
printf("El archivo a usar es %s\n", argv[1]);
}
//--------------------------------------------------------
input=fopen(argv[1],"r");
if(!input){
printf("surgió un problema abriendo el archivo\n");
exit(1);
}
/*---------------------------------------------------------
toma como archivo base el primer argumento y cuenta sus lineas
-----------------------------------------------------------*/
num_lineas=0;
while ((var = fgetc(input)) != EOF){
if (var =='\n')
++num_lineas;
}
//printf("Número de lineas del archivo:\n -->%d\n",num_lineas);
/*---------------------------------------------------------
Data allocation
-----------------------------------------------------------*/
rewind(input);
Original=gsl_matrix_alloc((num_lineas),24);
// printf("\nOriginal\n");
gsl_matrix_fscanf(input,Original);
//gsl_matrix_fprintf (stdout, Original, "%g");
//CheckPoint
//printf("matriz escaneada\n");
/*---------------------------------------------------------
Promedio
-----------------------------------------------------------*/
float *prom;
int y;
prom=malloc((num_lineas) * sizeof(float));
//printf("...\n");
for(k=0;k<num_lineas;k++){
float suma=0.0;
for(y=0;y<24;y++){
suma+=gsl_matrix_get(Original,k,y);
}
prom[k]=suma/24.0;
}
printf("Checkpoint... Promedios\n");
/*---------------------------------------------------------
Efectos en la matriz
-----------------------------------------------------------*/
Mtr_Cov=gsl_matrix_alloc(num_lineas,num_lineas);
//printf("...\n");
int l,n,m;
double sprite=0;
for(l=0;l<num_lineas;l++){
for(m=0;m<num_lineas;m++){
for(n=1;n<24;n++){
double flan=gsl_matrix_get(Original,m,n);
double agua=prom[m];
double frutino=gsl_matrix_get(Original,l,n);
double tang=prom[l];
double jarra1=(flan-agua);
double jarra2=(frutino-tang);
//printf("%g %g\n",jarra1,jarra2);
sprite=sprite+(jarra1*jarra2)/24;
}
gsl_matrix_set(Mtr_Cov,m,l,sprite);
sprite=0;
}}
/*---------------------------------------------------------
Matriz de covarianza creada;
sacar vectores y valores propios de la matriz.
-----------------------------------------------------------*/
/*
int pa,po;
double can;
for(pa=0;pa<num_lineas;pa++){
for(po=0;po<num_lineas;po++){
can=gsl_matrix_get(Mtr_Cov,po,pa);
printf("%f ",can);
}
printf("\n");
}
*/
gsl_eigen_symmv_workspace * w = gsl_eigen_symmv_alloc (num_lineas);
gsl_vector *eval = gsl_vector_alloc (num_lineas);
gsl_matrix *evec = gsl_matrix_alloc (num_lineas,num_lineas);
gsl_eigen_symmv (Mtr_Cov, eval, evec, w);
gsl_eigen_symmv_sort (eval, evec,GSL_EIGEN_SORT_ABS_ASC);
/*---------------------------------------------------------
PON ESA COSA HORROROSA AHI O VERAS!!!
-----------------------------------------------------------*/
FILE *Out1;
FILE *Out2;
Out1 = fopen("JorgeHayek_eigenvalues.dat", "w");
Out2 = fopen("JorgeHayek_eigenvectors.dat", "w");
fprintf(Out1,"EigenValues:\n");
fprintf(Out2,"EigenVectors:\n");
for (i = 0; i < num_lineas; i++)
{
double eval_i = gsl_vector_get (eval, i);
fprintf (Out1,"%g\n", eval_i);
}
for (i = 0; i < 11; i++)
{fprintf(Out2,"--------------------------------------------\nVector %d\n--------------------------------------------\n",i);
gsl_vector_view evec_i
= gsl_matrix_column (evec, i);
gsl_vector_fprintf (Out2,
&evec_i.vector, "%g");
}
/*---------------------------------------------------------
FIN
-----------------------------------------------------------*/
gsl_vector_free (eval);
gsl_matrix_free (evec);
gsl_matrix_free(Original);
fclose(input);
return 0;
}
void ssm_input_free(ssm_input_t *input)
{
gsl_vector_free(input);
}
int DPMHC_xi_smplr(struct str_DPMHC *ptr_DPMHC_data, int i_J, struct str_firm_data *a_firm_data)
{
int j,i;
int i_K = ptr_DPMHC_data->i_K;
int i_n = ptr_DPMHC_data->v_y->size; // is this the same as i_J???
if (i_n != i_J){
fprintf(stderr,"Error in DPMN_xi_smplr(): DPMHC.v_y length does not equal i_J\n");
exit(1);
}
double d_sumT_si;
gsl_vector_int *vi_S = ptr_DPMHC_data->vi_S;
gsl_matrix *m_theta = ptr_DPMHC_data->m_DPtheta;
double d_A = ptr_DPMHC_data->d_A;
double d_mu_si, d_tau_si, d_ei;
double d_mean_j, d_var_j;
double d_xi_j;
int i_Ti;
int i_factors = (a_firm_data[0].v_beta)->size;
gsl_vector *v_ret;
gsl_matrix *m_factors;
gsl_vector *v_betai;
gsl_vector *v_rstar_i;
gsl_matrix *m_Xi;
gsl_matrix_view mv_Xi;
double d_rstar_j;
double d_s2i;
for(j=0;j<i_K;j++){
d_mu_si = mget(m_theta,j,0);
d_tau_si = mget(m_theta,j,2);
d_rstar_j = 0.;
d_sumT_si = 0;
for(i=0;i<i_J;i++){
if( vget_int(vi_S,i) == j ){
d_ei = vget(ptr_DPMHC_data->v_e,i);
m_factors = a_firm_data[i].m_factors;
i_Ti = a_firm_data[i].i_ni;
d_s2i = a_firm_data[i].d_s2;
m_Xi = gsl_matrix_alloc(i_Ti,i_factors);
mv_Xi = gsl_matrix_submatrix(m_factors,0,0,i_Ti,i_factors);
gsl_matrix_memcpy(m_Xi,&mv_Xi.matrix);
v_betai = a_firm_data[i].v_beta;
v_ret = a_firm_data[i].v_ret;
v_rstar_i = gsl_vector_alloc(i_Ti);
gsl_vector_memcpy(v_rstar_i,v_ret);
gsl_blas_dgemv(CblasNoTrans, -1.0, m_Xi, v_betai, 1.0, v_rstar_i);
gsl_vector_add_constant(v_rstar_i, -d_mu_si);
gsl_vector_scale(v_rstar_i, 1./(sqrt(d_tau_si) * d_ei) );
d_rstar_j += sum(v_rstar_i);
d_sumT_si += i_Ti/(d_s2i/(d_tau_si * d_ei * d_ei) );
gsl_matrix_free(m_Xi);
gsl_vector_free(v_rstar_i);
}
}
d_var_j = 1./( 1./(d_A * d_A) + d_sumT_si);
d_mean_j = d_rstar_j * d_var_j;
d_xi_j = d_mean_j + gsl_ran_gaussian_ziggurat(rng, sqrt(d_var_j) );
mset(m_theta, j, 1, d_xi_j);
// printf("%d: eta = %g lambda^2 = %g\n",j, mget(m_theta,j,0), mget(m_theta,j,1) );
}
return 0;
}
void ssm_par_free(ssm_par_t *par)
{
gsl_vector_free(par);
}
static int
hybrid_alloc (void *vstate, size_t n)
{
hybrid_state_t *state = (hybrid_state_t *) vstate;
gsl_matrix *J, *q, *r;
gsl_vector *tau, *diag, *qtf, *newton, *gradient, *x_trial, *f_trial,
*df, *qtdf, *rdx, *w, *v;
J = gsl_matrix_calloc (n, n);
if (J == 0)
{
GSL_ERROR_VAL ("failed to allocate space for J", GSL_ENOMEM, 0);
}
state->J = J;
q = gsl_matrix_calloc (n, n);
if (q == 0)
{
gsl_matrix_free (J);
GSL_ERROR_VAL ("failed to allocate space for q", GSL_ENOMEM, 0);
}
state->q = q;
r = gsl_matrix_calloc (n, n);
if (r == 0)
{
gsl_matrix_free (J);
gsl_matrix_free (q);
GSL_ERROR_VAL ("failed to allocate space for r", GSL_ENOMEM, 0);
}
state->r = r;
tau = gsl_vector_calloc (n);
if (tau == 0)
{
gsl_matrix_free (J);
gsl_matrix_free (q);
gsl_matrix_free (r);
GSL_ERROR_VAL ("failed to allocate space for tau", GSL_ENOMEM, 0);
}
state->tau = tau;
diag = gsl_vector_calloc (n);
if (diag == 0)
{
gsl_matrix_free (J);
gsl_matrix_free (q);
gsl_matrix_free (r);
gsl_vector_free (tau);
GSL_ERROR_VAL ("failed to allocate space for diag", GSL_ENOMEM, 0);
}
state->diag = diag;
qtf = gsl_vector_calloc (n);
if (qtf == 0)
{
gsl_matrix_free (J);
gsl_matrix_free (q);
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
GSL_ERROR_VAL ("failed to allocate space for qtf", GSL_ENOMEM, 0);
}
state->qtf = qtf;
newton = gsl_vector_calloc (n);
if (newton == 0)
{
gsl_matrix_free (J);
gsl_matrix_free (q);
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
GSL_ERROR_VAL ("failed to allocate space for newton", GSL_ENOMEM, 0);
}
state->newton = newton;
gradient = gsl_vector_calloc (n);
if (gradient == 0)
{
gsl_matrix_free (J);
gsl_matrix_free (q);
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
GSL_ERROR_VAL ("failed to allocate space for gradient", GSL_ENOMEM, 0);
}
state->gradient = gradient;
x_trial = gsl_vector_calloc (n);
if (x_trial == 0)
{
gsl_matrix_free (J);
gsl_matrix_free (q);
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
GSL_ERROR_VAL ("failed to allocate space for x_trial", GSL_ENOMEM, 0);
}
state->x_trial = x_trial;
f_trial = gsl_vector_calloc (n);
if (f_trial == 0)
{
gsl_matrix_free (J);
gsl_matrix_free (q);
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
GSL_ERROR_VAL ("failed to allocate space for f_trial", GSL_ENOMEM, 0);
}
state->f_trial = f_trial;
df = gsl_vector_calloc (n);
if (df == 0)
{
gsl_matrix_free (J);
gsl_matrix_free (q);
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
GSL_ERROR_VAL ("failed to allocate space for df", GSL_ENOMEM, 0);
}
state->df = df;
qtdf = gsl_vector_calloc (n);
if (qtdf == 0)
{
gsl_matrix_free (J);
gsl_matrix_free (q);
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
GSL_ERROR_VAL ("failed to allocate space for qtdf", GSL_ENOMEM, 0);
}
state->qtdf = qtdf;
rdx = gsl_vector_calloc (n);
if (rdx == 0)
{
gsl_matrix_free (J);
gsl_matrix_free (q);
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
gsl_vector_free (qtdf);
GSL_ERROR_VAL ("failed to allocate space for rdx", GSL_ENOMEM, 0);
}
state->rdx = rdx;
w = gsl_vector_calloc (n);
if (w == 0)
{
gsl_matrix_free (J);
gsl_matrix_free (q);
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
gsl_vector_free (qtdf);
gsl_vector_free (rdx);
GSL_ERROR_VAL ("failed to allocate space for w", GSL_ENOMEM, 0);
}
state->w = w;
v = gsl_vector_calloc (n);
if (v == 0)
{
gsl_matrix_free (J);
gsl_matrix_free (q);
gsl_matrix_free (r);
gsl_vector_free (tau);
gsl_vector_free (diag);
gsl_vector_free (qtf);
gsl_vector_free (newton);
gsl_vector_free (gradient);
gsl_vector_free (x_trial);
gsl_vector_free (f_trial);
gsl_vector_free (df);
gsl_vector_free (qtdf);
gsl_vector_free (rdx);
gsl_vector_free (w);
GSL_ERROR_VAL ("failed to allocate space for v", GSL_ENOMEM, 0);
}
state->v = v;
return GSL_SUCCESS;
}
void ssm_theta_free(ssm_theta_t *theta)
{
gsl_vector_free(theta);
}
int GMRFLib_gsl_ginv(gsl_matrix * A, double tol, int rankdef)
{
/*
* replace n x n matrix A with its generlized inverse. if TOL > 0, use that tolerance. If rankdef is set, use that. If both are set, give an error.
*/
assert(A && (A->size1 == A->size2));
gsl_matrix *U = GMRFLib_gsl_duplicate_matrix(A);
gsl_matrix *V = gsl_matrix_alloc(A->size1, A->size2);
gsl_vector *S = gsl_vector_alloc(A->size1);
gsl_vector *work = gsl_vector_alloc(A->size1);
gsl_linalg_SV_decomp(U, V, S, work);
size_t i;
double one = 1.0, zero = 0.0;
double s_max = gsl_vector_get(S, 0);
gsl_matrix *M1 = gsl_matrix_alloc(A->size1, A->size2);
gsl_matrix *M2 = gsl_matrix_alloc(A->size1, A->size2);
assert(!(tol > 0.0 && (rankdef >= 0 && rankdef <= (int) A->size1)));
if (tol > 0.0){
for(i = 0; i < A->size1; i++){
double s = gsl_vector_get(S, i);
if (s < tol * s_max) {
gsl_matrix_set(M2, i, i, 0.0);
} else {
gsl_matrix_set(M2, i, i, 1.0/s);
}
}
} else {
assert(rankdef >= 0);
assert(rankdef <= (int)A->size1);
double first = gsl_vector_get(S, 0);
double last = gsl_vector_get(S, A->size1-1);
for(i = 0; i < A->size1; i++){
double s = gsl_vector_get(S, i);
if (first > last){
// do not use the last 'rdef's
if (i < (int) A->size1 - rankdef){
gsl_matrix_set(M2, i, i, 1.0/s);
} else {
gsl_matrix_set(M2, i, i, 0.0);
}
} else {
// do not use the first 'rdef's
if (i < rankdef){
gsl_matrix_set(M2, i, i, 0.0);
} else {
gsl_matrix_set(M2, i, i, 1.0/s);
}
}
}
}
gsl_blas_dgemm(CblasNoTrans, CblasTrans, one, M2, U, zero, M1);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, one, V, M1, zero, M2);
gsl_matrix_memcpy(A, M2);
gsl_matrix_free(U);
gsl_matrix_free(V);
gsl_matrix_free(M1);
gsl_matrix_free(M2);
gsl_vector_free(S);
gsl_vector_free(work);
return GMRFLib_SUCCESS;
}
int GlmTest::GeeScore(gsl_matrix *X1, glm *PtrNull, gsl_vector *teststat) {
gsl_set_error_handler_off();
double result, alpha, sum = 0;
unsigned int i, j, l, nP = X1->size2;
unsigned int nVars = tm->nVars, nRows = tm->nRows;
int status;
gsl_vector *U = gsl_vector_alloc(nVars * nP);
gsl_matrix *kRlNull = gsl_matrix_alloc(nVars * nP, nVars * nP);
gsl_matrix_set_zero(kRlNull);
gsl_matrix *XwX = gsl_matrix_alloc(nP, nP);
gsl_vector *tmp = gsl_vector_alloc(nVars * nP);
gsl_vector_view wj, uj, rj, tmp2; //, dj;
gsl_matrix_view Rl;
GrpMat *Z = (GrpMat *)malloc(nVars * sizeof(GrpMat));
for (j = 0; j < nVars; j++) {
Z[j].matrix = gsl_matrix_alloc(nRows, nP);
// get W^1/2 * X
wj = gsl_matrix_column(PtrNull->wHalf, j);
for (i = 0; i < nP; i++)
gsl_matrix_set_col(Z[j].matrix, i, &wj.vector);
gsl_matrix_mul_elements(Z[j].matrix, X1);
uj = gsl_vector_subvector(U, j * nP, nP);
rj = gsl_matrix_column(PtrNull->Res, j);
gsl_blas_dgemv(CblasTrans, 1, Z[j].matrix, &rj.vector, 0, &uj.vector);
if ((tm->punit != NONE) || (tm->corr == IDENTITY)) {
gsl_matrix_set_identity(XwX);
gsl_blas_dsyrk(CblasLower, CblasTrans, 1, Z[j].matrix, 0, XwX);
status = gsl_linalg_cholesky_decomp(XwX);
if (status == GSL_EDOM) {
if (tm->warning == TRUE)
printf("Warning: singular matrix in score test. An eps*I is added to "
"the singular matrix.\n");
gsl_matrix_set_identity(XwX);
gsl_blas_dsyrk(CblasLower, CblasTrans, 1, Z[j].matrix, eps, XwX);
gsl_linalg_cholesky_decomp(XwX);
}
tmp2 = gsl_vector_subvector(tmp, 0, nP);
gsl_linalg_cholesky_solve(XwX, &uj.vector, &tmp2.vector);
gsl_blas_ddot(&uj.vector, &tmp2.vector, &result);
gsl_vector_set(teststat, j + 1, result);
sum = sum + result;
}
if (tm->corr != IDENTITY) {
for (l = 0; l <= j; l++) { // lower half
alpha = gsl_matrix_get(Rlambda, j, l);
Rl = gsl_matrix_submatrix(kRlNull, j * nP, l * nP, nP, nP);
gsl_blas_dgemm(CblasTrans, CblasNoTrans, alpha, Z[j].matrix,
Z[l].matrix, 0, &Rl.matrix);
}
}
} // end for j=1:nVars
// multivariate test stat
if (tm->corr == IDENTITY)
gsl_vector_set(teststat, 0, sum);
else {
status = gsl_linalg_cholesky_decomp(kRlNull);
if (status == GSL_EDOM) {
if (tm->warning == TRUE)
printf("Warning:singular kRlNull in multivariate score test.\n");
}
gsl_linalg_cholesky_solve(kRlNull, U, tmp);
gsl_blas_ddot(U, tmp, &result);
gsl_vector_set(teststat, 0, result);
}
// clear memory
gsl_vector_free(U);
gsl_vector_free(tmp);
gsl_matrix_free(XwX);
gsl_matrix_free(kRlNull);
for (j = 0; j < nVars; j++)
gsl_matrix_free(Z[j].matrix);
free(Z);
return SUCCESS;
}
