int GlmTest::resampAnovaCase(glm *model, gsl_matrix *bT, gsl_matrix *bX, gsl_matrix *bO, unsigned int i) { gsl_set_error_handler_off(); int status, isValid = TRUE; unsigned int j, id, nP; gsl_vector_view yj, xj, oj; nP = model->Xref->size2; gsl_matrix *tXX = gsl_matrix_alloc(nP, nP); unsigned int nRows = tm->nRows; while (isValid == TRUE) { for (j = 0; j < nRows; j++) { if (bootID != NULL) id = (unsigned int)gsl_matrix_get(bootID, i, j); else { if (tm->reprand == TRUE) id = (unsigned int)gsl_rng_uniform_int(rnd, nRows); else id = (unsigned int)nRows * Rf_runif(0, 1); } // resample Y and X and offset yj = gsl_matrix_row(model->Yref, id); xj = gsl_matrix_row(model->Xref, id); oj = gsl_matrix_row(model->Eta, id); // oj = gsl_matrix_row(model->Oref, id); gsl_matrix_set_row(bT, j, &yj.vector); gsl_matrix_set_row(bX, j, &xj.vector); gsl_matrix_set_row(bO, j, &oj.vector); } gsl_matrix_set_identity(tXX); gsl_blas_dsyrk(CblasLower, CblasTrans, 1.0, bX, 0.0, tXX); status = gsl_linalg_cholesky_decomp(tXX); if (status != GSL_EDOM) break; } gsl_matrix_free(tXX); return SUCCESS; }
/* Initialise RMHMC kernel with initial parameters x. * Arguments: * kernel: a pointer to the RMHMC kernel structure. * x: an array of N doubles with initial parameters. N must be * equal to kernel->N. * Result: * returns 0 for success and non-zero for error. */ static int rmhmc_kernel_init(mcmc_kernel* kernel, const double* x){ int res,i,n; n = kernel->N; rmhmc_params* params = (rmhmc_params*)kernel->kernel_params; /* copy x to the kernel x state */ for ( i=0; i < n; i++) kernel->x[i] = x[i]; rmhmc_model* model = kernel->model_function; /* call user function to update all required quantities */ res = model->PosteriorAll(x, model->m_params, &(params->fx), params->dfx, params->cholMx, params->dMx); /* TODO: write a proper error handler */ if (res != 0){ fprintf(stderr,"rmhmc_kernel_init: Likelihood function failed\n"); return 1; } /* calculate cholesky factor for current metric */ gsl_matrix_view cholMx_v = gsl_matrix_view_array(params->cholMx,n,n); gsl_error_handler_t* old_handle = gsl_set_error_handler_off(); res = gsl_linalg_cholesky_decomp( &cholMx_v.matrix ); if (res != 0){ fprintf(stderr,"Error: matrix not positive definite in rmhmc_init.\n"); return -1; } gsl_set_error_handler(old_handle); /* calculate inverse for current metric */ gsl_matrix_view invMx_v = gsl_matrix_view_array(params->invMx,n,n); gsl_matrix_memcpy(&invMx_v.matrix, &cholMx_v.matrix ); gsl_linalg_cholesky_invert(&invMx_v.matrix); /* calculate trace terms from equation (15) in Girolami and Calderhead (2011) */ calculateTraceTerms(n, params->invMx, params->dMx, params->tr_invM_dM); return 0; }
double Matrix::determinant() { int rows = numRows(); int cols = numCols(); if (rows != cols){ QMessageBox::critical((ApplicationWindow *)applicationWindow(), tr("QtiPlot - Error"), tr("Calculation failed, the matrix is not square!")); return GSL_POSINF; } gsl_set_error_handler_off(); gsl_matrix *A = gsl_matrix_alloc(rows, cols); gsl_permutation * p = gsl_permutation_alloc(rows); if (!A || !p){ QApplication::restoreOverrideCursor(); QMessageBox::critical((ApplicationWindow *)applicationWindow(), tr("QtiPlot") + " - " + tr("Memory Allocation Error"), tr("Not enough memory, operation aborted!")); return 0.0; } QApplication::setOverrideCursor(QCursor(Qt::WaitCursor)); double *data = d_matrix_model->dataVector(); int i, cell = 0; for(i=0; i<rows; i++) for(int j=0; j<cols; j++) gsl_matrix_set(A, i, j, data[cell++]); gsl_linalg_LU_decomp(A, p, &i); double det = gsl_linalg_LU_det(A, i); gsl_matrix_free(A); gsl_permutation_free(p); QApplication::restoreOverrideCursor(); return det; }
int test_main(int, char* []) { #ifdef TEST_GSL gsl_set_error_handler_off(); #endif BOOST_MATH_CONTROL_FP; #ifndef BOOST_MATH_BUGGY_LARGE_FLOAT_CONSTANTS test_hankel(0.1F, "float"); #endif test_hankel(0.1, "double"); #ifndef BOOST_MATH_NO_LONG_DOUBLE_MATH_FUNCTIONS test_hankel(0.1L, "long double"); #else std::cout << "<note>The long double tests have been disabled on this platform " "either because the long double overloads of the usual math functions are " "not available at all, or because they are too inaccurate for these tests " "to pass.</note>" << std::cout; #endif return 0; }
int gsl_svd( const struct tc_mat *A, struct tc_mat *U, struct tc_mat *D, struct tc_mat *V) { if (!A || !U || !D || !V) return -1; if ((U->nr != A->nr) || (U->nc != A->nc)) tc_mat_resize(U, A->nr, A->nc); if ((V->nr != A->nc) || (V->nc != A->nc)) tc_mat_resize(V, A->nc, A->nc); if ((D->nr != A->nc) || (D->nc != A->nc)) tc_mat_resize(D, A->nc, A->nc); gsl_vector *gwork = gsl_vector_alloc(A->nc); gsl_vector *gS = gsl_vector_alloc(A->nc); gsl_matrix *gA = gsl_matrix_alloc(A->nr, A->nc); gsl_matrix *gV = gsl_matrix_alloc(A->nc, A->nc); for(uint32_t i=0; i < A->nr; i++) for(uint32_t j=0; j < A->nc; j++) gsl_matrix_set(gA, i, j, A->a[i][j]); gsl_set_error_handler_off(); int status = gsl_linalg_SV_decomp(gA, gV, gS, gwork); if (status != GSL_SUCCESS) return -2; for(uint32_t i=0; i < U->nr; i++) for(uint32_t j=0; j < U->nc; j++) U->a[i][j] = gsl_matrix_get(gA, i, j); for(uint32_t i=0; i < D->nr; i++) for(uint32_t j=0; j < D->nc; j++) D->a[i][j] = (i==j)? gsl_vector_get(gS, i): 0.0; for(uint32_t i=0; i < V->nr; i++) for(uint32_t j=0; j < V->nc; j++) V->a[i][j] = gsl_matrix_get(gV, i, j); gsl_vector_free(gwork); gsl_vector_free(gS); gsl_matrix_free(gA); gsl_matrix_free(gV); return 0; }
/** Initialisation method */ void Fit1D::init() { declareProperty(new WorkspaceProperty<MatrixWorkspace>("InputWorkspace","",Direction::Input), "Name of the input Workspace"); auto mustBePositive = boost::make_shared<BoundedValidator<int> >(); mustBePositive->setLower(0); declareProperty("WorkspaceIndex",0, mustBePositive, "The Workspace to fit, uses the workspace numbering of the spectra (default 0)"); declareProperty("StartX", EMPTY_DBL(), "A value of x in, or on the low x boundary of, the first bin to include in\n" "the fit (default lowest value of x)" ); declareProperty("EndX", EMPTY_DBL(), "A value in, or on the high x boundary of, the last bin the fitting range\n" "(default the highest value of x)" ); size_t i0 = getProperties().size(); // declare parameters specific to a given fitting function declareParameters(); // load the name of these specific parameter into a vector for later use const std::vector< Property* > props = getProperties(); for ( size_t i = i0; i < props.size(); i++ ) { m_parameterNames.push_back(props[i]->name()); } declareProperty("Fix","","A list of comma separated parameter names which should be fixed in the fit"); declareProperty("MaxIterations", 500, mustBePositive, "Stop after this number of iterations if a good fit is not found" ); declareProperty("OutputStatus","", Direction::Output); declareProperty("OutputChi2overDoF",0.0, Direction::Output); // Disable default gsl error handler (which is to call abort!) gsl_set_error_handler_off(); declareAdditionalProperties(); declareProperty("Output","","If not empty OutputParameters TableWorksace and OutputWorkspace will be created."); }
double gslInt_diffusion( double E, double ri, double r){ // int over Ep double E_scaled = (int)(E/c.scale); double vE = c.vlookup[E_scaled]; //std::cout <<"E_scaled = " << E_scaled << std::endl; //std::cout << c.n << " , " <<p.mx <<" "; //double Ep = (p.mx + E) /2; //std::cout <<E <<" -> vE = "<< vE << std::endl; //double scale = 0.001; //double Es = (int)(E*c.n/p.mx); //std::cout << sqrt(vE)/mpc2cm*1000 << " "<<sqrt(c.vlookup[ E*c.n/p.mx ])/mpc2cm*1000 <<std::endl;; //std::cout << Es << " LUT = " << sqrt(c.vlookup[ Es ])/mpc2cm*1000 << std::endl; //double rootdv =sqrt(c.vlookup[E*c.n/p.mx]) ;//0.035*mpc2cm ;//sqrt(c.vlookup[ Es ]); //gives max value for rootdv//root_dv(Ep, vE); // //std::cout << "umax: " << umax << std::endl; gsl_integration_workspace * w = gsl_integration_workspace_alloc (1000); double result, error; std::vector<double> diffusionParams (4); diffusionParams[0] = E; diffusionParams[1] = ri; diffusionParams[2] = vE; diffusionParams[3] = r; gsl_function F; F.function = &ddiffusion; F.params = &diffusionParams; //pass Ep to rootdv(), pass r from dndeeq as well, gsl_set_error_handler_off(); gsl_integration_qags (&F, E, p.mx, 0, 1e-1, 1000, w, &result, &error); //std::cout << "result = " << result <<std::endl; gsl_integration_workspace_free (w); return result; }
void FC_FUNC_(oct_1dminimize, OCT_1DMINIMIZE)(double *a, double *b, double *m, func1 f, int *status) { int iter = 0; int max_iter = 100; const gsl_min_fminimizer_type *T; gsl_min_fminimizer *s; gsl_function F; param_f1_t p; p.func = f; F.function = &fn1; F.params = (void *) &p; T = gsl_min_fminimizer_brent; s = gsl_min_fminimizer_alloc (T); *status = gsl_min_fminimizer_set (s, &F, *m, *a, *b); gsl_set_error_handler_off(); do { iter++; *status = gsl_min_fminimizer_iterate (s); *m = gsl_min_fminimizer_x_minimum (s); *a = gsl_min_fminimizer_x_lower (s); *b = gsl_min_fminimizer_x_upper (s); *status = gsl_min_test_interval (*a, *b, 0.00001, 0.0); /*if (*status == GSL_SUCCESS) printf ("Converged:\n");*/ /*printf ("%5d [%.7f, %.7f] %.7f \n", iter, *a, *b,*m);*/ } while (*status == GSL_CONTINUE && iter < max_iter); gsl_min_fminimizer_free(s); }
double epidemicGrowthRate(const double theta[numParam], const double r0time, double * eigenvec) { gsl_matrix * Fmat = gsl_matrix_calloc(NG*(DS-1)*RG, NG*(DS-1)*RG); gsl_matrix * Vmat = gsl_matrix_calloc(NG*(DS-1)*RG, NG*(DS-1)*RG); createNGM(theta, r0time, Fmat, Vmat); gsl_matrix_sub(Fmat, Vmat); gsl_eigen_nonsymmv_workspace * w = gsl_eigen_nonsymmv_alloc(NG*(DS-1)*RG); gsl_vector_complex * eval = gsl_vector_complex_alloc(NG*(DS-1)*RG); gsl_matrix_complex * evec = gsl_matrix_complex_alloc(NG*(DS-1)*RG, NG*(DS-1)*RG); gsl_set_error_handler_off(); gsl_eigen_nonsymmv(Fmat, eval, evec, w); size_t growth_rate_idx = 0; double growth_rate = -INFINITY; for(size_t i = 0; i < NG*(DS-1)*RG; i++){ if(GSL_REAL(gsl_vector_complex_get(eval, i)) > growth_rate){ growth_rate_idx = i; growth_rate = GSL_REAL(gsl_vector_complex_get(eval, i)); } } if(eigenvec != NULL){ for(size_t i = 0; i < NG*(DS-1)*RG; i++) eigenvec[i] = GSL_REAL(gsl_matrix_complex_get(evec, i, growth_rate_idx)); } gsl_matrix_free(Fmat); gsl_matrix_free(Vmat); gsl_vector_complex_free(eval); gsl_matrix_complex_free(evec); gsl_eigen_nonsymmv_free(w); return growth_rate; }
double sncp_model::propose_new_parameters(double alpha,double z,double previous_height, double bound,double norm){ gsl_error_handler_t * old_handler = gsl_set_error_handler_off(); double new_value=NAN; int count =0; while(new_value!=new_value){ double u = gsl_ran_flat(m_r,0,1); u*=norm; new_value = gsl_cdf_gamma_Pinv(u,alpha,1.0/(double)z); //if(new_value!=new_value) // cout<<u<<" "<<norm<<" "<<bound<<" "<<alpha<<" "<<z<<" "<<previous_height<<endl; count++; if(count>20 and bound>0){ new_value=(previous_height+bound)/2; //cout<<new_value<<endl; } } gsl_set_error_handler(old_handler); return new_value; }
int test_main(int, char* []) { #ifdef TEST_GSL gsl_set_error_handler_off(); #endif expected_results(); BOOST_MATH_CONTROL_FP; test_bessel(0.1F, "float"); test_bessel(0.1, "double"); #ifndef BOOST_MATH_NO_LONG_DOUBLE_MATH_FUNCTIONS test_bessel(0.1L, "long double"); #ifndef BOOST_MATH_NO_REAL_CONCEPT_TESTS test_bessel(boost::math::concepts::real_concept(0.1), "real_concept"); #endif #else std::cout << "<note>The long double tests have been disabled on this platform " "either because the long double overloads of the usual math functions are " "not available at all, or because they are too inaccurate for these tests " "to pass.</note>" << std::cout; #endif return 0; }
void conf(Args *args, Result *result){ const gsl_root_fsolver_type *solverType; gsl_root_fsolver *s; gsl_function fun; double xLo, xHi; int status; /* preliminaries */ gsl_set_error_handler_off(); fun.function = &confFun; fun.params = result; solverType = gsl_root_fsolver_brent; s = gsl_root_fsolver_alloc(solverType); /* search for lower bound of delta */ result->type = 2; if(result->de < 0) xLo = -1; else xLo = 0; xHi = result->de; status = gsl_root_fsolver_set(s,&fun,xLo,xHi); if(status){ printf("WARNING: Lower confidence limit of \\Delta cannot be estimated; setting it to -1.\n"); result->dLo = -1.0; }else result->dLo = iterate(args, s, xLo, xHi); /* search for upper bound of delta */ xLo = result->de; xHi = 1.0; status = gsl_root_fsolver_set(s,&fun,xLo,xHi); if(status){ printf("WARNING: Upper confidence limit of \\Delta cannot be estimated; setting it to 1.\n"); result->dUp = 1; }else result->dUp = iterate(args, s, xLo, xHi); gsl_root_fsolver_free(s); }
/* --------------------- Interface to Fortran ---------------------- */ double FC_FUNC_(c_poisson_cutoff_1d_0d, C_POISSON_CUTOFF_1D_0D) (double *g, double *a, double *rc) { double result, error; struct parameters_1d_0d params; const size_t wrk_size = 5000; const double epsilon_abs = 1e-3; const double epsilon_rel = 1e-3; int status; gsl_integration_workspace * ws; gsl_function F; if((*g) <= 0.0){return 2.0*asinh((*rc)/(*a));}; if((*g)*(*rc) > 100.0*M_PI){return 2.0*gsl_sf_bessel_K0((*a)*(*g));}; gsl_set_error_handler_off(); ws = gsl_integration_workspace_alloc (wrk_size); params.g = *g; params.a = *a; F.function = &cutoff_1d_0d; F.params = ¶ms; status = gsl_integration_qag(&F, 0.0, (*rc)*(*g), epsilon_abs, epsilon_rel, wrk_size, 3, ws, &result, &error); gsl_integration_workspace_free (ws); if(status){ return 0.0; }else{ return result; } }
/** Initialisation method */ void DiffractionEventCalibrateDetectors::init() { declareProperty(make_unique<WorkspaceProperty<EventWorkspace>>( "InputWorkspace", "", Direction::Input, boost::make_shared<InstrumentValidator>()), "The workspace containing the geometry to be calibrated."); declareProperty("Params", "", "A comma separated list of first bin boundary, width, last " "bin boundary. Optionally " "this can be followed by a comma and more widths and last " "boundary pairs. " "Use bin boundaries close to peak you wish to maximize. " "Negative width values indicate logarithmic binning."); auto mustBePositive = boost::make_shared<BoundedValidator<int>>(); declareProperty( "MaxIterations", 10, mustBePositive, "Stop after this number of iterations if a good fit is not found"); auto dblmustBePositive = boost::make_shared<BoundedValidator<double>>(); declareProperty("LocationOfPeakToOptimize", 2.0308, dblmustBePositive, "Optimize this location of peak by moving detectors"); declareProperty(make_unique<API::FileProperty>( "DetCalFilename", "", API::FileProperty::Save, ".DetCal"), "The output filename of the ISAW DetCal file"); declareProperty( make_unique<PropertyWithValue<std::string>>("BankName", "", Direction::Input), "Optional: To only calibrate one bank. Any bank whose name does not " "match the given string will have no events."); // Disable default gsl error handler (which is to call abort!) gsl_set_error_handler_off(); }
//Main program int main(int argc, char *argv[]) { INT4 ii, jj; //counter variables //Turn off gsl error handler gsl_set_error_handler_off(); //Initiate command line interpreter and config file loader struct gengetopt_args_info args_info; struct cmdline_parser_params *configparams; configparams = cmdline_parser_params_create(); //initialize parameters structure configparams->check_required = 0; //don't check for required values at the step if ( cmdline_parser_ext(argc, argv, &args_info, configparams) ) { fprintf(stderr, "%s: cmdline_parser_ext() failed.\n", __func__); XLAL_ERROR(XLAL_FAILURE); } configparams->initialize = 0; //don't reinitialize the parameters structure if ( args_info.config_given && cmdline_parser_config_file(args_info.config_arg, &args_info, configparams) ) { fprintf(stderr, "%s: cmdline_parser_config_file() failed.\n", __func__); XLAL_ERROR(XLAL_FAILURE); } //Check required if ( cmdline_parser_required(&args_info, argv[0]) ) { fprintf(stderr, "%s: cmdline_parser_required() failed.\n", __func__); XLAL_ERROR(XLAL_FAILURE); } //Set lalDebugLevel to user input or 0 if no input //Allocate input parameters structure memory inputParamsStruct *inputParams = new_inputParams(args_info.IFO_given); if (inputParams==NULL) { fprintf(stderr, "%s: new_inputParams() failed.\n", __func__); XLAL_ERROR(XLAL_EFUNC); } //Read TwoSpect input parameters if ( (readTwoSpectInputParams(inputParams, args_info)) != 0 ) { fprintf(stderr, "%s: readTwoSpectInputParams() failed.\n", __func__); XLAL_ERROR(XLAL_EFUNC); } //Initialize ephemeris data structure EphemerisData *edat = XLALInitBarycenter(earth_ephemeris, sun_ephemeris); if (edat==NULL) { fprintf(stderr, "%s: XLALInitBarycenter() failed.\n", __func__); XLAL_ERROR(XLAL_EFUNC); } //Maximum detector velocity in units of c from start of observation time - Tcoh to end of observation + Tcoh REAL4 detectorVmax = CompDetectorVmax(inputParams->searchstarttime-inputParams->Tcoh, inputParams->Tcoh, inputParams->SFToverlap, inputParams->Tobs+2.0*inputParams->Tcoh, inputParams->det[0], edat); if (xlalErrno!=0) { fprintf(stderr, "%s: CompDetectorVmax() failed.\n", __func__); XLAL_ERROR(XLAL_EFUNC); } //Assume maximum bin shift possible inputParams->maxbinshift = (INT4)round(detectorVmax * (inputParams->fmin+0.5*inputParams->fspan) * inputParams->Tcoh)+1; //Read in the T-F data from SFTs fprintf(stderr, "Loading in SFTs... "); REAL8 tfnormalization = 2.0/inputParams->Tcoh/(args_info.avesqrtSh_arg*args_info.avesqrtSh_arg); REAL4Vector *tfdata = readInSFTs(inputParams, &(tfnormalization)); if (tfdata==NULL) { fprintf(stderr, "\n%s: readInSFTs() failed.\n", __func__); XLAL_ERROR(XLAL_EFUNC); } fprintf(stderr, "done\n"); //Removing bad SFTs using K-S test and Kuiper's test if (inputParams->markBadSFTs!=0 && inputParams->signalOnly==0) { fprintf(stderr, "Marking and removing bad SFTs... "); INT4 numffts = (INT4)floor(inputParams->Tobs/(inputParams->Tcoh-inputParams->SFToverlap)-1); //Number of FFTs INT4 numfbins = (INT4)(round(inputParams->fspan*inputParams->Tcoh+2.0*inputParams->dfmax*inputParams->Tcoh)+12+1)+2*inputParams->maxbinshift+inputParams->blksize-1; //Number of frequency bins REAL4Vector *tempvect = XLALCreateREAL4Vector(numfbins); if (tempvect==NULL) { fprintf(stderr, "%s: XLALCreateREAL4Vector(%d) failed.\n", __func__, numfbins); XLAL_ERROR(XLAL_EFUNC); } REAL8 ksthreshold = 1.358/(sqrt(numfbins)+0.12+0.11/sqrt(numfbins)); REAL8 kuiperthreshold = 1.747/(sqrt(numfbins)+0.155+0.24/sqrt(numfbins)); //fprintf(stderr, "%f %f\n", ksthreshold, kuiperthreshold); INT4 badsfts = 0, badsfts0 = 0, kuiperoverlap1 = 0, kuiperoverlap2 = 0, totalsfts = 0; FILE *OUTPUT = fopen("./output/kskoutput.dat","a"); for (ii=0; ii<numffts; ii++) { if (tfdata->data[ii*numfbins]!=0.0) { totalsfts++; memcpy(tempvect->data, &(tfdata->data[ii*numfbins]), sizeof(REAL4)*tempvect->length); qsort(tempvect->data, tempvect->length, sizeof(REAL4), qsort_REAL4_compar); REAL4 vector_median = 0.0; if (tempvect->length % 2 != 1) vector_median = 0.5*(tempvect->data[(INT4)(0.5*tempvect->length)-1] + tempvect->data[(INT4)(0.5*tempvect->length)]); else vector_median = tempvect->data[(INT4)(0.5*tempvect->length)]; REAL4 vector_mean = (REAL4)(vector_median/LAL_LN2); REAL8 ksvalue = 0.0, testval1, testval2, testval; REAL8 oneoverlength = 1.0/tempvect->length; for (jj=0; jj<(INT4)tempvect->length; jj++) { testval1 = fabs((1.0+jj)*oneoverlength - gsl_cdf_exponential_P(tempvect->data[jj], vector_mean)); testval2 = fabs(jj*oneoverlength - gsl_cdf_exponential_P(tempvect->data[jj], vector_mean)); testval = fmax(testval1, testval2); if (testval>ksvalue) ksvalue = testval; } REAL8 loval = 0.0, hival = 0.0; for (jj=0; jj<(INT4)tempvect->length; jj++) { testval1 = (1.0+jj)*oneoverlength - gsl_cdf_exponential_P(tempvect->data[jj], vector_mean); testval2 = jj*oneoverlength - gsl_cdf_exponential_P(tempvect->data[jj], vector_mean); if (hival<testval1) hival = testval1; if (loval<testval2) loval = testval2; } REAL8 kuiperval1 = hival + loval; loval = -1.0, hival = -1.0; for (jj=0; jj<(INT4)tempvect->length; jj++) { testval1 = (1.0+jj)*oneoverlength - gsl_cdf_exponential_P(tempvect->data[jj], vector_mean); testval2 = jj*oneoverlength - gsl_cdf_exponential_P(tempvect->data[jj], vector_mean); if (hival<testval1) hival = testval1; if (hival<testval2) hival = testval2; if (loval<-testval1) loval = -testval1; if (loval<-testval2) loval = -testval2; } REAL8 kuiperval = hival + loval; //fprintf(OUTPUT, "%g %g %g\n", ksvalue, kuiperval1, kuiperval); if (ksvalue>ksthreshold || kuiperval1>kuiperthreshold) badsfts0++; if (ksvalue>ksthreshold || kuiperval>kuiperthreshold) badsfts++; if (kuiperval1>kuiperthreshold && kuiperval>kuiperthreshold) kuiperoverlap1++; if (kuiperval1>kuiperthreshold || kuiperval>kuiperthreshold) kuiperoverlap2++; } } fprintf(OUTPUT, "%f %d %d %d %d\n", inputParams->fmin, badsfts0, badsfts, kuiperoverlap1, kuiperoverlap2); fclose(OUTPUT); fprintf(stderr, "Fraction excluded in K-S and Kuiper's tests = %f\n", (REAL4)badsfts/(REAL4)totalsfts); XLALDestroyREAL4Vector(tempvect); } XLALDestroyREAL4Vector(tfdata); XLALDestroyEphemerisData(edat); cmdline_parser_free(&args_info); free_inputParams(inputParams); return 0; }
/** * MAIN function * Generates samples of B-stat and F-stat according to their pdfs for given signal-params. */ int main(int argc,char *argv[]) { UserInput_t XLAL_INIT_DECL(uvar); ConfigVariables XLAL_INIT_DECL(cfg); /**< various derived configuration settings */ vrbflg = 1; /* verbose error-messages */ LogSetLevel(lalDebugLevel); /* turn off default GSL error handler */ gsl_set_error_handler_off (); /* ----- register and read all user-variables ----- */ LogSetLevel(lalDebugLevel); if ( XLALInitUserVars( &uvar ) != XLAL_SUCCESS ) { LogPrintf ( LOG_CRITICAL, "%s: XLALInitUserVars() failed with errno=%d\n", __func__, xlalErrno ); return 1; } /* do ALL cmdline and cfgfile handling */ if ( XLALUserVarReadAllInput ( argc, argv ) != XLAL_SUCCESS ) { LogPrintf ( LOG_CRITICAL, "%s: XLALUserVarReadAllInput() failed with errno=%d\n", __func__, xlalErrno ); return 1; } if (uvar.help) /* if help was requested, we're done here */ return 0; if ( uvar.version ) { /* output verbose VCS version string if requested */ CHAR *vcs; if ( (vcs = XLALGetVersionString (lalDebugLevel)) == NULL ) { LogPrintf ( LOG_CRITICAL, "%s:XLALGetVersionString(%d) failed with errno=%d.\n", __func__, lalDebugLevel, xlalErrno ); return 1; } printf ( "%s\n", vcs ); XLALFree ( vcs ); return 0; } /* ---------- Initialize code-setup ---------- */ if ( XLALInitCode( &cfg, &uvar ) != XLAL_SUCCESS ) { LogPrintf (LOG_CRITICAL, "%s: XLALInitCode() failed with error = %d\n", __func__, xlalErrno ); XLAL_ERROR ( XLAL_EFUNC ); } /* ----- prepare stats output ----- */ FILE *fpTransientStats = NULL; if ( uvar.outputStats ) { if ( (fpTransientStats = fopen (uvar.outputStats, "wb")) == NULL) { LogPrintf (LOG_CRITICAL, "Error opening file '%s' for writing..\n\n", uvar.outputStats ); XLAL_ERROR ( XLAL_EIO ); } fprintf (fpTransientStats, "%s", cfg.logString ); /* write search log comment */ if ( write_transientCandidate_to_fp ( fpTransientStats, NULL ) != XLAL_SUCCESS ) { /* write header-line comment */ XLAL_ERROR ( XLAL_EFUNC ); } } /* if outputStats */ /* ----- prepare injection params output ----- */ FILE *fpInjParams = NULL; if ( uvar.outputInjParams ) { if ( (fpInjParams = fopen (uvar.outputInjParams, "wb")) == NULL) { LogPrintf (LOG_CRITICAL, "Error opening file '%s' for writing..\n\n", uvar.outputInjParams ); XLAL_ERROR ( XLAL_EIO ); } fprintf (fpInjParams, "%s", cfg.logString ); /* write search log comment */ if ( write_InjParams_to_fp ( fpInjParams, NULL, 0, 0, 0 ) != XLAL_SUCCESS ) { /* write header-line comment - options outputMmunuX and numDetectors not supported here, so pass defaults to deactivate them */ XLAL_ERROR ( XLAL_EFUNC ); } } /* if outputInjParams */ /* ----- main MC loop over numDraws trials ---------- */ multiAMBuffer_t XLAL_INIT_DECL(multiAMBuffer); /* prepare AM-buffer */ INT4 i; for ( i=0; i < uvar.numDraws; i ++ ) { InjParams_t XLAL_INIT_DECL(injParamsDrawn); /* ----- generate signal random draws from ranges and generate Fstat atoms */ MultiFstatAtomVector *multiAtoms; multiAtoms = XLALSynthesizeTransientAtoms ( &injParamsDrawn, cfg.skypos, cfg.AmpPrior, cfg.transientInjectRange, cfg.multiDetStates, cfg.SignalOnly, &multiAMBuffer, cfg.rng, -1, NULL ); // options lineX and noise_weights not supported here, so pass defaults to deactivate them if ( multiAtoms ==NULL ) { LogPrintf ( LOG_CRITICAL, "%s: XLALSynthesizeTransientAtoms() failed with xlalErrno = %d\n", __func__, xlalErrno ); XLAL_ERROR ( XLAL_EFUNC ); } /* ----- if requested, output signal injection parameters into file */ if ( fpInjParams && (write_InjParams_to_fp ( fpInjParams, &injParamsDrawn, uvar.dataStartGPS, 0, 0 ) ) != XLAL_SUCCESS ) { // options outputMmunuX and numDetectors not supported here, so pass defaults to deactivate them XLAL_ERROR ( XLAL_EFUNC ); } /* if fpInjParams & failure*/ /* ----- add meta-info on current transient-CW candidate */ transientCandidate_t XLAL_INIT_DECL(cand); cand.doppler.Alpha = multiAMBuffer.skypos.longitude; cand.doppler.Delta = multiAMBuffer.skypos.latitude; cand.windowRange = cfg.transientSearchRange; /* ----- if needed: compute transient-Bstat search statistic on these atoms */ if ( fpTransientStats || uvar.outputFstatMap || uvar.outputPosteriors ) { /* compute Fstat map F_mn over {t0, tau} */ if ( (cand.FstatMap = XLALComputeTransientFstatMap ( multiAtoms, cand.windowRange, uvar.useFReg)) == NULL ) { XLALPrintError ("%s: XLALComputeTransientFstatMap() failed with xlalErrno = %d.\n", __func__, xlalErrno ); XLAL_ERROR ( XLAL_EFUNC ); } } /* if we'll need the Fstat-map F_mn */ /* ----- if requested compute marginalized Bayes factor */ if ( fpTransientStats ) { cand.logBstat = XLALComputeTransientBstat ( cand.windowRange, cand.FstatMap ); UINT4 err = xlalErrno; if ( err ) { XLALPrintError ("%s: XLALComputeTransientBstat() failed with xlalErrno = %d\n", __func__, err ); XLAL_ERROR ( XLAL_EFUNC ); } if ( uvar.SignalOnly ) { cand.FstatMap->maxF += 2; cand.logBstat += 2; } } /* if Bstat requested */ /* ----- if requested, compute parameter posteriors for {t0, tau} */ pdf1D_t *pdf_t0 = NULL; pdf1D_t *pdf_tau = NULL; if ( fpTransientStats || uvar.outputPosteriors ) { if ( (pdf_t0 = XLALComputeTransientPosterior_t0 ( cand.windowRange, cand.FstatMap )) == NULL ) { XLALPrintError ("%s: failed to compute t0-posterior\n", __func__ ); XLAL_ERROR ( XLAL_EFUNC ); } if ( (pdf_tau = XLALComputeTransientPosterior_tau ( cand.windowRange, cand.FstatMap )) == NULL ) { XLALPrintError ("%s: failed to compute tau-posterior\n", __func__ ); XLAL_ERROR ( XLAL_EFUNC ); } /* get maximum-posterior estimate (MP) from the modes of these pdfs */ cand.t0_MP = XLALFindModeOfPDF1D ( pdf_t0 ); if ( xlalErrno ) { XLALPrintError ("%s: mode-estimation failed for pdf_t0. xlalErrno = %d\n", __func__, xlalErrno ); XLAL_ERROR ( XLAL_EFUNC ); } cand.tau_MP = XLALFindModeOfPDF1D ( pdf_tau ); if ( xlalErrno ) { XLALPrintError ("%s: mode-estimation failed for pdf_tau. xlalErrno = %d\n", __func__, xlalErrno ); XLAL_ERROR ( XLAL_EFUNC ); } } // if posteriors required /* ----- if requested, compute Ftotal over full data-span */ if ( uvar.computeFtotal ) { transientFstatMap_t *FtotalMap; /* prepare special window to cover all the data with one F-stat calculation == Ftotal */ transientWindowRange_t XLAL_INIT_DECL(winRangeAll); winRangeAll.type = TRANSIENT_NONE; BOOLEAN useFReg = false; if ( (FtotalMap = XLALComputeTransientFstatMap ( multiAtoms, winRangeAll, useFReg)) == NULL ) { XLALPrintError ("%s: XLALComputeTransientFstatMap() failed with xlalErrno = %d.\n", __func__, xlalErrno ); XLAL_ERROR ( XLAL_EFUNC ); } /* we only use twoFtotal = 2 * maxF from this single-Fstat calculation */ REAL8 twoFtotal = 2.0 * FtotalMap->maxF; if ( uvar.SignalOnly ) twoFtotal += 4; /* ugly hack: lacking a good container for twoFtotal, we borrow fkdot[3] for this here ;) [only used for paper-MCs] */ cand.doppler.fkdot[3] = twoFtotal; /* good riddance .. */ XLALDestroyTransientFstatMap ( FtotalMap ); } /* if computeFtotal */ /* ----- if requested, output atoms-vector into file */ if ( uvar.outputAtoms ) { FILE *fpAtoms; char *fnameAtoms; UINT4 len = strlen ( uvar.outputAtoms ) + 20; if ( (fnameAtoms = XLALCalloc ( 1, len )) == NULL ) { XLALPrintError ("%s: failed to XLALCalloc ( 1, %d )\n", __func__, len ); XLAL_ERROR ( XLAL_EFUNC ); } sprintf ( fnameAtoms, "%s_%04d_of_%04d.dat", uvar.outputAtoms, i + 1, uvar.numDraws ); if ( ( fpAtoms = fopen ( fnameAtoms, "wb" )) == NULL ) { XLALPrintError ("%s: failed to open atoms-output file '%s' for writing.\n", __func__, fnameAtoms ); XLAL_ERROR ( XLAL_EFUNC ); } fprintf ( fpAtoms, "%s", cfg.logString ); /* output header info */ if ( write_MultiFstatAtoms_to_fp ( fpAtoms, multiAtoms ) != XLAL_SUCCESS ) { XLALPrintError ("%s: failed to write atoms to output file '%s'. xlalErrno = %d\n", __func__, fnameAtoms, xlalErrno ); XLAL_ERROR ( XLAL_EFUNC ); } XLALFree ( fnameAtoms ); fclose (fpAtoms); } /* if outputAtoms */ /* ----- if requested, output Fstat-map over {t0, tau} */ if ( uvar.outputFstatMap ) { FILE *fpFstatMap; char *fnameFstatMap; UINT4 len = strlen ( uvar.outputFstatMap ) + 20; if ( (fnameFstatMap = XLALCalloc ( 1, len )) == NULL ) { XLALPrintError ("%s: failed to XLALCalloc ( 1, %d )\n", __func__, len ); XLAL_ERROR ( XLAL_EFUNC ); } sprintf ( fnameFstatMap, "%s_%04d_of_%04d.dat", uvar.outputFstatMap, i + 1, uvar.numDraws ); if ( ( fpFstatMap = fopen ( fnameFstatMap, "wb" )) == NULL ) { XLALPrintError ("%s: failed to open Fstat-map output file '%s' for writing.\n", __func__, fnameFstatMap ); XLAL_ERROR ( XLAL_EFUNC ); } fprintf ( fpFstatMap, "%s", cfg.logString ); /* output header info */ fprintf (fpFstatMap, "\nFstat_mn = \\\n" ); if ( XLALfprintfGSLmatrix ( fpFstatMap, "%.9g", cand.FstatMap->F_mn ) != XLAL_SUCCESS ) { XLALPrintError ("%s: XLALfprintfGSLmatrix() failed.\n", __func__ ); XLAL_ERROR ( XLAL_EFUNC ); } XLALFree ( fnameFstatMap ); fclose (fpFstatMap); } /* if outputFstatMap */ /* ----- if requested, output posterior pdfs on transient params {t0, tau} into a file */ if ( uvar.outputPosteriors ) { FILE *fpPosteriors; char *fnamePosteriors; UINT4 len = strlen ( uvar.outputPosteriors ) + 20; if ( (fnamePosteriors = XLALCalloc ( 1, len )) == NULL ) { XLALPrintError ("%s: failed to XLALCalloc ( 1, %d )\n", __func__, len ); XLAL_ERROR ( XLAL_EFUNC ); } sprintf ( fnamePosteriors, "%s_%04d_of_%04d.dat", uvar.outputPosteriors, i + 1, uvar.numDraws ); if ( ( fpPosteriors = fopen ( fnamePosteriors, "wb" )) == NULL ) { XLALPrintError ("%s: failed to open posteriors-output file '%s' for writing.\n", __func__, fnamePosteriors ); XLAL_ERROR ( XLAL_EFUNC ); } fprintf ( fpPosteriors, "%s", cfg.logString ); /* output header info */ /* write them to file, using pdf-method */ if ( XLALOutputPDF1D_to_fp ( fpPosteriors, pdf_t0, "pdf_t0" ) != XLAL_SUCCESS ) { XLALPrintError ("%s: failed to output t0-posterior to file '%s'.\n", __func__, fnamePosteriors ); XLAL_ERROR ( XLAL_EFUNC ); } if ( XLALOutputPDF1D_to_fp ( fpPosteriors, pdf_tau, "pdf_tau" ) != XLAL_SUCCESS ) { XLALPrintError ("%s: failed to output tau-posterior to file '%s'.\n", __func__, fnamePosteriors ); XLAL_ERROR ( XLAL_EFUNC ); } /* free mem, close file */ XLALFree ( fnamePosteriors ); fclose (fpPosteriors); } /* if outputPosteriors */ /* ----- if requested, output transient-cand statistics */ if ( fpTransientStats && write_transientCandidate_to_fp ( fpTransientStats, &cand ) != XLAL_SUCCESS ) { XLALPrintError ( "%s: write_transientCandidate_to_fp() failed.\n", __func__ ); XLAL_ERROR ( XLAL_EFUNC ); } /* ----- free Memory */ XLALDestroyTransientFstatMap ( cand.FstatMap ); XLALDestroyMultiFstatAtomVector ( multiAtoms ); XLALDestroyPDF1D ( pdf_t0 ); XLALDestroyPDF1D ( pdf_tau ); } /* for i < numDraws */ /* ----- close files ----- */ if ( fpTransientStats) fclose ( fpTransientStats ); if ( fpInjParams ) fclose ( fpInjParams ); /* ----- free memory ---------- */ XLALDestroyMultiDetectorStateSeries ( cfg.multiDetStates ); XLALDestroyMultiAMCoeffs ( multiAMBuffer.multiAM ); XLALDestroyExpLUT(); /* ----- free amplitude prior pdfs ----- */ XLALDestroyPDF1D ( cfg.AmpPrior.pdf_h0Nat ); XLALDestroyPDF1D ( cfg.AmpPrior.pdf_cosi ); XLALDestroyPDF1D ( cfg.AmpPrior.pdf_psi ); XLALDestroyPDF1D ( cfg.AmpPrior.pdf_phi0 ); if ( cfg.logString ) XLALFree ( cfg.logString ); gsl_rng_free ( cfg.rng ); XLALDestroyUserVars(); /* did we forget anything ? (doesn't cover gsl-memory!) */ LALCheckMemoryLeaks(); return 0; } /* main() */
char* oph_gsl_ifft(UDF_INIT *initid, UDF_ARGS *args, char *result, unsigned long *length, char *is_null, char *error) { if (*error) { *length=0; *is_null=0; *error=1; return NULL; } if (*is_null || !args->lengths[2]) { *length=0; *is_null=1; *error=0; return NULL; } if (!initid->ptr) { initid->ptr=(char *)calloc(1,sizeof(oph_string)); if(!initid->ptr){ pmesg(1, __FILE__, __LINE__, "Error allocating result\n"); *length=0; *is_null=1; *error=1; return NULL; } oph_stringPtr output = (oph_stringPtr) initid->ptr; core_set_type(output,args->args[1],&(args->lengths[1])); if (output->type!=OPH_COMPLEX_DOUBLE) { pmesg(1, __FILE__, __LINE__, "Invalid type: oph_complex_double required\n"); *length=0; *is_null=1; *error=1; return NULL; } core_set_type(output,args->args[0],&(args->lengths[0])); if (output->type!=OPH_COMPLEX_DOUBLE) { pmesg(1, __FILE__, __LINE__, "Invalid type: oph_complex_double or oph_double required\n"); *length=0; *is_null=1; *error=1; return NULL; } output->length = (unsigned long *)calloc(1,sizeof(unsigned long)); if (!output->length) { pmesg(1, __FILE__, __LINE__, "Error allocating length\n"); *length=0; *is_null=1; *error=1; return NULL; } *(output->length) = args->lengths[2]; if(core_set_elemsize(output)){ pmesg(1, __FILE__, __LINE__, "Error on setting element size\n"); *length=0; *is_null=0; *error=1; return NULL; } if(core_set_numelem(output)){ pmesg(1, __FILE__, __LINE__, "Error on counting result elements\n"); *length=0; *is_null=0; *error=1; return NULL; } output->content = (char *)calloc(1,*(output->length)); if(!output->content){ pmesg(1, __FILE__, __LINE__, "Error allocating result string\n"); *length=0; *is_null=1; *error=1; return NULL; } initid->extension = calloc(1,sizeof(oph_gsl_fft_extraspace)); if (!initid->extension) { pmesg(1, __FILE__, __LINE__, "Error allocating extra space\n"); *length=0; *is_null=1; *error=1; return NULL; } oph_gsl_fft_extraspace *extra = (oph_gsl_fft_extraspace *) initid->extension; extra->wt = gsl_fft_complex_wavetable_alloc(output->numelem); if (!extra->wt) { pmesg(1, __FILE__, __LINE__, "Error allocating wavetable\n"); *length=0; *is_null=1; *error=1; return NULL; } extra->ws = gsl_fft_complex_workspace_alloc(output->numelem); if (!extra->ws) { pmesg(1, __FILE__, __LINE__, "Error allocating workspace\n"); *length=0; *is_null=1; *error=1; return NULL; } } oph_stringPtr output = (oph_stringPtr) initid->ptr; oph_gsl_fft_extraspace *extra = (oph_gsl_fft_extraspace *) initid->extension; gsl_set_error_handler_off(); memcpy(output->content,args->args[2],*(output->length)); if (gsl_fft_complex_inverse((gsl_complex_packed_array) output->content,1,output->numelem,extra->wt,extra->ws)) { pmesg(1, __FILE__, __LINE__, "Error computing ifft\n"); *length=0; *is_null=1; *error=1; return NULL; } *length = *(output->length); *error=0; *is_null=0; return output->content; }
void initialise() { gsl_set_error_handler_off(); }
/** * The settle function computes the steady state nearest the initial * conditions. */ void SteadyState::settle( bool forceSetup ) { #ifdef USE_GSL gsl_set_error_handler_off(); if ( !isInitialized_ ) { cout << "Error: SteadyState object has not been initialized. No calculations done\n"; return; } if ( forceSetup || isSetup_ == 0 ) { setupSSmatrix(); } // Setting up matrices and vectors for the calculation. unsigned int nConsv = numVarPools_ - rank_; double * T = (double *) calloc( nConsv, sizeof( double ) ); unsigned int i, j; Id ksolve = Field< Id >::get( stoich_, "ksolve" ); struct reac_info ri; ri.rank = rank_; ri.num_reacs = nReacs_; ri.num_mols = numVarPools_; ri.T = T; ri.Nr = Nr_; ri.gamma = gamma_; ri.stoich = stoich_; ri.nVec = LookupField< unsigned int, vector< double > >::get( ksolve,"nVec", 0 ); ri.convergenceCriterion = convergenceCriterion_; // Fill up boundary condition values if ( reassignTotal_ ) { // The user has defined new conservation values. for ( i = 0; i < nConsv; ++i ) T[i] = total_[i]; reassignTotal_ = 0; } else { for ( i = 0; i < nConsv; ++i ) for ( j = 0; j < numVarPools_; ++j ) T[i] += gsl_matrix_get( gamma_, i, j ) * ri.nVec[ j ]; total_.assign( T, T + nConsv ); } vector< double > repair( numVarPools_, 0.0 ); for ( unsigned int j = 0; j < numVarPools_; ++j ) repair[j] = ri.nVec[j]; int status = iterate( gsl_multiroot_fsolver_hybrids, &ri, maxIter_ ); if ( status ) // It failed. Fall back with the Newton method status = iterate( gsl_multiroot_fsolver_dnewton, &ri, maxIter_ ); status_ = string( gsl_strerror( status ) ); nIter_ = ri.nIter; if ( status == GSL_SUCCESS ) { solutionStatus_ = 0; // Good solution LookupField< unsigned int, vector< double > >::set( ksolve,"nVec", 0, ri.nVec ); classifyState( T ); /* * Should happen in the ss_func. for ( i = 0; i < numVarPools_; ++i ) s_->S()[i] = gsl_vector_get( op( solver->x ), i ); */ } else { cout << "Warning: SteadyState iteration failed, status = " << status_ << ", nIter = " << nIter_ << endl; // Repair the mess for ( unsigned int j = 0; j < numVarPools_; ++j ) ri.nVec[j] = repair[j]; solutionStatus_ = 1; // Steady state failed. LookupField< unsigned int, vector< double > >::set( ksolve,"nVec", 0, ri.nVec ); } // Clean up. free( T ); #endif }
gsl_multimin_fminimizer * Fit::fitSimplex(gsl_multimin_function f, int &iterations, int &status) { const gsl_multimin_fminimizer_type *T = gsl_multimin_fminimizer_nmsimplex2; //size of the simplex gsl_vector *ss; //initial vertex size vector ss = gsl_vector_alloc (f.n); //set all step sizes to 1 can be increased to converge faster gsl_vector_set_all (ss, 10.0); gsl_set_error_handler_off(); gsl_multimin_fminimizer *s_min = gsl_multimin_fminimizer_alloc (T, f.n); status = gsl_multimin_fminimizer_set (s_min, &f, d_param_init, ss); double size; size_t iter = 0; bool inRange = true; for (int i=0; i<d_p; i++){ double p = gsl_vector_get(d_param_init, i); d_results[i] = p; if (p < d_param_range_left[i] || p > d_param_range_right[i]){ inRange = false; break; } } if (status) { iterations = 0; gsl_vector_free(ss); return s_min; } do{ iter++; status = gsl_multimin_fminimizer_iterate (s_min); if (status) break; for (int i=0; i<d_p; i++){ double p = gsl_vector_get(s_min->x, i); if (p < d_param_range_left[i] || p > d_param_range_right[i]){ inRange = false; break; } } if (!inRange) break; for (int i=0; i<d_p; i++) d_results[i] = gsl_vector_get(s_min->x, i); size = gsl_multimin_fminimizer_size (s_min); status = gsl_multimin_test_size (size, d_tolerance); } while (inRange && status == GSL_CONTINUE && (int)iter < d_max_iterations); iterations = iter; gsl_vector_free(ss); return s_min; }
/** * MAIN function * Generates samples of B-stat and F-stat according to their pdfs for given signal-params. */ int main(int argc,char *argv[]) { UserInput_t XLAL_INIT_DECL(uvar); ConfigVariables XLAL_INIT_DECL(cfg); vrbflg = 1; /* verbose error-messages */ /* turn off default GSL error handler */ gsl_set_error_handler_off (); /* ----- register and read all user-variables ----- */ if ( XLALInitUserVars( &uvar ) != XLAL_SUCCESS ) { LogPrintf ( LOG_CRITICAL, "%s: XLALInitUserVars() failed with errno=%d\n", __func__, xlalErrno ); return 1; } /* do ALL cmdline and cfgfile handling */ BOOLEAN should_exit = 0; if ( XLALUserVarReadAllInput ( &should_exit, argc, argv ) != XLAL_SUCCESS ) { LogPrintf ( LOG_CRITICAL, "%s: XLALUserVarReadAllInput() failed with errno=%d\n", __func__, xlalErrno ); return 1; } if ( should_exit ) return EXIT_FAILURE; if ( uvar.version ) { /* output verbose VCS version string if requested */ CHAR *vcs; if ( (vcs = XLALGetVersionString (lalDebugLevel)) == NULL ) { LogPrintf ( LOG_CRITICAL, "%s:XLALGetVersionString(%d) failed with errno=%d.\n", __func__, lalDebugLevel, xlalErrno ); return 1; } printf ( "%s\n", vcs ); XLALFree ( vcs ); return 0; } /* ---------- Initialize code-setup ---------- */ if ( XLALInitCode( &cfg, &uvar ) != XLAL_SUCCESS ) { LogPrintf (LOG_CRITICAL, "%s: XLALInitCode() failed with error = %d\n", __func__, xlalErrno ); XLAL_ERROR ( XLAL_EFUNC ); } /* compare IFO name for line injection with IFO list, find the corresponding index, or throw an error if not found */ UINT4 numDetectors = cfg.multiDetStates->length; INT4 lineX = -1; if ( uvar.lineIFO ) { for ( UINT4 X=0; X < numDetectors; X++ ) { if ( strcmp( uvar.lineIFO, uvar.IFOs->data[X] ) == 0 ) lineX = X; } if ( lineX == -1 ) { XLALPrintError ("\nError in function %s, line %d : Could not match detector ID \"%s\" for line injection to any detector.\n\n", __func__, __LINE__, uvar.lineIFO); XLAL_ERROR ( XLAL_EFAILED ); } } /* ----- prepare stats output ----- */ FILE *fpStats = NULL; if ( uvar.outputStats ) { if ( (fpStats = fopen (uvar.outputStats, "wb")) == NULL) { LogPrintf (LOG_CRITICAL, "Error opening file '%s' for writing..\n\n", uvar.outputStats ); XLAL_ERROR ( XLAL_EIO ); } fprintf (fpStats, "%s", cfg.logString ); /* write search log comment */ if ( write_BSGL_candidate_to_fp ( fpStats, NULL, uvar.IFOs, NULL, uvar.computeBSGL ) != XLAL_SUCCESS ) { /* write header-line comment */ XLAL_ERROR ( XLAL_EFUNC ); } } /* if outputStats */ /* ----- prepare injection params output ----- */ FILE *fpInjParams = NULL; if ( uvar.outputInjParams ) { if ( (fpInjParams = fopen (uvar.outputInjParams, "wb")) == NULL) { LogPrintf (LOG_CRITICAL, "Error opening file '%s' for writing..\n\n", uvar.outputInjParams ); XLAL_ERROR ( XLAL_EIO ); } fprintf (fpInjParams, "%s", cfg.logString ); /* write search log comment */ if ( write_InjParams_to_fp ( fpInjParams, NULL, 0, uvar.outputMmunuX, numDetectors ) != XLAL_SUCCESS ) { /* write header-line comment */ XLAL_ERROR ( XLAL_EFUNC ); } } /* if outputInjParams */ multiAMBuffer_t XLAL_INIT_DECL(multiAMBuffer); /* prepare AM-buffer */ /* ----- prepare BSGL computation */ BSGLSetup *BSGLsetup = NULL; if ( uvar.computeBSGL ) { BOOLEAN useLogCorrection = TRUE; REAL4 *oLGX_p = NULL; REAL4 oLGX[PULSAR_MAX_DETECTORS]; if ( uvar.oLGX != NULL ) { XLAL_CHECK ( uvar.oLGX->length == numDetectors, XLAL_EINVAL, "Invalid input: length(oLGX) = %d differs from number of detectors (%d)'\n", uvar.oLGX->length, numDetectors ); XLAL_CHECK ( XLALParseLinePriors ( &oLGX[0], uvar.oLGX ) == XLAL_SUCCESS, XLAL_EFUNC ); oLGX_p = &oLGX[0]; } XLAL_CHECK ( ( BSGLsetup = XLALCreateBSGLSetup ( numDetectors, uvar.Fstar0, oLGX_p, useLogCorrection ) ) != NULL, XLAL_EFUNC ); } // if computeBSGL /* ----- main MC loop over numDraws trials ---------- */ INT4 i; for ( i=0; i < uvar.numDraws; i ++ ) { InjParams_t XLAL_INIT_DECL(injParamsDrawn); /* ----- generate signal random draws from ranges and generate Fstat atoms */ MultiFstatAtomVector *multiAtoms; multiAtoms = XLALSynthesizeTransientAtoms ( &injParamsDrawn, cfg.skypos, cfg.AmpPrior, cfg.transientInjectRange, cfg.multiDetStates, cfg.SignalOnly, &multiAMBuffer, cfg.rng, lineX, cfg.multiNoiseWeights ); XLAL_CHECK ( multiAtoms != NULL, XLAL_EFUNC ); /* ----- if requested, output signal injection parameters into file */ if ( fpInjParams && (write_InjParams_to_fp ( fpInjParams, &injParamsDrawn, uvar.dataStartGPS, uvar.outputMmunuX, numDetectors ) != XLAL_SUCCESS ) ) { XLAL_ERROR ( XLAL_EFUNC ); } /* if fpInjParams & failure*/ /* initialise BSGLComponents structure and allocate memory */ BSGLComponents XLAL_INIT_DECL(synthStats); /* struct containing multi-detector Fstat, single-detector Fstats, line-robust stat */ synthStats.numDetectors = numDetectors; /* compute F- and BSGListics from atoms */ UINT4 X; for ( X=0; X < numDetectors; X++ ) { synthStats.TwoFX[X] = XLALComputeFstatFromAtoms ( multiAtoms, X ); if ( xlalErrno != 0 ) { XLALPrintError ("\nError in function %s, line %d : Failed call to XLALComputeFstatFromAtoms().\n\n", __func__, __LINE__); XLAL_ERROR ( XLAL_EFUNC ); } } synthStats.TwoF = XLALComputeFstatFromAtoms ( multiAtoms, -1 ); if ( xlalErrno != 0 ) { XLALPrintError ("\nError in function %s, line %d : Failed call to XLALComputeFstatFromAtoms().\n\n", __func__, __LINE__); XLAL_ERROR ( XLAL_EFUNC ); } if ( uvar.computeBSGL ) { synthStats.log10BSGL = XLALComputeBSGL ( synthStats.TwoF, synthStats.TwoFX, BSGLsetup ); XLAL_CHECK ( xlalErrno == 0, XLAL_EFUNC, "XLALComputeBSGL() failed with xlalErrno = %d\n", xlalErrno ); } /* ----- if requested, output atoms-vector into file */ if ( uvar.outputAtoms ) { FILE *fpAtoms; char *fnameAtoms; UINT4 len = strlen ( uvar.outputAtoms ) + 20; if ( (fnameAtoms = XLALCalloc ( 1, len )) == NULL ) { XLALPrintError ("%s: failed to XLALCalloc ( 1, %d )\n", __func__, len ); XLAL_ERROR ( XLAL_EFUNC ); } sprintf ( fnameAtoms, "%s_%04d_of_%04d.dat", uvar.outputAtoms, i + 1, uvar.numDraws ); if ( ( fpAtoms = fopen ( fnameAtoms, "wb" )) == NULL ) { XLALPrintError ("%s: failed to open atoms-output file '%s' for writing.\n", __func__, fnameAtoms ); XLAL_ERROR ( XLAL_EFUNC ); } fprintf ( fpAtoms, "%s", cfg.logString ); /* output header info */ if ( write_MultiFstatAtoms_to_fp ( fpAtoms, multiAtoms ) != XLAL_SUCCESS ) { XLALPrintError ("%s: failed to write atoms to output file '%s'. xlalErrno = %d\n", __func__, fnameAtoms, xlalErrno ); XLAL_ERROR ( XLAL_EFUNC ); } XLALFree ( fnameAtoms ); fclose (fpAtoms); } /* if outputAtoms */ /* ----- if requested, output transient-cand statistics */ if ( fpStats && write_BSGL_candidate_to_fp ( fpStats, &synthStats, uvar.IFOs, &injParamsDrawn, uvar.computeBSGL ) != XLAL_SUCCESS ) { XLALPrintError ( "%s: write_transientCandidate_to_fp() failed.\n", __func__ ); XLAL_ERROR ( XLAL_EFUNC ); } /* ----- free Memory */ XLALDestroyMultiFstatAtomVector ( multiAtoms ); } /* for i < numDraws */ /* ----- close files ----- */ if ( fpStats ) fclose ( fpStats ); if ( fpInjParams ) fclose ( fpInjParams ); /* ----- free memory ---------- */ XLALDestroyMultiDetectorStateSeries ( cfg.multiDetStates ); XLALDestroyMultiNoiseWeights ( cfg.multiNoiseWeights ); XLALDestroyExpLUT(); XLALDestroyMultiAMCoeffs ( multiAMBuffer.multiAM ); /* ----- free amplitude prior pdfs ----- */ XLALDestroyPDF1D ( cfg.AmpPrior.pdf_h0Nat ); XLALDestroyPDF1D ( cfg.AmpPrior.pdf_cosi ); XLALDestroyPDF1D ( cfg.AmpPrior.pdf_psi ); XLALDestroyPDF1D ( cfg.AmpPrior.pdf_phi0 ); XLALFree ( BSGLsetup ); BSGLsetup = NULL; if ( cfg.logString ) { XLALFree ( cfg.logString ); } gsl_rng_free ( cfg.rng ); XLALDestroyUserVars(); /* did we forget anything ? (doesn't cover gsl-memory!) */ LALCheckMemoryLeaks(); return 0; } /* main() */
int PoissonGlm::betaEst( unsigned int id, unsigned int iter, double *tol, double th) { gsl_set_error_handler_off(); int status, isValid; // unsigned int j, ngoodobs; unsigned int i, step, step1; double wij, zij, eij, mij, yij; //, bij; double dev_old, dev_grad=1.0; gsl_vector_view Xwi; gsl_matrix *WX, *XwX; gsl_vector *z, *Xwz; gsl_vector *coef_old = gsl_vector_alloc(nParams); gsl_vector_view bj=gsl_matrix_column (Beta, id); // Main Loop of IRLS begins z = gsl_vector_alloc(nRows); WX = gsl_matrix_alloc(nRows, nParams); XwX = gsl_matrix_alloc(nParams, nParams); Xwz = gsl_vector_alloc(nParams); step=0; *tol = 1.0; gsl_vector_memcpy (coef_old, &bj.vector); while ( step<iter ) { for (i=0; i<nRows; i++) { // (y-m)/g' yij = gsl_matrix_get(Yref, i, id); eij = gsl_matrix_get(Eta, i, id); mij = gsl_matrix_get(Mu, i, id); // if (mij<mintol) mij=mintol; // if (mij>maxtol) mij=maxtol; zij = eij + (yij-mij)*LinkDash(mij); if (Oref!=NULL) zij = zij - gsl_matrix_get(Oref, i, id); // wt=sqrt(weifunc); wij = sqrt(weifunc(mij, th)); // W^1/2*z[good] gsl_vector_set(z, i, wij*zij); // W^1/2*X[good] Xwi = gsl_matrix_row (Xref, i); gsl_matrix_set_row (WX, i, &Xwi.vector); Xwi = gsl_matrix_row (WX, i); gsl_vector_scale(&Xwi.vector, wij); } // in glm2, solve WXb=Wz, David suggested not good // So back to solving X'WXb=X'Wz gsl_matrix_set_identity (XwX); gsl_blas_dsyrk (CblasLower,CblasTrans,1.0,WX,0.0,XwX); status=gsl_linalg_cholesky_decomp(XwX); if (status==GSL_EDOM) { if (mmRef->warning==TRUE) { printf("Warning: singular matrix in betaEst: "); gsl_matrix_set_identity (XwX); gsl_blas_dsyrk (CblasLower,CblasTrans,1.0,Xref,0.0,XwX); // displaymatrix(Xref, "Xref"); // displaymatrix(XwX, "XX^T"); // printf("calc(XX')=%.8f\n", calcDet(XwX)); status=gsl_linalg_cholesky_decomp(XwX); if (status==GSL_EDOM) printf("X^TX is singular - check case resampling or input design matrix!\n"); else { for (i=0; i<nRows; i++) { mij = gsl_matrix_get(Mu, i, id); wij = sqrt(weifunc(mij, th)); if (wij<mintol) printf("weight[%d, %d]=%.4f is too close to zero\n", i, id, wij); } } printf("An eps*I is added to the singular matrix.\n"); } gsl_matrix_set_identity (XwX); gsl_blas_dsyrk (CblasLower,CblasTrans,1.0,WX,mintol,XwX); gsl_linalg_cholesky_decomp(XwX); } gsl_blas_dgemv(CblasTrans,1.0,WX,z,0.0,Xwz); gsl_linalg_cholesky_solve (XwX, Xwz, &bj.vector); // Debug for nan /* if (gsl_vector_get(&bj.vector, 1)!=gsl_vector_get(&bj.vector, 1)) { displayvector(&bj.vector, "bj"); displayvector(z, "z"); gsl_vector_view mj=gsl_matrix_column(Mu, id); displayvector(&mj.vector, "mj"); printf("weight\n"); for (i=0; i<nRows; i++){ printf("%.4f ", sqrt(weifunc(mij, th))); } printf("\n"); displaymatrix(XwX, "XwX"); exit(-1); } */ // Given bj, update eta, mu dev_old = dev[id]; isValid=predict(bj, id, th); dev_grad=(dev[id]-dev_old)/(ABS(dev[id])+0.1); *(tol)=ABS(dev_grad); step1 = 0; // If divergent or increasing deviance, half step // (step>1) -> (step>0) gives weired results for NBin fit // below works for boundary values, esp BIN fit but not NBin fit while ((dev_grad>eps)&(step>1)){ gsl_vector_add (&bj.vector, coef_old); gsl_vector_scale (&bj.vector, 0.5); // dev_old=dev[id]; isValid=predict(bj, id, th); dev_grad=(dev[id]-dev_old)/(ABS(dev[id])+0.1); *tol=ABS(dev_grad); if (*tol<eps) break; step1++; if (step1>10) { // printf("\t Half step stopped at iter %d: gradient=%.8f\n", step1, dev_grad); break; } } if (isValid==TRUE) gsl_vector_memcpy (coef_old, &bj.vector); step++; if (*tol<eps) break; } gsl_vector_free(z); gsl_matrix_free(WX); gsl_matrix_free(XwX); gsl_vector_free(Xwz); gsl_vector_free(coef_old); return step; }
int main( int argc, char **argv ) { // We use a GSL special function to compute binomial cdfs. // Turn off the GSL error handler so we can trap those errors ourself. gsl_set_error_handler_off(); // Set defaults program input values hotspot::numSD = hotspot::HotspotDefaults::MINSD; // minimum sd and intensity for detection hotspot::lowInt = hotspot::HotspotDefaults::LOW_INTERVAL_WIDTH; // range and interval for scanning hotspot::highInt = hotspot::HotspotDefaults::HIGH_INTEVAL_WIDTH; hotspot::incInt = hotspot::HotspotDefaults::INTERVAL_INCREMENT; hotspot::fuzzySeed = hotspot::HotspotDefaults::FUZZY_SEED; hotspot::totaltagcount = 0; hotspot::densityWin = hotspot::HotspotDefaults::DENSITY_WIN; // Fetch input data hotspot::GetArgs( argc, argv); hotspot::InputDataReader inputDataReader( hotspot::libpath ); hotspot::totaltagcount = inputDataReader.numLines( ); std::cout << "TotalTagCount: " << hotspot::totaltagcount << std::endl; hotspot::MappableCountsDataReader mappableCountsDataReader( hotspot::densitypath ); if( hotspot::useDefaultBackgroundTags ) { hotspot::backgroundTotalTagCount = hotspot::totaltagcount; } if( hotspot::useFuzzyThreshold ) { std::srand( hotspot::fuzzySeed ); } bool headerPrinted = false; std::vector< int > inputData; std::vector< int > mappableCounts; // Main processing loop: each pass considers each chromosome in the input data set while( inputDataReader.readNextChrom( inputData ) > 0 ) { std::cerr << "Processing chrom: " << inputDataReader.currentChromName( ) << std::endl; // get counts of 'background' mappable K-mers on each 50kb interval on that chromosome int numRead = mappableCountsDataReader.readChrom(inputDataReader.currentChromName( ), mappableCounts ); if( numRead < 0 ) { std::cerr << "Error reading background file. Aborting" << std::endl; exit( EXIT_FAILURE ); } // Compute the hot spots and filter them std::cerr << "Compute Hot Spots " << std::endl; std::map< int, Hotspot* > hotspots; hotspot::ComputeHotSpots( inputData, hotspot::lowInt, hotspot::highInt, hotspot::incInt, hotspots ); std::cerr << "Filter Hot Spots " << std::endl; std::map< int, Hotspot* > filteredHotspots; hotspot::FilterHotspots( hotspots, filteredHotspots ); // Calculate cluster size, and other hotspot statistics if( hotspot::useGenomeDensWin) { // These vars are updated (side-effect) of the ClusterSize routine hotspot::numGenomeDens = 0; hotspot::numLocalDens = 0; hotspot::genomeDensZ = 0.0; hotspot::localDensZ = 0.0; } std::cerr << "Cluster Size" << std::endl; hotspot::ClusterSize( inputData, hotspot::densityWin, filteredHotspots, mappableCounts ); if( hotspot::useGenomeDensWin ) { std::cerr << hotspot::numGenomeDens << " clusters scored using genome-wide density, avg. z = " << hotspot::genomeDensZ / hotspot::numGenomeDens << "; " << hotspot::numLocalDens << " scored using local density, avg. z = " << hotspot::localDensZ / hotspot::numLocalDens << std::endl; } // Summarize the results of this chromosome. Reset temp data structures std::map< int, Hotspot* >::iterator iter; for( iter = hotspots.begin( ); iter != hotspots.end( ); ++iter ) { delete iter->second; } if(! headerPrinted ) { Hotspot::printHeader( hotspot::fpout ); headerPrinted = true; } for( iter = filteredHotspots.begin(); iter != filteredHotspots.end(); ++iter ) { //TODO remove costly char lookup to one-time lookup outside loop iter->second->printOut( inputDataReader.currentChromName().c_str( ), hotspot::fpout ); delete iter->second; } std::cerr << "Chrom summary: " << filteredHotspots.size( ) << std::endl; std::fflush( hotspot::fpout ); mappableCounts.clear( ); inputData.clear( ); } // end loop over all chromosomes // Release open resources if( hotspot::fpout ) { std::fclose( hotspot::fpout ); } std::exit( EXIT_SUCCESS ); }
static VALUE rb_gsl_set_error_handler_off(VALUE module) { gsl_set_error_handler_off(); return Qtrue; }
int handle_second_lvl(int argc,char **argv,struct first_lvl_cmd *fl, struct second_lvl_cmd *sl) { int status = 0; // check for help if(ask_help || (argc == 0 && sl->nargs != 0)) { if(sl->help != NULL) print_help(sl->help); else print_first_lvl_help(fl); return 0; } // check number of arguments if(argc != sl->nargs) { info("Expected %u arguments, found %u\n",sl->nargs,argc); error("Wrong number of arguments\n"); return 1; } // open input if(fl->flags & NEED_INPUT) { normal("Configuring input\n"); if(infname) { info("Using %s as input file\n",infname); infile = fopen(infname,"r"); if(!infile) { warning("failed to open file %s for graph input, using stdin instead\n",infname); infile = stdin; infname = NULL; } } else infile = stdin; status = ggen_read_graph(&g,infile); if(infname) fclose(infile); if(status) { error("Failed to read graph\n"); goto free_ing; } normal("Input configured and graph read\n"); } // load rng if(fl->flags & NEED_RNG) { normal("Configuring random number generator\n"); // turn off automatic abort on gsl error gsl_set_error_handler_off(); status = ggen_rng_init(&rng); if(status) { error("Failed to initialize RNG\n"); goto free_ing; } if(rngfname) { info("Using %s as RNG state file\n",rngfname); status = ggen_rng_load(&rng,rngfname); if(status == 1) warning("RNG State file not found, will continue anyway\n"); else if(status != 0) { error("Reading RNG State from file failed.\n"); goto free_rng; } } normal("RNG configured\n"); } // set name if((fl->flags & NEED_NAME) && name == NULL) { name = "newproperty"; info("Property name needed, using %s as default\n",name); } // set type if((fl->flags & NEED_TYPE) && ptype == -1) { ptype = VERTEX_PROPERTY; info("Property type needed, using VERTEX as default\n"); } // output is a bit different from input: // a command can have its output redirected even // if it does not generate a graph // need_output tells us if a resulting graph needs // to be wrote, not if the output can be redirected normal("Configuring output\n"); if(outfname) { info("Opening %s for writing\n",outfname); outfile = fopen(outfname,"w"); if(!outfile) { warning("Failed to open file %s for output, using stdout instead\n",outfname); outfile = stdout; outfname = NULL; } } else outfile = stdout; normal("Ouput configured\n"); // launch cmd status = sl->fn(argc,argv); if(status) { error("Command Failed\n"); goto err; } if(fl->flags & NEED_OUTPUT) { normal("Printing graph\n"); if(fl->flags & IS_GRAPH_P) status = ggen_write_graph(g_p,outfile); else status = ggen_write_graph(&g,outfile); if(status) { error("Writing graph failed\n"); goto free_outg; } else normal("Graph printed\n"); } if((fl->flags & NEED_RNG) && rngfname) { normal("Saving RNG state\n"); status = ggen_rng_save(&rng,rngfname); if(status) { error("RNG saving failed\n"); } else normal("RNG Saved\n"); } free_outg: if(outfname) fclose(outfile); if(fl->flags & IS_GRAPH_P) { igraph_destroy(g_p); free(g_p); } err: free_rng: if(fl->flags & NEED_RNG) gsl_rng_free(rng); free_ing: if(fl->flags & NEED_INPUT) igraph_destroy(&g); return status; }
// 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; }
int PoissonGlm::EstIRLS(gsl_matrix *Y, gsl_matrix *X, gsl_matrix *O, gsl_matrix *B, double *a) { initialGlm(Y, X, O, B); gsl_set_error_handler_off(); gsl_rng *rnd=gsl_rng_alloc(gsl_rng_mt19937); unsigned int i, j; int status; double yij, mij, vij, wij, tol, hii, uij, wei; gsl_vector_view Xwi, Xi, vj, hj, dj; gsl_matrix *WX = gsl_matrix_alloc(nRows, nParams); gsl_matrix *TMP = gsl_matrix_alloc(nRows, nParams); gsl_matrix *XwX = gsl_matrix_alloc(nParams, nParams); for (j=0; j<nVars; j++) { if ( a!=NULL ) theta[j]=a[j]; // estimate mu and beta iterconv[j] = betaEst(j, maxiter, &tol, theta[j]); if ((mmRef->warning==TRUE)&(iterconv[j]==maxiter)) printf("Warning: EstIRLS reached max iterations, may not converge in the %d-th variable (dev=%.4f, err=%.4f)!\n", j, dev[j], tol); gsl_matrix_memcpy (WX, X); for (i=0; i<nRows; i++) { mij = gsl_matrix_get(Mu, i, j); // get variance vij = varfunc( mij, theta[j] ); gsl_matrix_set(Var, i, j, vij); // get weight wij = sqrt(weifunc(mij, theta[j])); gsl_matrix_set(wHalf, i, j, wij); // get (Pearson) residuals yij = gsl_matrix_get(Y, i, j); gsl_matrix_set(Res, i, j, (yij-mij)/sqrt(vij)); // get PIT residuals for discrete data wei = gsl_rng_uniform_pos (rnd); // wei ~ U(0, 1) uij = wei*cdf(yij, mij, theta[j]); if (yij>0) uij=uij+(1-wei)*cdf((yij-1),mij,theta[j]); gsl_matrix_set(PitRes, i, j, uij); // get elementry log-likelihood ll[j] = ll[j] + llfunc( yij, mij, theta[j]); // W^1/2 X Xwi = gsl_matrix_row (WX, i); gsl_vector_scale(&Xwi.vector, wij); } aic[j]=-ll[j]+2*(nParams); // X^T * W * X gsl_matrix_set_identity(XwX); gsl_blas_dsyrk (CblasLower, CblasTrans, 1.0, WX, 0.0, XwX); status=gsl_linalg_cholesky_decomp (XwX); if (status==GSL_EDOM) { if (mmRef->warning==TRUE) printf("Warning: singular matrix in calculating pit-residuals. An eps*I is added to the singular matrix.\n"); gsl_matrix_set_identity(XwX); gsl_blas_dsyrk (CblasLower, CblasTrans, 1.0, WX, mintol, XwX); gsl_linalg_cholesky_decomp (XwX); } gsl_linalg_cholesky_invert (XwX); // Calc varBeta dj = gsl_matrix_diagonal (XwX); vj = gsl_matrix_column (varBeta, j); gsl_vector_memcpy (&vj.vector, &dj.vector); // hii is diagonal element of H=X*(X'WX)^-1*X'*W hj = gsl_matrix_column (sqrt1_Hii, j); gsl_blas_dsymm(CblasRight,CblasLower,1.0,XwX,Xref,0.0,TMP); // X*(X'WX)^-1 for (i=0; i<nRows; i++) { Xwi=gsl_matrix_row(TMP, i); Xi=gsl_matrix_row(Xref, i); wij=gsl_matrix_get(wHalf, i, j); gsl_blas_ddot(&Xwi.vector, &Xi.vector, &hii); gsl_vector_set(&hj.vector, i, MAX(mintol, sqrt(MAX(0, 1-wij*wij*hii)))); } } // standardize perason residuals by rp/sqrt(1-hii) // gsl_matrix_div_elements (Res, sqrt1_Hii); // subtractMean(Res); // have mean subtracted gsl_matrix_free(XwX); gsl_matrix_free(WX); gsl_matrix_free(TMP); gsl_rng_free(rnd); return SUCCESS; }
double QFFitFunctionFCSDistributionDIntGaussian::evaluate(double t, const double* data) const { const int nonfl_comp=data[FCSDLG_n_nonfluorescent]; const double N=data[FCSDLG_n_particle]; const double nf_tau1=data[FCSDLG_nonfl_tau1]/1.0e6; const double nf_theta1=data[FCSDLG_nonfl_theta1]; const double nf_tau2=data[FCSDLG_nonfl_tau2]/1.0e6; const double nf_theta2=data[FCSDLG_nonfl_theta2]; const double D1=data[FCSDLG_diff_coeff1]; const double D1_sigma=data[FCSDLG_diff_coeff_sigma]; const double D_min=data[FCSDLG_D_range_min]; const double D_max=data[FCSDLG_D_range_max]; const double wxy=data[FCSDLG_focus_width]/1e3; const double background=data[FCSDiff_background]; const double cr=data[FCSDLG_count_rate]; double backfactor=qfSqr(cr-background)/qfSqr(cr); if (fabs(cr)<1e-15) backfactor=1; double gamma=data[FCSDLG_focus_struct_fac]; if (gamma==0) gamma=1; const double gamma2=sqr(gamma); const double offset=data[FCSDLG_offset]; if (N>0) { register double diff=0.0; double diff1=0.0; double diff2=0.0; double error=0; QFFitFunctionFCSDistributionDIntGaussian_intparam p; p.gamma=gamma; p.DC=D1; p.DSigma=D1_sigma; p.wxy=wxy; p.tau=t; gsl_function F; F.function = &QFFitFunctionFCSDistributionDIntGaussian_f; F.params = &p; gsl_function FD; FD.function = &QFFitFunctionFCSDistributionDIntGaussian_fd; FD.params = &p; gsl_error_handler_t * old_h=gsl_set_error_handler_off(); gsl_integration_qags(&F, D_min, D1, 0, 1e-7, wN, w, &diff1, &error); gsl_integration_qags(&F, D1, D_max, 0, 1e-7, wN, w, &diff2, &error); diff=diff1+diff2; gsl_integration_qags(&FD, D_min, D1, 0, 1e-7, wN, w, &diff1, &error); gsl_integration_qags(&FD, D1, D_max, 0, 1e-7, wN, w, &diff2, &error); diff=diff/(diff1+diff2); gsl_set_error_handler(old_h); double pre=1.0; if (nonfl_comp==1) { pre=(1.0-nf_theta1+nf_theta1*exp(-t/nf_tau1))/(1.0-nf_theta1); } else if (nonfl_comp==2) { pre=(1.0-nf_theta1+nf_theta1*exp(-t/nf_tau1)-nf_theta2+nf_theta2*exp(-t/nf_tau2))/(1.0-nf_theta1-nf_theta2); } return offset+pre/N*diff*backfactor; } else { const double Dtau=qfSqr(wxy)/4.0/t; return -1.0*exp(-0.5*qfSqr((Dtau-D1)/D1_sigma))/N*backfactor; } }
int NBinGlm::nbinfit(gsl_matrix *Y, gsl_matrix *X, gsl_matrix *O, gsl_matrix *B) { gsl_set_error_handler_off(); initialGlm(Y, X, O, B); gsl_rng *rnd=gsl_rng_alloc(gsl_rng_mt19937); unsigned int i, j; //, isConv; double yij, mij, vij, hii, uij, wij, wei; double th, tol, dev_th_b_old; int status; // gsl_vector_view b0j, m0j, e0j, v0j; gsl_matrix *WX = gsl_matrix_alloc(nRows, nParams); gsl_matrix *TMP = gsl_matrix_alloc(nRows, nParams); gsl_matrix *XwX = gsl_matrix_alloc(nParams, nParams); gsl_vector_view Xwi, Xi, vj, dj, hj; for (j=0; j<nVars; j++) { betaEst(j, maxiter, &tol, maxtol); //poisson // Get initial theta estimates iterconv[j]=0.0; if (mmRef->estiMethod==CHI2) { th = getDisper(j, 1.0); while ( iterconv[j]<maxiter ) { //printf("th=%.2f, iterconv[%d]=%d\n", th, j, iterconv[j]); iterconv[j]++; dev_th_b_old = dev[j]; betaEst(j, 1.0, &tol, th); // 1-step beta th = getDisper(j, th)/th; tol = ABS((dev[j]-dev_th_b_old)/(ABS(dev[j])+0.1)); if (tol<eps) break; } } else if (mmRef->estiMethod==NEWTON) { th = thetaML(0.0, j, maxiter); while ( iterconv[j]<maxiter ) { iterconv[j]++; dev_th_b_old = dev[j]; th = thetaML(th, j, maxiter2); betaEst(j, maxiter2, &tol, th); tol=ABS((dev[j]-dev_th_b_old)/(ABS(dev[j])+0.1)); if (tol<eps) break; } } else { th = getfAfAdash(0.0, j, maxiter); /* lm=0; for (i=0; i<nRows; i++) { yij = gsl_matrix_get(Y, i, j); mij = gsl_matrix_get(Mu, i, j); lm = lm + llfunc( yij, mij, th); } */ while ( iterconv[j]<maxiter ) { iterconv[j]++; dev_th_b_old = dev[j]; betaEst(j, maxiter2, &tol, th); th = getfAfAdash(th, j, 1.0); tol=ABS((dev[j]-dev_th_b_old)/(ABS(dev[j])+0.1)); if (tol<eps) break; } } if ((iterconv[j]==maxiter)&(mmRef->warning==TRUE)) printf("Warning: reached maximum itrations - negative binomial may NOT converge in the %d-th variable (dev=%.4f, err=%.4f, theta=%.4f)!\n", j, dev[j], tol, th); // other properties based on mu and phi theta[j] = th; gsl_matrix_memcpy(WX, Xref); ll[j]=0; for (i=0; i<nRows; i++) { yij = gsl_matrix_get(Y, i, j); mij = gsl_matrix_get(Mu, i, j); vij = varfunc( mij, th); gsl_matrix_set(Var, i, j, vij); wij = sqrt(weifunc(mij, th)); gsl_matrix_set(wHalf, i, j, wij); gsl_matrix_set(Res, i, j, (yij-mij)/sqrt(vij)); ll[j] = ll[j] + llfunc( yij, mij, th); // get PIT residuals for discrete data wei = gsl_rng_uniform_pos (rnd); // wei ~ U(0, 1) uij=wei*cdf(yij, mij, th); if (yij>0) uij=uij+(1-wei)*cdf((yij-1),mij,th); gsl_matrix_set(PitRes, i, j, uij); // W^1/2 X Xwi = gsl_matrix_row (WX, i); gsl_vector_scale(&Xwi.vector, wij); } aic[j]=-ll[j]+2*(nParams+1); // X^T * W * X gsl_matrix_set_identity (XwX); gsl_blas_dsyrk (CblasLower, CblasTrans, 1.0, WX, 0.0, XwX); status=gsl_linalg_cholesky_decomp (XwX); if (status==GSL_EDOM) { if (mmRef->warning==TRUE) printf("Warning: singular matrix in calculating pit-residuals. An eps*I is added to the singular matrix.\n"); gsl_matrix_set_identity (XwX); gsl_blas_dsyrk (CblasLower, CblasTrans, 1.0, WX, mintol, XwX); gsl_linalg_cholesky_decomp (XwX); } gsl_linalg_cholesky_invert (XwX); // (X'WX)^-1 // Calc varBeta vj = gsl_matrix_column (varBeta, j); dj = gsl_matrix_diagonal (XwX); gsl_vector_memcpy (&vj.vector, &dj.vector); // hii is diagonal element of H=X*(X'WX)^-1*X'*W hj = gsl_matrix_column (sqrt1_Hii, j); gsl_blas_dsymm(CblasRight,CblasLower,1.0,XwX,Xref,0.0,TMP); // X*(X'WX)^-1 for (i=0; i<nRows; i++) { Xwi=gsl_matrix_row(TMP, i); Xi=gsl_matrix_row(Xref, i); wij=gsl_matrix_get(wHalf, i, j); gsl_blas_ddot(&Xwi.vector, &Xi.vector, &hii); gsl_vector_set(&hj.vector, i, MAX(mintol, sqrt(MAX(0, 1-wij*wij*hii)))); //printf("hii=%.4f, wij=%.4f, sqrt(1-wij*wij*hii)=%.4f\n", hii, wij, sqrt(1-wij*wij*hii)); } } // end nVar for j loop // gsl_matrix_div_elements (Res, sqrt1_Hii); // subtractMean(Res); gsl_matrix_free(XwX); gsl_matrix_free(WX); gsl_matrix_free(TMP); gsl_rng_free(rnd); return 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; }